Posted to tcl by auriocus at Sun Jun 08 09:47:41 GMT 2014view raw

  1. #include <tcl.h>
  2. #include <fribidi.h>
  3.  
  4. static int
  5. fribidi_log2visCmd(
  6. ClientData clientData, /* Not used. */
  7. Tcl_Interp *interp, /* Current interpreter */
  8. int objc, /* Number of arguments */
  9. Tcl_Obj *const objv[] /* Argument strings */
  10. )
  11. {
  12. if (objc != 2) {
  13. Tcl_WrongNumArgs (interp, 1, objv, "string");
  14. return TCL_ERROR;
  15. }
  16.  
  17.  
  18. /* convert arg1 to FriBidiChar = UTF32 */
  19. int len;
  20. char *str = Tcl_GetStringFromObj(interp, objv[1], &len);
  21.  
  22. /* the string can have at most len characters */
  23. FriBidiChar *frstr = ckalloc(sizeof(FriBidiChar)*len);
  24.  
  25. int len_res = len, ind = 0;
  26. while (len_res >0) {
  27. Tcl_UniChar ch;
  28. int nbytes = Tcl_UtfToUniChar(str, &ch);
  29. str += nbytes; len_res -= nbytes;
  30. frstr[ind++] = ch;
  31. }
  32.  
  33. int nchar = ind; /* nr. of characters in this string */
  34.  
  35. /* I don't understand FriBidiCharType. Does it need a chartype for every single char? */
  36. FriBidiCharType *pbase_dir = ckalloc(sizeof(FriBidiCharType)*ind);
  37. for (ind = 0; ind < nchar; ind ++) {
  38. pbase_dir[ind] = FRIBIDI_TYPE_ON;
  39. }
  40.  
  41.  
  42. /* alloc buffer for result */
  43. FriBidiChar *visual_str = ckalloc(sizeof(FriBidiCharType)*ind);
  44.  
  45. fribidi_boolean result = fribidi_log2vis(
  46. /* input */
  47. frstr,
  48. nchar,
  49. pbase_dir,
  50. /* output */
  51. visual_str,
  52. NULL,
  53. NULL,
  54. NULL
  55. );
  56. /* free input */
  57. ckfree(pbase_dir);
  58. ckfree(frstr);
  59.  
  60. /* Does the result indicate failure? */
  61. if (result) {
  62. /* Success ? */
  63.  
  64. /* copy output to new string in Tcl_UniChar format */
  65. Tcl_UniChar *uniresult = ckalloc(sizeof(Tcl_UniChar)*nchar);
  66. for (ind=0; ind < nchar; ind++) {
  67. uniresult[ind] = visual_str[ind];
  68. }
  69.  
  70. Tcl_SetObjResult(interp, Tcl_NewUnicodeObj(uniresult, nchar));
  71. ckfree(uniresult);
  72. ckfree(visual_str)
  73. return TCL_OK;
  74.  
  75. } else {
  76. /* Failure ? */
  77. Tcl_SetResult(interp, "fribidi failed", NULL);
  78. ckfree(visual_str)
  79. return TCL_ERROR;
  80. }
  81.  
  82. }
  83.  
  84. int Tclfribidi_Init(Tcl_Interp *interp)
  85. {
  86. /*
  87. * This may work with 8.0, but we are using strictly stubs here,
  88. * which requires 8.1.
  89. */
  90. if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
  91. return TCL_ERROR;
  92. }
  93.  
  94. Tcl_CreateObjCommand(interp, "fribidi_log2vis", (Tcl_ObjCmdProc *) fribidi_log2visCmd,
  95. (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
  96.  
  97. return TCL_OK;
  98. }