Posted to tcl by patthoyts at Tue Jun 10 22:48:33 GMT 2008view raw
- static int
- BinaryEncodeHex(ClientData clientData, Tcl_Interp *interp,
- int objc, Tcl_Obj *const objv[])
- {
- Tcl_Obj *resultObj = NULL;
- Tcl_Obj *stateObj = NULL;
- Tcl_Obj *statevarObj = NULL;
- unsigned char *data = NULL, *input = NULL, *state = NULL;
- unsigned char *cursor = NULL;
- const char *digits = clientData;
- int i, index, offset = 0, count = 0, state_count = 0;
- enum {OPT_STATE};
- static const char *optStrings[] = { "-state", NULL };
- if (objc < 2 || objc%2 != 0) {
- Tcl_WrongNumArgs(interp, 1, objv, "?-state varname? data");
- return TCL_ERROR;
- }
- for (i = 1; i < objc-1; i += 2) {
- if (Tcl_GetIndexFromObj(interp, objv[i], optStrings,
- "option", TCL_EXACT, &index) != TCL_OK) {
- return TCL_ERROR;
- }
- switch (index) {
- case OPT_STATE: {
- statevarObj = objv[i+1];
- stateObj = Tcl_ObjGetVar2(interp, statevarObj,
- NULL, TCL_LEAVE_ERR_MSG);
- if (stateObj == NULL) {
- return TCL_ERROR;
- }
- break;
- }
- }
- }
- TclNewObj(resultObj);
- data = input = Tcl_GetByteArrayFromObj(objv[objc-1], &count);
- if (stateObj) {
- data = state = Tcl_GetByteArrayFromObj(stateObj, &state_count);
- count += state_count;
- }
- cursor = Tcl_SetByteArrayLength(resultObj, count * 2);
- for (offset = 0; offset < count; ++offset) {
- if (state && offset >= state_count) {
- data = input;
- state = NULL;
- }
- *cursor++ = digits[((*data >> 4) & 0x0f)];
- *cursor++ = digits[( *data & 0x0f)];
- ++data;
- }
- if (statevarObj) {
- /*
- * the hex encoding never has any data left over so we always
- * set the state to an empty byte array.
- */
- Tcl_Obj *excessObj = Tcl_NewByteArrayObj(NULL, 0);
- Tcl_ObjSetVar2(interp, statevarObj, NULL, excessObj, 0);
- }
- Tcl_SetObjResult(interp, resultObj);
- return TCL_OK;
- }