00001
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037 #if HAVE_CONFIG_H
00038 #include <config.h>
00039 #endif
00040 #include <tcl.h>
00041 #include <tk.h>
00042 #include <sadie.h>
00043 #include "tclsadie.h"
00044
00052 Tcl_Obj *
00053 NewSadieImageObj (IMAGE *img)
00054 {
00055 char strbuf[SLEN];
00056
00057 if (img == NULL)
00058 return NULL;
00059 snprintf (strbuf, SLEN - 1, "%lx", (unsigned long) img);
00060 return Tcl_NewStringObj (strbuf, -1);
00061 }
00062
00072 int
00073 GetSadieImageFromObj (Tcl_Obj *objPtr, IMAGE **imagehandle)
00074 {
00075 const char *hex_image = NULL;
00076 unsigned long raw_image;
00077 int len;
00078
00079 if ((imagehandle == NULL) || (objPtr == NULL))
00080 return TCL_ERROR;
00081 *imagehandle = NULL;
00082 hex_image = Tcl_GetStringFromObj (objPtr, &len);
00083 if (len == 0)
00084 return TCL_ERROR;
00085 sscanf (hex_image, "%lx", &raw_image);
00086 *imagehandle = (IMAGE *) raw_image;
00087 return TCL_OK;
00088 }
00089
00101 int
00102 SetSadieNamedImageResult (Tcl_Interp *interp, IMAGE *imagePtr,
00103 Tcl_Obj *nameobjPtr)
00104 {
00105 Tcl_Obj * objPtr;
00106
00107 if ((interp == NULL) || (nameobjPtr == NULL))
00108 return TCL_ERROR;
00109 if (imagePtr != NULL)
00110 {
00111 strncpy (imagePtr->text, Tcl_GetString(nameobjPtr), TLEN - 1);
00112 objPtr = NewSadieImageObj (imagePtr);
00113 if (objPtr != NULL)
00114 Tcl_SetObjResult (interp, objPtr);
00115 }
00116 return TCL_OK;
00117 }
00118
00133 int
00134 GetSadieImageFromObj2 (Tcl_Interp *interp, Tcl_Obj *arrayobjPtr,
00135 const char *ixname, IMAGE **imagehandle)
00136 {
00137 Tcl_Obj *indexobjPtr = NULL;
00138 Tcl_Obj *valueobjPtr = NULL;
00139 const char *hex_image = NULL;
00140 unsigned long raw_image;
00141 int len;
00142 int err = TCL_OK;
00143
00144 if ((interp == NULL) || (imagehandle == NULL) || (arrayobjPtr == NULL))
00145 return TCL_ERROR;
00146 *imagehandle = NULL;
00147 if (ixname != NULL)
00148 {
00149 indexobjPtr = Tcl_NewStringObj (ixname, -1);
00150 if (indexobjPtr == NULL)
00151 err = TCL_ERROR;
00152 else
00153 Tcl_IncrRefCount (indexobjPtr);
00154 }
00155 if (err == TCL_OK)
00156 {
00157 valueobjPtr = Tcl_ObjGetVar2 (interp, arrayobjPtr, indexobjPtr,
00158 TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
00159 if (valueobjPtr == NULL)
00160 err = TCL_ERROR;
00161 else
00162 {
00163 Tcl_IncrRefCount (valueobjPtr);
00164 hex_image = Tcl_GetStringFromObj (valueobjPtr, &len);
00165 if (len == 0)
00166 err = TCL_ERROR;
00167 else
00168 {
00169 sscanf (hex_image, "%lx", &raw_image);
00170 *imagehandle = (IMAGE *) raw_image;
00171 }
00172 Tcl_DecrRefCount (valueobjPtr);
00173 }
00174 if (indexobjPtr != NULL)
00175 Tcl_DecrRefCount (indexobjPtr);
00176 }
00177 return err;
00178 }
00179
00191 Tcl_Obj *
00192 NewSadieImageObj2 (Tcl_Interp *interp, Tcl_Obj *arrayobjPtr,
00193 const char *ixname, IMAGE *imagePtr)
00194 {
00195 Tcl_Obj *indexobjPtr = NULL;
00196 Tcl_Obj *nameobjPtr = NULL;
00197 Tcl_Obj *newobjPtr = NULL;
00198 char strbuf[SLEN];
00199 int err = TCL_OK;
00200
00201 if ((interp == NULL) || (imagePtr == NULL) || (arrayobjPtr == NULL)
00202 || (!CHECKIMG (imagePtr)))
00203 return NULL;
00204 if (ixname != NULL)
00205 {
00206 indexobjPtr = Tcl_NewStringObj (ixname, -1);
00207 if (indexobjPtr == NULL)
00208 err = TCL_ERROR;
00209 else
00210 Tcl_IncrRefCount (indexobjPtr);
00211 }
00212 if (err == TCL_OK)
00213 {
00214 nameobjPtr = Tcl_ObjGetVar2 (interp, arrayobjPtr, indexobjPtr,
00215 TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
00216 if (nameobjPtr == NULL)
00217 err = TCL_ERROR;
00218 else
00219 {
00220 Tcl_IncrRefCount (nameobjPtr);
00221 strncpy (imagePtr->text, Tcl_GetString(nameobjPtr), TLEN - 1);
00222 snprintf (strbuf, SLEN - 1, "%lx", (unsigned long) imagePtr);
00223 newobjPtr = Tcl_NewStringObj (strbuf, -1);
00224 Tcl_DecrRefCount (nameobjPtr);
00225 }
00226 if (indexobjPtr != NULL)
00227 Tcl_DecrRefCount (indexobjPtr);
00228 }
00229 return (err == TCL_OK) ? newobjPtr : NULL;
00230 }
00231
00245 int
00246 SetSadieImageObj2 (Tcl_Interp *interp, Tcl_Obj *arrayobjPtr,
00247 const char *ixname, IMAGE *imagePtr)
00248 {
00249 Tcl_Obj *indexobjPtr = NULL;
00250 Tcl_Obj *nameobjPtr = NULL;
00251 char strbuf[SLEN];
00252 int err = TCL_OK;
00253
00254 if ((interp == NULL) || (imagePtr == NULL) || (arrayobjPtr == NULL)
00255 || (!CHECKIMG (imagePtr)))
00256 return TCL_ERROR;
00257 if (ixname != NULL)
00258 {
00259 indexobjPtr = Tcl_NewStringObj (ixname, -1);
00260 if (indexobjPtr == NULL)
00261 err = TCL_ERROR;
00262 else
00263 Tcl_IncrRefCount (indexobjPtr);
00264 }
00265 if (err == TCL_OK)
00266 {
00267 nameobjPtr = Tcl_ObjGetVar2 (interp, arrayobjPtr, indexobjPtr,
00268 TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
00269 if (nameobjPtr == NULL)
00270 err = TCL_ERROR;
00271 else
00272 {
00273 Tcl_IncrRefCount (nameobjPtr);
00274 strncpy (imagePtr->text, Tcl_GetString(nameobjPtr), TLEN - 1);
00275 snprintf (strbuf, SLEN - 1, "%lx", (unsigned long) imagePtr);
00276 Tcl_SetObjResult (interp, Tcl_NewStringObj (strbuf, -1));
00277 Tcl_DecrRefCount (nameobjPtr);
00278 }
00279 if (indexobjPtr != NULL)
00280 Tcl_DecrRefCount (indexobjPtr);
00281 }
00282 return err;
00283 }
00284
00300 int
00301 SetSadieComponentObj2 (Tcl_Interp *interp, Tcl_Obj *arrayobjPtr,
00302 const char **ixname, IMAGE **comp_image)
00303 {
00304 Tcl_Obj *comp_obj[2] = { NULL, NULL };
00305
00306 if ((!interp) || (!comp_image) || (!arrayobjPtr) || (!ixname)
00307 || (!ixname[0]) || (!ixname[1])
00308 || (!CHECKIMG (comp_image[0])) || (!CHECKIMG (comp_image[1])))
00309 return TCL_ERROR;
00310 comp_obj[0] = NewSadieImageObj2 (interp, arrayobjPtr, ixname[0],
00311 comp_image[0]);
00312 if (comp_obj[0] != NULL)
00313 Tcl_IncrRefCount (comp_obj[0]);
00314 else
00315 return TCL_ERROR;
00316 comp_obj[1] = NewSadieImageObj2 (interp, arrayobjPtr, ixname[1],
00317 comp_image[1]);
00318 if (comp_obj[1] != NULL)
00319 Tcl_IncrRefCount (comp_obj[1]);
00320 else
00321 {
00322 Tcl_DecrRefCount (comp_obj[0]);
00323 return TCL_ERROR;
00324 }
00325 Tcl_SetObjResult (interp, Tcl_NewListObj (2, comp_obj));
00326 Tcl_DecrRefCount (comp_obj[0]);
00327 Tcl_DecrRefCount (comp_obj[1]);
00328 return TCL_OK;
00329 }
00330
00344 int
00345 GetSadiePixelFromObj2 (Tcl_Interp *interp, Tcl_Obj *arrayobjPtr,
00346 const char *ixname, PIXEL *pixelPtr)
00347 {
00348 Tcl_Obj *indexobjPtr = NULL;
00349 Tcl_Obj *valueobjPtr = NULL;
00350 double raw_pixel;
00351 int err = TCL_OK;
00352
00353 if ((interp == NULL) || (pixelPtr == NULL) || (arrayobjPtr == NULL))
00354 return TCL_ERROR;
00355 *pixelPtr = 0;
00356 if (ixname != NULL)
00357 {
00358 indexobjPtr = Tcl_NewStringObj (ixname, -1);
00359 if (indexobjPtr == NULL)
00360 err = TCL_ERROR;
00361 else
00362 Tcl_IncrRefCount (indexobjPtr);
00363 }
00364 if (err == TCL_OK)
00365 {
00366 valueobjPtr = Tcl_ObjGetVar2 (interp, arrayobjPtr, indexobjPtr,
00367 TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
00368 if (valueobjPtr == NULL)
00369 err = TCL_ERROR;
00370 else
00371 {
00372 Tcl_IncrRefCount (valueobjPtr);
00373 err = Tcl_GetDoubleFromObj (interp, valueobjPtr, &raw_pixel);
00374 if (err == TCL_OK)
00375 *pixelPtr = (PIXEL) raw_pixel;
00376 Tcl_DecrRefCount (valueobjPtr);
00377 }
00378 if (indexobjPtr != NULL)
00379 Tcl_DecrRefCount (indexobjPtr);
00380 }
00381 return err;
00382 }
00383
00394 int
00395 GetSadieUintFromObj (Tcl_Interp *interp, Tcl_Obj *objPtr, uint32_t *uintPtr)
00396 {
00397 long raw_value;
00398 int err = TCL_OK;
00399
00400 if ((interp == NULL) || (uintPtr == NULL) || (objPtr == NULL))
00401 return TCL_ERROR;
00402 *uintPtr = 0;
00403 err = Tcl_GetLongFromObj (interp, objPtr, &raw_value);
00404 if (err == TCL_OK)
00405 *uintPtr = (uint32_t) raw_value;
00406 return err;
00407 }
00408
00419 int
00420 GetSadieUint64FromObj (Tcl_Interp *interp,
00421 Tcl_Obj *objPtr,
00422 uint64_t *uintPtr)
00423 {
00424 #ifdef HAVE_TCL_WIDEINT
00425 Tcl_WideInt raw_value;
00426 #else
00427 long raw_value;
00428 #endif
00429 int err = TCL_OK;
00430
00431 if ((interp == NULL) || (uintPtr == NULL) || (objPtr == NULL))
00432 return TCL_ERROR;
00433 *uintPtr = 0;
00434 #ifdef HAVE_TCL_WIDEINT
00435 err = Tcl_GetWideIntFromObj (interp, objPtr, &raw_value);
00436 #else
00437 err = Tcl_GetLongFromObj (interp, objPtr, &raw_value);
00438 #endif
00439 if (err == TCL_OK)
00440 *uintPtr = (uint64_t) raw_value;
00441 return err;
00442 }
00443
00457 int
00458 GetSadieUintFromObj2 (Tcl_Interp *interp, Tcl_Obj *arrayobjPtr,
00459 const char *ixname, uint32_t *uintPtr)
00460 {
00461 Tcl_Obj *indexobjPtr = NULL;
00462 Tcl_Obj *valueobjPtr = NULL;
00463 long raw_value;
00464 int err = TCL_OK;
00465
00466 if ((interp == NULL) || (uintPtr == NULL) || (arrayobjPtr == NULL))
00467 return TCL_ERROR;
00468 *uintPtr = 0;
00469 if (ixname != NULL)
00470 {
00471 indexobjPtr = Tcl_NewStringObj (ixname, -1);
00472 if (indexobjPtr == NULL)
00473 err = TCL_ERROR;
00474 else
00475 Tcl_IncrRefCount (indexobjPtr);
00476 }
00477 if (err == TCL_OK)
00478 {
00479 valueobjPtr = Tcl_ObjGetVar2 (interp, arrayobjPtr, indexobjPtr,
00480 TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
00481 if (valueobjPtr == NULL)
00482 err = TCL_ERROR;
00483 else
00484 {
00485 Tcl_IncrRefCount (valueobjPtr);
00486 err = Tcl_GetLongFromObj (interp, valueobjPtr, &raw_value);
00487 if (err == TCL_OK)
00488 *uintPtr = (uint32_t) raw_value;
00489 Tcl_DecrRefCount (valueobjPtr);
00490 }
00491 if (indexobjPtr != NULL)
00492 Tcl_DecrRefCount (indexobjPtr);
00493 }
00494 return err;
00495 }
00496
00510 int
00511 GetSadieIntFromObj2 (Tcl_Interp *interp, Tcl_Obj *arrayobjPtr,
00512 const char *ixname, int *intPtr)
00513 {
00514 Tcl_Obj *indexobjPtr = NULL;
00515 Tcl_Obj *valueobjPtr = NULL;
00516 int err = TCL_OK;
00517
00518 if ((interp == NULL) || (intPtr == NULL) || (arrayobjPtr == NULL))
00519 return TCL_ERROR;
00520 *intPtr = 0;
00521 if (ixname != NULL)
00522 {
00523 indexobjPtr = Tcl_NewStringObj (ixname, -1);
00524 if (indexobjPtr == NULL)
00525 err = TCL_ERROR;
00526 else
00527 Tcl_IncrRefCount (indexobjPtr);
00528 }
00529 if (err == TCL_OK)
00530 {
00531 valueobjPtr = Tcl_ObjGetVar2 (interp, arrayobjPtr, indexobjPtr,
00532 TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
00533 if (valueobjPtr == NULL)
00534 err = TCL_ERROR;
00535 else
00536 {
00537 Tcl_IncrRefCount (valueobjPtr);
00538 err = Tcl_GetIntFromObj (interp, valueobjPtr, intPtr);
00539 Tcl_DecrRefCount (valueobjPtr);
00540 }
00541 if (indexobjPtr != NULL)
00542 Tcl_DecrRefCount (indexobjPtr);
00543 }
00544 return err;
00545 }
00546
00560 int
00561 GetSadieDoubleFromObj2 (Tcl_Interp *interp, Tcl_Obj *arrayobjPtr,
00562 const char *ixname, double *doublePtr)
00563 {
00564 Tcl_Obj *indexobjPtr = NULL;
00565 Tcl_Obj *valueobjPtr = NULL;
00566 int err = TCL_OK;
00567
00568 if ((interp == NULL) || (doublePtr == NULL) || (arrayobjPtr == NULL))
00569 return TCL_ERROR;
00570 *doublePtr = 0;
00571 if (ixname != NULL)
00572 {
00573 indexobjPtr = Tcl_NewStringObj (ixname, -1);
00574 if (indexobjPtr == NULL)
00575 err = TCL_ERROR;
00576 else
00577 Tcl_IncrRefCount (indexobjPtr);
00578 }
00579 if (err == TCL_OK)
00580 {
00581 valueobjPtr = Tcl_ObjGetVar2 (interp, arrayobjPtr, indexobjPtr,
00582 TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
00583 if (valueobjPtr == NULL)
00584 err = TCL_ERROR;
00585 else
00586 {
00587 Tcl_IncrRefCount (valueobjPtr);
00588 err = Tcl_GetDoubleFromObj (interp, valueobjPtr, doublePtr);
00589 Tcl_DecrRefCount (valueobjPtr);
00590 }
00591 if (indexobjPtr != NULL)
00592 Tcl_DecrRefCount (indexobjPtr);
00593 }
00594 return err;
00595 }
00596
00616 int
00617 GetSadieBooleanFromObj2 (Tcl_Interp *interp, Tcl_Obj *arrayobjPtr,
00618 const char *ixname, int *boolPtr)
00619 {
00620 Tcl_Obj *indexobjPtr = NULL;
00621 Tcl_Obj *valueobjPtr = NULL;
00622 int err = TCL_OK;
00623
00624 if ((interp == NULL) || (boolPtr == NULL) || (arrayobjPtr == NULL))
00625 return TCL_ERROR;
00626 *boolPtr = 0;
00627 if (ixname != NULL)
00628 {
00629 indexobjPtr = Tcl_NewStringObj (ixname, -1);
00630 if (indexobjPtr == NULL)
00631 err = TCL_ERROR;
00632 else
00633 Tcl_IncrRefCount (indexobjPtr);
00634 }
00635 if (err == TCL_OK)
00636 {
00637 valueobjPtr = Tcl_ObjGetVar2 (interp, arrayobjPtr, indexobjPtr,
00638 TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
00639 if (valueobjPtr == NULL)
00640 err = TCL_ERROR;
00641 else
00642 {
00643 Tcl_IncrRefCount (valueobjPtr);
00644 err = Tcl_GetBooleanFromObj (interp, valueobjPtr, boolPtr);
00645 Tcl_DecrRefCount (valueobjPtr);
00646 }
00647 if (indexobjPtr != NULL)
00648 Tcl_DecrRefCount (indexobjPtr);
00649 }
00650 return err;
00651 }
00652
00663 int
00664 GetSadieDkeyFromObj (Tcl_Obj *objPtr, const char ** dkeyhandle)
00665 {
00666 int len;
00667
00668 if ((dkeyhandle == NULL) || (objPtr == NULL))
00669 return TCL_ERROR;
00670 *dkeyhandle = Tcl_GetStringFromObj (objPtr, &len);
00671 return (len == 0) ? TCL_ERROR : TCL_OK;
00672 }
00673
00688
00689
00690
00691
00692
00693
00694
00695
00696
00697
00698 int
00699 GetSadieDkeyFromObj2 (Tcl_Interp *interp,
00700 Tcl_Obj *arrayobjPtr,
00701 const char *ixname,
00702 const char **dkeyhandle)
00703 {
00704 Tcl_Obj *indexobjPtr = NULL;
00705 Tcl_Obj *valueobjPtr = NULL;
00706 int err = TCL_OK;
00707
00708 if ((interp == NULL) || (dkeyhandle == NULL) || (arrayobjPtr == NULL))
00709 return TCL_ERROR;
00710 *dkeyhandle = NULL;
00711 if (ixname != NULL)
00712 {
00713 indexobjPtr = Tcl_NewStringObj (ixname, -1);
00714 if (indexobjPtr == NULL)
00715 err = TCL_ERROR;
00716 else
00717 Tcl_IncrRefCount (indexobjPtr);
00718 }
00719 if (err == TCL_OK)
00720 {
00721 valueobjPtr = Tcl_ObjGetVar2 (interp, arrayobjPtr, indexobjPtr,
00722 TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
00723 if (valueobjPtr == NULL)
00724 err = TCL_ERROR;
00725 else
00726 {
00727 Tcl_IncrRefCount (valueobjPtr);
00728 err = GetSadieDkeyFromObj (valueobjPtr, dkeyhandle);
00729 Tcl_DecrRefCount (valueobjPtr);
00730 }
00731 if (indexobjPtr != NULL)
00732 Tcl_DecrRefCount (indexobjPtr);
00733 }
00734 return err;
00735 }
00736
00737