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;
}