Main Page | Data Structures | Directories | File List | Data Fields | Globals

tclSadie_getset.c

Go to the documentation of this file.
00001 
00021 /* This file is part of tclSadie.
00022 
00023    tclSadie is free software; you can redistribute it and/or modify it
00024    under the terms of the GNU General Public License as published by
00025    the Free Software Foundation; either version 2 of the License, or
00026    (at your option) any later version.
00027 
00028    tclSadie is distributed in the hope that it will be useful, but
00029    WITHOUT ANY WARRANTY; without even the implied warranty of
00030    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
00031    General Public License for more details.
00032 
00033    You should have received a copy of the GNU General Public License
00034    along with tclSadie; if not, write to the Free Software Foundation,
00035    Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA.  */
00036 
00037 #if HAVE_CONFIG_H
00038 #include <config.h>
00039 #endif /* HAVE_CONFIG_H */
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, /*  I  Tcl interpreter. */
00421                        Tcl_Obj *objPtr,    /*  I  the Tcl object. */
00422                        uint64_t *uintPtr)  /*  O  store the int here. */
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 /*-Copyright Information------------------------------------------------------*/
00689 /* Copyright (c) 2004 by the University of Arizona Digital Image Analysis Lab */
00690 /*----------------------------------------------------------------------------*/
00691 /*-General Information--------------------------------------------------------*/
00692 /*                                                                            */
00693 /*   This utility function obtains a hashable string from the Tcl object      */
00694 /*   representaion of a SADIE image given by a Tcl array name and index.      */
00695 /*                                                                            */
00696 /*----------------------------------------------------------------------------*/
00697 /*-Interface Information------------------------------------------------------*/
00698 int
00699 GetSadieDkeyFromObj2 (Tcl_Interp *interp,   /*  I  Tcl interpreter. */
00700                       Tcl_Obj *arrayobjPtr, /*  I  the Tcl array object. */
00701                       const char *ixname,   /*  I  array index string. */
00702                       const char **dkeyhandle)  /*  O  string key handle. */
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 

Generated on Fri Jul 8 14:55:01 2005 for tclSadie by  doxygen 1.4.2