Posted to tcl by auriocus at Sun Jun 08 09:47:41 GMT 2014view raw
- #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;
- }