Sadie_NewFunctions.c Source File

00001 /*
00002 ##########################################
00003 # Sadie_NewFunctions.c -
00004 #   Set of routines for linking SADIE routines to create
00005 #   new images into tcl/tk.
00006 #
00007 # RCS: $Id: Sadie_NewFunctions.c,v 2.5 2000/08/08 22:54:32 giri Exp $ 
00008 # 
00009 # Digital Image Analysis Lab
00010 # Dept. of Electrical and Computer Engineering
00011 # University of Arizona
00012 ##########################################
00013 */
00014 
00015 #include <tcl.h>
00016 #include <tk.h>
00017 #include "sadie.h"
00018 
00019 /* RCS Indentification information */
00020 static char rcsid[] =
00021   "$Id: Sadie_NewFunctions.c,v 2.5 2000/08/08 22:54:32 giri Exp $";
00022 
00023 /*-Copyright Information------------------------------------------------------*/
00024 /* Copyright (c) 1999 by the University of Arizona Digital Image Analysis Lab */
00025 /*----------------------------------------------------------------------------*/
00026 /*-General Information--------------------------------------------------------*/
00027 /*                                                                            */
00028 /*   This procedure provides an interface to the SADIE function               */
00029 /*   SINEWAVE from Tcl/Tk.  It expects a tcl global array                     */
00030 /*   with these indices to exist:                                             */
00031 /*      array(lines)              --  int                                     */
00032 /*      array(pix)                --  int                                     */
00033 /*      array(period)             --  double                                  */
00034 /*      array(phase)              --  double                                  */
00035 /*      array(outname)            --  char*                                   */
00036 /*                                                                            */
00037 /*----------------------------------------------------------------------------*/
00038 /*-Interface Information------------------------------------------------------*/
00039 int
00040 Sadie_NewFunctions_SineWaveCmd (ClientData client_data, Tcl_Interp * interp,
00041                                 int argc, char *argv[])
00042 {
00043   Tcl_Obj *tclobj = NULL;
00044   Tcl_Obj *tclarrayname = NULL;
00045   Tcl_Obj *tclindexname = NULL;
00046   char msg[SLEN];
00047   char *array = NULL;
00048   char *tempstr = NULL;
00049   int strlen;
00050   int outimgaddr;
00051   IMAGE *outimg = NULL;
00052   char *outname = NULL;
00053   int lines, pix;
00054   double period, phase;
00055 
00056   if (argc != 2)
00057     {
00058       Tcl_AppendResult (interp, "wrong # args: should be \"",
00059                         argv[0], " arrayname\"", (char *) NULL);
00060       return TCL_ERROR;
00061     }
00062   array = argv[1];
00063 
00064   /* Read the input integer array(lines) */
00065   tclarrayname = Tcl_NewStringObj (array, -1);
00066   tclindexname = Tcl_NewStringObj ("lines", -1);
00067   if (tclobj =
00068       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00069                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00070     {
00071       if (Tcl_GetIntFromObj (interp, tclobj, &lines) == TCL_ERROR)
00072         return TCL_ERROR;
00073     }
00074   else
00075     {
00076       return TCL_ERROR;
00077     }
00078   Tcl_DecrRefCount (tclarrayname);
00079   Tcl_DecrRefCount (tclindexname);
00080 
00081   /* Read the input integer array(pix) */
00082   tclarrayname = Tcl_NewStringObj (array, -1);
00083   tclindexname = Tcl_NewStringObj ("pix", -1);
00084   if (tclobj =
00085       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00086                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00087     {
00088       if (Tcl_GetIntFromObj (interp, tclobj, &pix) == TCL_ERROR)
00089         return TCL_ERROR;
00090     }
00091   else
00092     {
00093       return TCL_ERROR;
00094     }
00095   Tcl_DecrRefCount (tclarrayname);
00096   Tcl_DecrRefCount (tclindexname);
00097 
00098   /* Read the input double array(period) */
00099   tclarrayname = Tcl_NewStringObj (array, -1);
00100   tclindexname = Tcl_NewStringObj ("period", -1);
00101   if (tclobj =
00102       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00103                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00104     {
00105       if (Tcl_GetDoubleFromObj (interp, tclobj, &period) == TCL_ERROR)
00106         return TCL_ERROR;
00107     }
00108   else
00109     {
00110       return TCL_ERROR;
00111     }
00112   Tcl_DecrRefCount (tclarrayname);
00113   Tcl_DecrRefCount (tclindexname);
00114 
00115   /* Read the input double array(phase) */
00116   tclarrayname = Tcl_NewStringObj (array, -1);
00117   tclindexname = Tcl_NewStringObj ("phase", -1);
00118   if (tclobj =
00119       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00120                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00121     {
00122       if (Tcl_GetDoubleFromObj (interp, tclobj, &phase) == TCL_ERROR)
00123         return TCL_ERROR;
00124     }
00125   else
00126     {
00127       return TCL_ERROR;
00128     }
00129   Tcl_DecrRefCount (tclarrayname);
00130   Tcl_DecrRefCount (tclindexname);
00131 
00132   /* Read the output image 1 name */
00133   tclarrayname = Tcl_NewStringObj (array, -1);
00134   tclindexname = Tcl_NewStringObj ("outname", -1);
00135   if (tclobj =
00136       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00137                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00138     {
00139       outname = Tcl_GetStringFromObj (tclobj, &strlen);
00140       if (strlen <= 0)
00141         return TCL_ERROR;
00142     }
00143   else
00144     {
00145       return TCL_ERROR;
00146     }
00147   Tcl_DecrRefCount (tclarrayname);
00148   Tcl_DecrRefCount (tclindexname);
00149 
00150   SINEWAVE (lines, pix, period, phase, &outimg);
00151 
00152   if (CHECKIMG (outimg))
00153     sprintf (outimg->text, "%s", outname);
00154   outimgaddr = (int) outimg;
00155 
00156   sprintf (msg, "%x", outimgaddr);
00157   Tcl_SetResult (interp, msg, TCL_VOLATILE);
00158 
00159   return TCL_OK;
00160 }
00161 
00162 /*-Copyright Information------------------------------------------------------*/
00163 /* Copyright (c) 1999 by the University of Arizona Digital Image Analysis Lab */
00164 /*----------------------------------------------------------------------------*/
00165 /*-General Information--------------------------------------------------------*/
00166 /*                                                                            */
00167 /*   This procedure provides an interface to the SADIE function               */
00168 /*   CHIRP from Tcl/Tk.  It expects a tcl global array                        */
00169 /*   with these indices to exist:                                             */
00170 /*      array(lines)              --  int                                     */
00171 /*      array(pix)                --  int                                     */
00172 /*      array(period)             --  double                                  */
00173 /*      array(outname)            --  char*                                   */
00174 /*                                                                            */
00175 /*----------------------------------------------------------------------------*/
00176 /*-Interface Information------------------------------------------------------*/
00177 int
00178 Sadie_NewFunctions_ChirpCmd (ClientData client_data, Tcl_Interp * interp,
00179                              int argc, char *argv[])
00180 {
00181   Tcl_Obj *tclobj = NULL;
00182   Tcl_Obj *tclarrayname = NULL;
00183   Tcl_Obj *tclindexname = NULL;
00184   char msg[SLEN];
00185   char *array = NULL;
00186   char *tempstr = NULL;
00187   int strlen;
00188   int outimgaddr;
00189   IMAGE *outimg = NULL;
00190   char *outname = NULL;
00191   int lines, pix;
00192   double period;
00193 
00194   if (argc != 2)
00195     {
00196       Tcl_AppendResult (interp, "wrong # args: should be \"",
00197                         argv[0], " arrayname\"", (char *) NULL);
00198       return TCL_ERROR;
00199     }
00200   array = argv[1];
00201 
00202   /* Read the input integer array(lines) */
00203   tclarrayname = Tcl_NewStringObj (array, -1);
00204   tclindexname = Tcl_NewStringObj ("lines", -1);
00205   if (tclobj =
00206       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00207                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00208     {
00209       if (Tcl_GetIntFromObj (interp, tclobj, &lines) == TCL_ERROR)
00210         return TCL_ERROR;
00211     }
00212   else
00213     {
00214       return TCL_ERROR;
00215     }
00216   Tcl_DecrRefCount (tclarrayname);
00217   Tcl_DecrRefCount (tclindexname);
00218 
00219   /* Read the input integer array(pix) */
00220   tclarrayname = Tcl_NewStringObj (array, -1);
00221   tclindexname = Tcl_NewStringObj ("pix", -1);
00222   if (tclobj =
00223       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00224                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00225     {
00226       if (Tcl_GetIntFromObj (interp, tclobj, &pix) == TCL_ERROR)
00227         return TCL_ERROR;
00228     }
00229   else
00230     {
00231       return TCL_ERROR;
00232     }
00233   Tcl_DecrRefCount (tclarrayname);
00234   Tcl_DecrRefCount (tclindexname);
00235 
00236   /* Read the input double array(period) */
00237   tclarrayname = Tcl_NewStringObj (array, -1);
00238   tclindexname = Tcl_NewStringObj ("period", -1);
00239   if (tclobj =
00240       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00241                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00242     {
00243       if (Tcl_GetDoubleFromObj (interp, tclobj, &period) == TCL_ERROR)
00244         return TCL_ERROR;
00245     }
00246   else
00247     {
00248       return TCL_ERROR;
00249     }
00250   Tcl_DecrRefCount (tclarrayname);
00251   Tcl_DecrRefCount (tclindexname);
00252 
00253   /* Read the output image 1 name */
00254   tclarrayname = Tcl_NewStringObj (array, -1);
00255   tclindexname = Tcl_NewStringObj ("outname", -1);
00256   if (tclobj =
00257       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00258                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00259     {
00260       outname = Tcl_GetStringFromObj (tclobj, &strlen);
00261       if (strlen <= 0)
00262         return TCL_ERROR;
00263     }
00264   else
00265     {
00266       return TCL_ERROR;
00267     }
00268   Tcl_DecrRefCount (tclarrayname);
00269   Tcl_DecrRefCount (tclindexname);
00270 
00271   CHIRP (lines, pix, period, &outimg);
00272 
00273   if (CHECKIMG (outimg))
00274     sprintf (outimg->text, "%s", outname);
00275   outimgaddr = (int) outimg;
00276 
00277   sprintf (msg, "%x", outimgaddr);
00278   Tcl_SetResult (interp, msg, TCL_VOLATILE);
00279 
00280   return TCL_OK;
00281 }
00282 
00283 /*-Copyright Information------------------------------------------------------*/
00284 /* Copyright (c) 1999 by the University of Arizona Digital Image Analysis Lab */
00285 /*----------------------------------------------------------------------------*/
00286 /*-General Information--------------------------------------------------------*/
00287 /*                                                                            */
00288 /*   This procedure provides an interface to the SADIE function               */
00289 /*   SINESTAR from Tcl/Tk.  It expects a tcl global array                     */
00290 /*   with these indices to exist:                                             */
00291 /*      array(lines)              --  int                                     */
00292 /*      array(pix)                --  int                                     */
00293 /*      array(period)             --  double                                  */
00294 /*      array(outname)            --  char*                                   */
00295 /*                                                                            */
00296 /*----------------------------------------------------------------------------*/
00297 /*-Interface Information------------------------------------------------------*/
00298 int
00299 Sadie_NewFunctions_SineStarCmd (ClientData client_data, Tcl_Interp * interp,
00300                                 int argc, char *argv[])
00301 {
00302   Tcl_Obj *tclobj = NULL;
00303   Tcl_Obj *tclarrayname = NULL;
00304   Tcl_Obj *tclindexname = NULL;
00305   char msg[SLEN];
00306   char *array = NULL;
00307   char *tempstr = NULL;
00308   int strlen;
00309   int outimgaddr;
00310   IMAGE *outimg = NULL;
00311   char *outname = NULL;
00312   int lines, pix;
00313   double period;
00314 
00315   if (argc != 2)
00316     {
00317       Tcl_AppendResult (interp, "wrong # args: should be \"",
00318                         argv[0], " arrayname\"", (char *) NULL);
00319       return TCL_ERROR;
00320     }
00321   array = argv[1];
00322 
00323   /* Read the input integer array(lines) */
00324   tclarrayname = Tcl_NewStringObj (array, -1);
00325   tclindexname = Tcl_NewStringObj ("lines", -1);
00326   if (tclobj =
00327       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00328                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00329     {
00330       if (Tcl_GetIntFromObj (interp, tclobj, &lines) == TCL_ERROR)
00331         return TCL_ERROR;
00332     }
00333   else
00334     {
00335       return TCL_ERROR;
00336     }
00337   Tcl_DecrRefCount (tclarrayname);
00338   Tcl_DecrRefCount (tclindexname);
00339 
00340   /* Read the input integer array(pix) */
00341   tclarrayname = Tcl_NewStringObj (array, -1);
00342   tclindexname = Tcl_NewStringObj ("pix", -1);
00343   if (tclobj =
00344       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00345                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00346     {
00347       if (Tcl_GetIntFromObj (interp, tclobj, &pix) == TCL_ERROR)
00348         return TCL_ERROR;
00349     }
00350   else
00351     {
00352       return TCL_ERROR;
00353     }
00354   Tcl_DecrRefCount (tclarrayname);
00355   Tcl_DecrRefCount (tclindexname);
00356 
00357   /* Read the input double array(period) */
00358   tclarrayname = Tcl_NewStringObj (array, -1);
00359   tclindexname = Tcl_NewStringObj ("period", -1);
00360   if (tclobj =
00361       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00362                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00363     {
00364       if (Tcl_GetDoubleFromObj (interp, tclobj, &period) == TCL_ERROR)
00365         return TCL_ERROR;
00366     }
00367   else
00368     {
00369       return TCL_ERROR;
00370     }
00371   Tcl_DecrRefCount (tclarrayname);
00372   Tcl_DecrRefCount (tclindexname);
00373 
00374   /* Read the output image 1 name */
00375   tclarrayname = Tcl_NewStringObj (array, -1);
00376   tclindexname = Tcl_NewStringObj ("outname", -1);
00377   if (tclobj =
00378       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00379                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00380     {
00381       outname = Tcl_GetStringFromObj (tclobj, &strlen);
00382       if (strlen <= 0)
00383         return TCL_ERROR;
00384     }
00385   else
00386     {
00387       return TCL_ERROR;
00388     }
00389   Tcl_DecrRefCount (tclarrayname);
00390   Tcl_DecrRefCount (tclindexname);
00391 
00392   SINESTAR (lines, pix, period, &outimg);
00393 
00394   if (CHECKIMG (outimg))
00395     sprintf (outimg->text, "%s", outname);
00396   outimgaddr = (int) outimg;
00397 
00398   sprintf (msg, "%x", outimgaddr);
00399   Tcl_SetResult (interp, msg, TCL_VOLATILE);
00400 
00401   return TCL_OK;
00402 }
00403 
00404 /*-Copyright Information------------------------------------------------------*/
00405 /* Copyright (c) 1999 by the University of Arizona Digital Image Analysis Lab */
00406 /*----------------------------------------------------------------------------*/
00407 /*-General Information--------------------------------------------------------*/
00408 /*                                                                            */
00409 /*   This procedure provides an interface to the SADIE function               */
00410 /*   CHECKER from Tcl/Tk.  It expects a tcl global array                      */
00411 /*   with these indices to exist:                                             */
00412 /*      array(lines)              --  int                                     */
00413 /*      array(pix)                --  int                                     */
00414 /*      array(checklines)         --  int                                     */
00415 /*      array(checkpix)           --  int                                     */
00416 /*      array(outname)            --  char*                                   */
00417 /*                                                                            */
00418 /*----------------------------------------------------------------------------*/
00419 /*-Interface Information------------------------------------------------------*/
00420 int
00421 Sadie_NewFunctions_CheckerboardCmd (ClientData client_data,
00422                                     Tcl_Interp * interp, int argc,
00423                                     char *argv[])
00424 {
00425   Tcl_Obj *tclobj = NULL;
00426   Tcl_Obj *tclarrayname = NULL;
00427   Tcl_Obj *tclindexname = NULL;
00428   char msg[SLEN];
00429   char *array = NULL;
00430   char *tempstr = NULL;
00431   int strlen;
00432   int outimgaddr;
00433   IMAGE *outimg = NULL;
00434   char *outname = NULL;
00435   int lines, pix, checklines, checkpix;
00436 
00437   if (argc != 2)
00438     {
00439       Tcl_AppendResult (interp, "wrong # args: should be \"",
00440                         argv[0], " arrayname\"", (char *) NULL);
00441       return TCL_ERROR;
00442     }
00443   array = argv[1];
00444 
00445   /* Read the input integer array(lines) */
00446   tclarrayname = Tcl_NewStringObj (array, -1);
00447   tclindexname = Tcl_NewStringObj ("lines", -1);
00448   if (tclobj =
00449       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00450                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00451     {
00452       if (Tcl_GetIntFromObj (interp, tclobj, &lines) == TCL_ERROR)
00453         return TCL_ERROR;
00454     }
00455   else
00456     {
00457       return TCL_ERROR;
00458     }
00459   Tcl_DecrRefCount (tclarrayname);
00460   Tcl_DecrRefCount (tclindexname);
00461 
00462   /* Read the input integer array(pix) */
00463   tclarrayname = Tcl_NewStringObj (array, -1);
00464   tclindexname = Tcl_NewStringObj ("pix", -1);
00465   if (tclobj =
00466       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00467                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00468     {
00469       if (Tcl_GetIntFromObj (interp, tclobj, &pix) == TCL_ERROR)
00470         return TCL_ERROR;
00471     }
00472   else
00473     {
00474       return TCL_ERROR;
00475     }
00476   Tcl_DecrRefCount (tclarrayname);
00477   Tcl_DecrRefCount (tclindexname);
00478 
00479   /* Read the input integer array(checklines) */
00480   tclarrayname = Tcl_NewStringObj (array, -1);
00481   tclindexname = Tcl_NewStringObj ("checklines", -1);
00482   if (tclobj =
00483       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00484                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00485     {
00486       if (Tcl_GetIntFromObj (interp, tclobj, &checklines) == TCL_ERROR)
00487         return TCL_ERROR;
00488     }
00489   else
00490     {
00491       return TCL_ERROR;
00492     }
00493   Tcl_DecrRefCount (tclarrayname);
00494   Tcl_DecrRefCount (tclindexname);
00495 
00496   /* Read the input integer array(checkpix) */
00497   tclarrayname = Tcl_NewStringObj (array, -1);
00498   tclindexname = Tcl_NewStringObj ("checkpix", -1);
00499   if (tclobj =
00500       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00501                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00502     {
00503       if (Tcl_GetIntFromObj (interp, tclobj, &checkpix) == TCL_ERROR)
00504         return TCL_ERROR;
00505     }
00506   else
00507     {
00508       return TCL_ERROR;
00509     }
00510   Tcl_DecrRefCount (tclarrayname);
00511   Tcl_DecrRefCount (tclindexname);
00512 
00513   /* Read the output image 1 name */
00514   tclarrayname = Tcl_NewStringObj (array, -1);
00515   tclindexname = Tcl_NewStringObj ("outname", -1);
00516   if (tclobj =
00517       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00518                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00519     {
00520       outname = Tcl_GetStringFromObj (tclobj, &strlen);
00521       if (strlen <= 0)
00522         return TCL_ERROR;
00523     }
00524   else
00525     {
00526       return TCL_ERROR;
00527     }
00528   Tcl_DecrRefCount (tclarrayname);
00529   Tcl_DecrRefCount (tclindexname);
00530 
00531   CHECKER (lines, pix, checklines, checkpix, &outimg);
00532 
00533   if (CHECKIMG (outimg))
00534     sprintf (outimg->text, "%s", outname);
00535   outimgaddr = (int) outimg;
00536 
00537   sprintf (msg, "%x", outimgaddr);
00538   Tcl_SetResult (interp, msg, TCL_VOLATILE);
00539 
00540   return TCL_OK;
00541 }
00542 
00543 /*-Copyright Information------------------------------------------------------*/
00544 /* Copyright (c) 1999 by the University of Arizona Digital Image Analysis Lab */
00545 /*----------------------------------------------------------------------------*/
00546 /*-General Information--------------------------------------------------------*/
00547 /*                                                                            */
00548 /*   This procedure provides an interface to the SADIE function               */
00549 /*   GRAYSCAL from Tcl/Tk.  It expects a tcl global array                      */
00550 /*   with these indices to exist:                                             */
00551 /*      array(lines)              --  int                                     */
00552 /*      array(pix)                --  int                                     */
00553 /*      array(number)             --  int                                     */
00554 /*      array(min)                --  double                                  */
00555 /*      array(max)                --  double                                  */
00556 /*      array(outname)            --  char*                                   */
00557 /*                                                                            */
00558 /*----------------------------------------------------------------------------*/
00559 /*-Interface Information------------------------------------------------------*/
00560 int
00561 Sadie_NewFunctions_GrayScaleCmd (ClientData client_data, Tcl_Interp * interp,
00562                                  int argc, char *argv[])
00563 {
00564   Tcl_Obj *tclobj = NULL;
00565   Tcl_Obj *tclarrayname = NULL;
00566   Tcl_Obj *tclindexname = NULL;
00567   char msg[SLEN];
00568   char *array = NULL;
00569   char *tempstr = NULL;
00570   int strlen;
00571   int outimgaddr;
00572   IMAGE *outimg = NULL;
00573   char *outname = NULL;
00574   int lines, pix, number;
00575   double min, max;
00576 
00577   if (argc != 2)
00578     {
00579       Tcl_AppendResult (interp, "wrong # args: should be \"",
00580                         argv[0], " arrayname\"", (char *) NULL);
00581       return TCL_ERROR;
00582     }
00583   array = argv[1];
00584 
00585   /* Read the input integer array(lines) */
00586   tclarrayname = Tcl_NewStringObj (array, -1);
00587   tclindexname = Tcl_NewStringObj ("lines", -1);
00588   if (tclobj =
00589       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00590                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00591     {
00592       if (Tcl_GetIntFromObj (interp, tclobj, &lines) == TCL_ERROR)
00593         return TCL_ERROR;
00594     }
00595   else
00596     {
00597       return TCL_ERROR;
00598     }
00599   Tcl_DecrRefCount (tclarrayname);
00600   Tcl_DecrRefCount (tclindexname);
00601 
00602   /* Read the input integer array(pix) */
00603   tclarrayname = Tcl_NewStringObj (array, -1);
00604   tclindexname = Tcl_NewStringObj ("pix", -1);
00605   if (tclobj =
00606       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00607                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00608     {
00609       if (Tcl_GetIntFromObj (interp, tclobj, &pix) == TCL_ERROR)
00610         return TCL_ERROR;
00611     }
00612   else
00613     {
00614       return TCL_ERROR;
00615     }
00616   Tcl_DecrRefCount (tclarrayname);
00617   Tcl_DecrRefCount (tclindexname);
00618 
00619   /* Read the input integer array(number) */
00620   tclarrayname = Tcl_NewStringObj (array, -1);
00621   tclindexname = Tcl_NewStringObj ("number", -1);
00622   if (tclobj =
00623       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00624                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00625     {
00626       if (Tcl_GetIntFromObj (interp, tclobj, &number) == TCL_ERROR)
00627         return TCL_ERROR;
00628     }
00629   else
00630     {
00631       return TCL_ERROR;
00632     }
00633   Tcl_DecrRefCount (tclarrayname);
00634   Tcl_DecrRefCount (tclindexname);
00635 
00636   /* Read the input double array(min) */
00637   tclarrayname = Tcl_NewStringObj (array, -1);
00638   tclindexname = Tcl_NewStringObj ("min", -1);
00639   if (tclobj =
00640       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00641                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00642     {
00643       if (Tcl_GetDoubleFromObj (interp, tclobj, &min) == TCL_ERROR)
00644         return TCL_ERROR;
00645     }
00646   else
00647     {
00648       return TCL_ERROR;
00649     }
00650   Tcl_DecrRefCount (tclarrayname);
00651   Tcl_DecrRefCount (tclindexname);
00652 
00653   /* Read the input double array(max) */
00654   tclarrayname = Tcl_NewStringObj (array, -1);
00655   tclindexname = Tcl_NewStringObj ("max", -1);
00656   if (tclobj =
00657       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00658                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00659     {
00660       if (Tcl_GetDoubleFromObj (interp, tclobj, &max) == TCL_ERROR)
00661         return TCL_ERROR;
00662     }
00663   else
00664     {
00665       return TCL_ERROR;
00666     }
00667   Tcl_DecrRefCount (tclarrayname);
00668   Tcl_DecrRefCount (tclindexname);
00669 
00670   /* Read the output image 1 name */
00671   tclarrayname = Tcl_NewStringObj (array, -1);
00672   tclindexname = Tcl_NewStringObj ("outname", -1);
00673   if (tclobj =
00674       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00675                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00676     {
00677       outname = Tcl_GetStringFromObj (tclobj, &strlen);
00678       if (strlen <= 0)
00679         return TCL_ERROR;
00680     }
00681   else
00682     {
00683       return TCL_ERROR;
00684     }
00685   Tcl_DecrRefCount (tclarrayname);
00686   Tcl_DecrRefCount (tclindexname);
00687 
00688   GRAYSCAL (lines, pix, number, min, max, &outimg);
00689 
00690   if (CHECKIMG (outimg))
00691     sprintf (outimg->text, "%s", outname);
00692   outimgaddr = (int) outimg;
00693 
00694   sprintf (msg, "%x", outimgaddr);
00695   Tcl_SetResult (interp, msg, TCL_VOLATILE);
00696 
00697   return TCL_OK;
00698 }
00699 
00700 /*-Copyright Information------------------------------------------------------*/
00701 /* Copyright (c) 1999 by the University of Arizona Digital Image Analysis Lab */
00702 /*----------------------------------------------------------------------------*/
00703 /*-General Information--------------------------------------------------------*/
00704 /*                                                                            */
00705 /*   This procedure provides an interface to the SADIE function               */
00706 /*   FUNCTION from Tcl/Tk.  It expects a tcl global array                     */
00707 /*   with these indices to exist:                                             */
00708 /*      array(lines)              --  int                                     */
00709 /*      array(pix)                --  int                                     */
00710 /*      array(type)               --  int                                     */
00711 /*      array(radiuslines)        --  double                                  */
00712 /*      array(radiuspix)          --  double                                  */
00713 /*      array(outname)            --  char*                                   */
00714 /*                                                                            */
00715 /*----------------------------------------------------------------------------*/
00716 /*-Interface Information------------------------------------------------------*/
00717 int
00718 Sadie_NewFunctions_FunctionCmd (ClientData client_data, Tcl_Interp * interp,
00719                                 int argc, char *argv[])
00720 {
00721   Tcl_Obj *tclobj = NULL;
00722   Tcl_Obj *tclarrayname = NULL;
00723   Tcl_Obj *tclindexname = NULL;
00724   char msg[SLEN];
00725   char *array = NULL;
00726   char *tempstr = NULL;
00727   int strlen;
00728   int outimgaddr;
00729   IMAGE *outimg = NULL;
00730   char *outname = NULL;
00731   int lines, pix, type;
00732   double radiuslines, radiuspix, alpha;
00733 
00734   if (argc != 2)
00735     {
00736       Tcl_AppendResult (interp, "wrong # args: should be \"",
00737                         argv[0], " arrayname\"", (char *) NULL);
00738       return TCL_ERROR;
00739     }
00740   array = argv[1];
00741 
00742   /* Read the input integer array(lines) */
00743   tclarrayname = Tcl_NewStringObj (array, -1);
00744   tclindexname = Tcl_NewStringObj ("lines", -1);
00745   if (tclobj =
00746       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00747                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00748     {
00749       if (Tcl_GetIntFromObj (interp, tclobj, &lines) == TCL_ERROR)
00750         return TCL_ERROR;
00751     }
00752   else
00753     {
00754       return TCL_ERROR;
00755     }
00756   Tcl_DecrRefCount (tclarrayname);
00757   Tcl_DecrRefCount (tclindexname);
00758 
00759   /* Read the input integer array(pix) */
00760   tclarrayname = Tcl_NewStringObj (array, -1);
00761   tclindexname = Tcl_NewStringObj ("pix", -1);
00762   if (tclobj =
00763       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00764                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00765     {
00766       if (Tcl_GetIntFromObj (interp, tclobj, &pix) == TCL_ERROR)
00767         return TCL_ERROR;
00768     }
00769   else
00770     {
00771       return TCL_ERROR;
00772     }
00773   Tcl_DecrRefCount (tclarrayname);
00774   Tcl_DecrRefCount (tclindexname);
00775 
00776   /* Read the input integer array(type) */
00777   tclarrayname = Tcl_NewStringObj (array, -1);
00778   tclindexname = Tcl_NewStringObj ("type", -1);
00779   if (tclobj =
00780       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00781                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00782     {
00783       if (Tcl_GetIntFromObj (interp, tclobj, &type) == TCL_ERROR)
00784         return TCL_ERROR;
00785     }
00786   else
00787     {
00788       return TCL_ERROR;
00789     }
00790   Tcl_DecrRefCount (tclarrayname);
00791   Tcl_DecrRefCount (tclindexname);
00792 
00793   /* Read the input double array(radiuslines) */
00794   tclarrayname = Tcl_NewStringObj (array, -1);
00795   tclindexname = Tcl_NewStringObj ("radiuslines", -1);
00796   if (tclobj =
00797       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00798                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00799     {
00800       if (Tcl_GetDoubleFromObj (interp, tclobj, &radiuslines) == TCL_ERROR)
00801         return TCL_ERROR;
00802     }
00803   else
00804     {
00805       return TCL_ERROR;
00806     }
00807   Tcl_DecrRefCount (tclarrayname);
00808   Tcl_DecrRefCount (tclindexname);
00809 
00810   /* Read the input double array(radiuspix) */
00811   tclarrayname = Tcl_NewStringObj (array, -1);
00812   tclindexname = Tcl_NewStringObj ("radiuspix", -1);
00813   if (tclobj =
00814       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00815                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00816     {
00817       if (Tcl_GetDoubleFromObj (interp, tclobj, &radiuspix) == TCL_ERROR)
00818         return TCL_ERROR;
00819     }
00820   else
00821     {
00822       return TCL_ERROR;
00823     }
00824   Tcl_DecrRefCount (tclarrayname);
00825   Tcl_DecrRefCount (tclindexname);
00826 
00827   /* Read the input double array(alpha) */
00828   tclarrayname = Tcl_NewStringObj (array, -1);
00829   tclindexname = Tcl_NewStringObj ("alpha", -1);
00830   if (tclobj =
00831       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00832                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00833     {
00834       if (Tcl_GetDoubleFromObj (interp, tclobj, &alpha) == TCL_ERROR)
00835         return TCL_ERROR;
00836     }
00837   else
00838     {
00839       return TCL_ERROR;
00840     }
00841   Tcl_DecrRefCount (tclarrayname);
00842   Tcl_DecrRefCount (tclindexname);
00843 
00844   /* Read the output image 1 name */
00845   tclarrayname = Tcl_NewStringObj (array, -1);
00846   tclindexname = Tcl_NewStringObj ("outname", -1);
00847   if (tclobj =
00848       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00849                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00850     {
00851       outname = Tcl_GetStringFromObj (tclobj, &strlen);
00852       if (strlen <= 0)
00853         return TCL_ERROR;
00854     }
00855   else
00856     {
00857       return TCL_ERROR;
00858     }
00859   Tcl_DecrRefCount (tclarrayname);
00860   Tcl_DecrRefCount (tclindexname);
00861 
00862   FUNCTION (lines, pix, radiuslines, radiuspix, alpha, type, &outimg);
00863 
00864   if (CHECKIMG (outimg))
00865     sprintf (outimg->text, "%s", outname);
00866   outimgaddr = (int) outimg;
00867 
00868   sprintf (msg, "%x", outimgaddr);
00869   Tcl_SetResult (interp, msg, TCL_VOLATILE);
00870 
00871   return TCL_OK;
00872 }
00873 
00874 /*-Copyright Information------------------------------------------------------*/
00875 /* Copyright (c) 1999 by the University of Arizona Digital Image Analysis Lab */
00876 /*----------------------------------------------------------------------------*/
00877 /*-General Information--------------------------------------------------------*/
00878 /*                                                                            */
00879 /*   This procedure provides an interface to the SADIE function               */
00880 /*   RANDOM from Tcl/Tk.  It expects a tcl global array                       */
00881 /*   with these indices to exist:                                             */
00882 /*      array(lines)              --  int                                     */
00883 /*      array(pix)                --  int                                     */
00884 /*      array(type)               --  int                                     */
00885 /*      array(deviation)          --  double                                  */
00886 /*      array(outname)            --  char*                                   */
00887 /*                                                                            */
00888 /*----------------------------------------------------------------------------*/
00889 /*-Interface Information------------------------------------------------------*/
00890 int
00891 Sadie_NewFunctions_RandomCmd (ClientData client_data, Tcl_Interp * interp,
00892                               int argc, char *argv[])
00893 {
00894   Tcl_Obj *tclobj = NULL;
00895   Tcl_Obj *tclarrayname = NULL;
00896   Tcl_Obj *tclindexname = NULL;
00897   char msg[SLEN];
00898   char *array = NULL;
00899   char *tempstr = NULL;
00900   int strlen;
00901   int outimgaddr;
00902   IMAGE *outimg = NULL;
00903   char *outname = NULL;
00904   int lines, pix, type;
00905   double deviation;
00906 
00907   if (argc != 2)
00908     {
00909       Tcl_AppendResult (interp, "wrong # args: should be \"",
00910                         argv[0], " arrayname\"", (char *) NULL);
00911       return TCL_ERROR;
00912     }
00913   array = argv[1];
00914 
00915   /* Read the input integer array(lines) */
00916   tclarrayname = Tcl_NewStringObj (array, -1);
00917   tclindexname = Tcl_NewStringObj ("lines", -1);
00918   if (tclobj =
00919       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00920                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00921     {
00922       if (Tcl_GetIntFromObj (interp, tclobj, &lines) == TCL_ERROR)
00923         return TCL_ERROR;
00924     }
00925   else
00926     {
00927       return TCL_ERROR;
00928     }
00929   Tcl_DecrRefCount (tclarrayname);
00930   Tcl_DecrRefCount (tclindexname);
00931 
00932   /* Read the input integer array(pix) */
00933   tclarrayname = Tcl_NewStringObj (array, -1);
00934   tclindexname = Tcl_NewStringObj ("pix", -1);
00935   if (tclobj =
00936       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00937                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00938     {
00939       if (Tcl_GetIntFromObj (interp, tclobj, &pix) == TCL_ERROR)
00940         return TCL_ERROR;
00941     }
00942   else
00943     {
00944       return TCL_ERROR;
00945     }
00946   Tcl_DecrRefCount (tclarrayname);
00947   Tcl_DecrRefCount (tclindexname);
00948 
00949   /* Read the input integer array(type) */
00950   tclarrayname = Tcl_NewStringObj (array, -1);
00951   tclindexname = Tcl_NewStringObj ("type", -1);
00952   if (tclobj =
00953       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00954                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00955     {
00956       if (Tcl_GetIntFromObj (interp, tclobj, &type) == TCL_ERROR)
00957         return TCL_ERROR;
00958     }
00959   else
00960     {
00961       return TCL_ERROR;
00962     }
00963   Tcl_DecrRefCount (tclarrayname);
00964   Tcl_DecrRefCount (tclindexname);
00965 
00966   /* Read the input double array(deviation) */
00967   tclarrayname = Tcl_NewStringObj (array, -1);
00968   tclindexname = Tcl_NewStringObj ("deviation", -1);
00969   if (tclobj =
00970       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00971                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00972     {
00973       if (Tcl_GetDoubleFromObj (interp, tclobj, &deviation) == TCL_ERROR)
00974         return TCL_ERROR;
00975     }
00976   else
00977     {
00978       return TCL_ERROR;
00979     }
00980   Tcl_DecrRefCount (tclarrayname);
00981   Tcl_DecrRefCount (tclindexname);
00982 
00983   /* Read the output image 1 name */
00984   tclarrayname = Tcl_NewStringObj (array, -1);
00985   tclindexname = Tcl_NewStringObj ("outname", -1);
00986   if (tclobj =
00987       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00988                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00989     {
00990       outname = Tcl_GetStringFromObj (tclobj, &strlen);
00991       if (strlen <= 0)
00992         return TCL_ERROR;
00993     }
00994   else
00995     {
00996       return TCL_ERROR;
00997     }
00998   Tcl_DecrRefCount (tclarrayname);
00999   Tcl_DecrRefCount (tclindexname);
01000 
01001   RANDOM (lines, pix, type, deviation, &outimg);
01002 
01003   if (CHECKIMG (outimg))
01004     sprintf (outimg->text, "%s", outname);
01005   outimgaddr = (int) outimg;
01006 
01007   sprintf (msg, "%x", outimgaddr);
01008   Tcl_SetResult (interp, msg, TCL_VOLATILE);
01009 
01010   return TCL_OK;
01011 }
01012 
01013 /*-Copyright Information------------------------------------------------------*/
01014 /* Copyright (c) 1999 by the University of Arizona Digital Image Analysis Lab */
01015 /*----------------------------------------------------------------------------*/
01016 /*-General Information--------------------------------------------------------*/
01017 /*                                                                            */
01018 /*   This procedure initializes the all of the procedures                     */
01019 /*   in this file by registering them with Tcl.                               */
01020 /*                                                                            */
01021 /*----------------------------------------------------------------------------*/
01022 /*-Interface Information------------------------------------------------------*/
01023 int
01024 Sadie_NewFunctions_Init (Tcl_Interp * interp)
01025 {
01026   Tcl_CreateCommand (interp, "Sadie_NewFunctions_SineWave",
01027                      Sadie_NewFunctions_SineWaveCmd, (ClientData) NULL, NULL);
01028   Tcl_CreateCommand (interp, "Sadie_NewFunctions_Chirp",
01029                      Sadie_NewFunctions_ChirpCmd, (ClientData) NULL, NULL);
01030   Tcl_CreateCommand (interp, "Sadie_NewFunctions_SineStar",
01031                      Sadie_NewFunctions_SineStarCmd, (ClientData) NULL, NULL);
01032   Tcl_CreateCommand (interp, "Sadie_NewFunctions_Checkerboard",
01033                      Sadie_NewFunctions_CheckerboardCmd, (ClientData) NULL,
01034                      NULL);
01035   Tcl_CreateCommand (interp, "Sadie_NewFunctions_GrayScale",
01036                      Sadie_NewFunctions_GrayScaleCmd, (ClientData) NULL,
01037                      NULL);
01038   Tcl_CreateCommand (interp, "Sadie_NewFunctions_Function",
01039                      Sadie_NewFunctions_FunctionCmd, (ClientData) NULL, NULL);
01040   Tcl_CreateCommand (interp, "Sadie_NewFunctions_Random",
01041                      Sadie_NewFunctions_RandomCmd, (ClientData) NULL, NULL);
01042   return TCL_OK;
01043 }