Posted to tcl by auriocus at Sun Jun 08 09:47:41 GMT 2014view pretty
#include <tcl.h> #include <fribidi.h> static int fribidi_log2visCmd( ClientData clientData, /* Not used. */ Tcl_Interp *interp, /* Current interpreter */ int objc, /* Number of arguments */ Tcl_Obj *const objv[] /* Argument strings */ ) { if (objc != 2) { Tcl_WrongNumArgs (interp, 1, objv, "string"); return TCL_ERROR; } /* convert arg1 to FriBidiChar = UTF32 */ int len; char *str = Tcl_GetStringFromObj(interp, objv[1], &len); /* the string can have at most len characters */ FriBidiChar *frstr = ckalloc(sizeof(FriBidiChar)*len); int len_res = len, ind = 0; while (len_res >0) { Tcl_UniChar ch; int nbytes = Tcl_UtfToUniChar(str, &ch); str += nbytes; len_res -= nbytes; frstr[ind++] = ch; } int nchar = ind; /* nr. of characters in this string */ /* I don't understand FriBidiCharType. Does it need a chartype for every single char? */ FriBidiCharType *pbase_dir = ckalloc(sizeof(FriBidiCharType)*ind); for (ind = 0; ind < nchar; ind ++) { pbase_dir[ind] = FRIBIDI_TYPE_ON; } /* alloc buffer for result */ FriBidiChar *visual_str = ckalloc(sizeof(FriBidiCharType)*ind); fribidi_boolean result = fribidi_log2vis( /* input */ frstr, nchar, pbase_dir, /* output */ visual_str, NULL, NULL, NULL ); /* free input */ ckfree(pbase_dir); ckfree(frstr); /* Does the result indicate failure? */ if (result) { /* Success ? */ /* copy output to new string in Tcl_UniChar format */ Tcl_UniChar *uniresult = ckalloc(sizeof(Tcl_UniChar)*nchar); for (ind=0; ind < nchar; ind++) { uniresult[ind] = visual_str[ind]; } Tcl_SetObjResult(interp, Tcl_NewUnicodeObj(uniresult, nchar)); ckfree(uniresult); ckfree(visual_str) return TCL_OK; } else { /* Failure ? */ Tcl_SetResult(interp, "fribidi failed", NULL); ckfree(visual_str) return TCL_ERROR; } } int Tclfribidi_Init(Tcl_Interp *interp) { /* * This may work with 8.0, but we are using strictly stubs here, * which requires 8.1. */ if (Tcl_InitStubs(interp, "8.5", 0) == NULL) { return TCL_ERROR; } Tcl_CreateObjCommand(interp, "fribidi_log2vis", (Tcl_ObjCmdProc *) fribidi_log2visCmd, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); return TCL_OK; }