Main Page   Data Structures   File List   Data Fields   Globals  

Sadie_Tools.c

Go to the documentation of this file.
00001 /*
00002 ##########################################
00003 # Sadie_Tools.c -
00004 #   Set of routines for linking SADIE tools routines to tcl/tk.
00005 #
00006 # RCS: $Id: Sadie_Tools.c,v 2.3 1999/02/11 14:33:03 conner Exp $ 
00007 # 
00008 # Digital Image Analysis Lab
00009 # Dept. of Electrical and Computer Engineering
00010 # University of Arizona
00011 ##########################################
00012 */
00013 
00014 #include <tcl.h>
00015 #include <tk.h>
00016 #include <stdio.h>
00017 #include <string.h>
00018 #include "sadie.h"
00019 
00020 /* RCS Indentification information */
00021 static char rcsid[] =
00022   "$Id: Sadie_Tools.c,v 2.3 1999/02/11 14:33:03 conner Exp $";
00023 
00024 /*-------------------------------------------------------------*/
00025 /* Global Sadie variables that must be set from within Tcl/Tk  */
00026 /*-------------------------------------------------------------*/
00027 extern short nlev;
00028 extern short csize;
00029 extern double weight;
00030 extern double *count;
00031 extern PIXEL gain;
00032 extern PIXEL bias;
00033 extern PIXEL gmin;
00034 extern PIXEL gmax;
00035 extern PIXEL thresh;
00036 extern PIXEL gbrk[2][4];
00037 extern PIXEL *table;
00038 /* -------------------------------------------------------------------------- */
00039 
00040 /*-Copyright Information------------------------------------------------------*/
00041 /* Copyright (c) 1999 by the University of Arizona Digital Image Analysis Lab */
00042 /*----------------------------------------------------------------------------*/
00043 /*-General Information--------------------------------------------------------*/
00044 /*                                                                            */
00045 /*   This procedure provides an interface to the SADIE function               */
00046 /*   DESTRIPE from Tcl/Tk.  It expects a tcl global array                     */
00047 /*   with these indices to exist:                                             */
00048 /*      array(inimg,addr)         --  SADIE image address                     */
00049 /*      array(option)             --  int                                     */
00050 /*      array(reference)          --  int                                     */
00051 /*      array(period)             --  int                                     */
00052 /*      array(detector)           --  int                                     */
00053 /*      array(number)             --  int                                     */
00054 /*      array(outname)            --  char*                                   */
00055 /*                                                                            */
00056 /*----------------------------------------------------------------------------*/
00057 /*-Interface Information------------------------------------------------------*/
00058 int
00059 Sadie_Tools_DestripeCmd (ClientData client_data, Tcl_Interp * interp,
00060                          int argc, char *argv[])
00061 {
00062   Tcl_Obj *tclobj = NULL;
00063   Tcl_Obj *tclarrayname = NULL;
00064   Tcl_Obj *tclindexname = NULL;
00065   char msg[SLEN];
00066   char *array = NULL;
00067   char *tempstr = NULL;
00068   int strlen;
00069   int inimgaddr;
00070   IMAGE *inimg = NULL;
00071   int outimgaddr;
00072   IMAGE *outimg = NULL;
00073   char *outname = NULL;
00074   int option, reference, period, detector, number;
00075 
00076   if (argc != 2)
00077     {
00078       Tcl_AppendResult (interp, "wrong # args: should be \"",
00079                         argv[0], " arrayname\"", (char *) NULL);
00080       return TCL_ERROR;
00081     }
00082   array = argv[1];
00083 
00084   /* Read input image array(inimg,addr) */
00085   tclarrayname = Tcl_NewStringObj (array, -1);
00086   tclindexname = Tcl_NewStringObj ("inimg,addr", -1);
00087   if (tclobj =
00088       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00089                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00090     {
00091       tempstr = Tcl_GetStringFromObj (tclobj, &strlen);
00092       if (strlen <= 0)
00093         return TCL_ERROR;
00094       sscanf (tempstr, "%x", &inimgaddr);
00095       inimg = (IMAGE *) inimgaddr;
00096     }
00097   else
00098     {
00099       return TCL_ERROR;
00100     }
00101   Tcl_DecrRefCount (tclarrayname);
00102   Tcl_DecrRefCount (tclindexname);
00103 
00104   /* Read the input integer array(option) */
00105   tclarrayname = Tcl_NewStringObj (array, -1);
00106   tclindexname = Tcl_NewStringObj ("option", -1);
00107   if (tclobj =
00108       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00109                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00110     {
00111       if (Tcl_GetIntFromObj (interp, tclobj, &option) == TCL_ERROR)
00112         return TCL_ERROR;
00113     }
00114   else
00115     {
00116       return TCL_ERROR;
00117     }
00118   Tcl_DecrRefCount (tclarrayname);
00119   Tcl_DecrRefCount (tclindexname);
00120 
00121   /* Read the input integer array(reference) */
00122   tclarrayname = Tcl_NewStringObj (array, -1);
00123   tclindexname = Tcl_NewStringObj ("reference", -1);
00124   if (tclobj =
00125       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00126                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00127     {
00128       if (Tcl_GetIntFromObj (interp, tclobj, &reference) == TCL_ERROR)
00129         return TCL_ERROR;
00130     }
00131   else
00132     {
00133       return TCL_ERROR;
00134     }
00135   Tcl_DecrRefCount (tclarrayname);
00136   Tcl_DecrRefCount (tclindexname);
00137 
00138   /* Read the input integer array(period) */
00139   tclarrayname = Tcl_NewStringObj (array, -1);
00140   tclindexname = Tcl_NewStringObj ("period", -1);
00141   if (tclobj =
00142       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00143                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00144     {
00145       if (Tcl_GetIntFromObj (interp, tclobj, &period) == TCL_ERROR)
00146         return TCL_ERROR;
00147     }
00148   else
00149     {
00150       return TCL_ERROR;
00151     }
00152   Tcl_DecrRefCount (tclarrayname);
00153   Tcl_DecrRefCount (tclindexname);
00154 
00155   /* Read the input integer array(detector) */
00156   tclarrayname = Tcl_NewStringObj (array, -1);
00157   tclindexname = Tcl_NewStringObj ("detector", -1);
00158   if (tclobj =
00159       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00160                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00161     {
00162       if (Tcl_GetIntFromObj (interp, tclobj, &detector) == TCL_ERROR)
00163         return TCL_ERROR;
00164     }
00165   else
00166     {
00167       return TCL_ERROR;
00168     }
00169   Tcl_DecrRefCount (tclarrayname);
00170   Tcl_DecrRefCount (tclindexname);
00171 
00172   /* Read the input integer array(number) */
00173   tclarrayname = Tcl_NewStringObj (array, -1);
00174   tclindexname = Tcl_NewStringObj ("number", -1);
00175   if (tclobj =
00176       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00177                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00178     {
00179       if (Tcl_GetIntFromObj (interp, tclobj, &number) == TCL_ERROR)
00180         return TCL_ERROR;
00181     }
00182   else
00183     {
00184       return TCL_ERROR;
00185     }
00186   Tcl_DecrRefCount (tclarrayname);
00187   Tcl_DecrRefCount (tclindexname);
00188 
00189   /* Read the output image 1 name */
00190   tclarrayname = Tcl_NewStringObj (array, -1);
00191   tclindexname = Tcl_NewStringObj ("outname", -1);
00192   if (tclobj =
00193       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00194                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00195     {
00196       outname = Tcl_GetStringFromObj (tclobj, &strlen);
00197       if (strlen <= 0)
00198         return TCL_ERROR;
00199     }
00200   else
00201     {
00202       return TCL_ERROR;
00203     }
00204   Tcl_DecrRefCount (tclarrayname);
00205   Tcl_DecrRefCount (tclindexname);
00206 
00207   DESTRIPE (inimg, option, reference, period, detector, number, &outimg);
00208 
00209   if (CHECKIMG (outimg))
00210     sprintf (outimg->text, "%s", outname);
00211   outimgaddr = (int) outimg;
00212 
00213   sprintf (msg, "%x", outimgaddr);
00214   Tcl_SetResult (interp, msg, TCL_VOLATILE);
00215 
00216   return TCL_OK;
00217 }
00218 
00219 /*-Copyright Information------------------------------------------------------*/
00220 /* Copyright (c) 1999 by the University of Arizona Digital Image Analysis Lab */
00221 /*----------------------------------------------------------------------------*/
00222 /*-General Information--------------------------------------------------------*/
00223 /*                                                                            */
00224 /*   This procedure provides an interface to the SADIE function               */
00225 /*   CONTOUR from Tcl/Tk.  It expects a tcl global array                      */
00226 /*   with these indices to exist:                                             */
00227 /*      array(inimg,addr)         --  SADIE image address                     */
00228 /*      array(number)             --  int                                     */
00229 /*      array(width)              --  double                                  */
00230 /*      array(outname)            --  char*                                   */
00231 /*                                                                            */
00232 /*----------------------------------------------------------------------------*/
00233 /*-Interface Information------------------------------------------------------*/
00234 int
00235 Sadie_Tools_ContMapCmd (ClientData client_data, Tcl_Interp * interp, int argc,
00236                         char *argv[])
00237 {
00238   Tcl_Obj *tclobj = NULL;
00239   Tcl_Obj *tclarrayname = NULL;
00240   Tcl_Obj *tclindexname = NULL;
00241   char msg[SLEN];
00242   char *array = NULL;
00243   char *tempstr = NULL;
00244   int strlen;
00245   int inimgaddr;
00246   IMAGE *inimg = NULL;
00247   int outimgaddr;
00248   IMAGE *outimg = NULL;
00249   char *outname = NULL;
00250   int number;
00251   double width;
00252 
00253   if (argc != 2)
00254     {
00255       Tcl_AppendResult (interp, "wrong # args: should be \"",
00256                         argv[0], " arrayname\"", (char *) NULL);
00257       return TCL_ERROR;
00258     }
00259   array = argv[1];
00260 
00261   /* Read input image array(inimg,addr) */
00262   tclarrayname = Tcl_NewStringObj (array, -1);
00263   tclindexname = Tcl_NewStringObj ("inimg,addr", -1);
00264   if (tclobj =
00265       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00266                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00267     {
00268       tempstr = Tcl_GetStringFromObj (tclobj, &strlen);
00269       if (strlen <= 0)
00270         return TCL_ERROR;
00271       sscanf (tempstr, "%x", &inimgaddr);
00272       inimg = (IMAGE *) inimgaddr;
00273     }
00274   else
00275     {
00276       return TCL_ERROR;
00277     }
00278   Tcl_DecrRefCount (tclarrayname);
00279   Tcl_DecrRefCount (tclindexname);
00280 
00281   /* Read the input integer array(number) */
00282   tclarrayname = Tcl_NewStringObj (array, -1);
00283   tclindexname = Tcl_NewStringObj ("number", -1);
00284   if (tclobj =
00285       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00286                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00287     {
00288       if (Tcl_GetIntFromObj (interp, tclobj, &number) == TCL_ERROR)
00289         return TCL_ERROR;
00290     }
00291   else
00292     {
00293       return TCL_ERROR;
00294     }
00295   Tcl_DecrRefCount (tclarrayname);
00296   Tcl_DecrRefCount (tclindexname);
00297 
00298   /* Read the input double array(width) */
00299   tclarrayname = Tcl_NewStringObj (array, -1);
00300   tclindexname = Tcl_NewStringObj ("width", -1);
00301   if (tclobj =
00302       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00303                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00304     {
00305       if (Tcl_GetDoubleFromObj (interp, tclobj, &width) == TCL_ERROR)
00306         return TCL_ERROR;
00307     }
00308   else
00309     {
00310       return TCL_ERROR;
00311     }
00312   Tcl_DecrRefCount (tclarrayname);
00313   Tcl_DecrRefCount (tclindexname);
00314 
00315   /* Read the output image 1 name */
00316   tclarrayname = Tcl_NewStringObj (array, -1);
00317   tclindexname = Tcl_NewStringObj ("outname", -1);
00318   if (tclobj =
00319       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00320                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00321     {
00322       outname = Tcl_GetStringFromObj (tclobj, &strlen);
00323       if (strlen <= 0)
00324         return TCL_ERROR;
00325     }
00326   else
00327     {
00328       return TCL_ERROR;
00329     }
00330   Tcl_DecrRefCount (tclarrayname);
00331   Tcl_DecrRefCount (tclindexname);
00332 
00333   CONTOUR (inimg, number, width, &outimg);
00334 
00335   if (CHECKIMG (outimg))
00336     sprintf (outimg->text, "%s", outname);
00337   outimgaddr = (int) outimg;
00338 
00339   sprintf (msg, "%x", outimgaddr);
00340   Tcl_SetResult (interp, msg, TCL_VOLATILE);
00341 
00342   return TCL_OK;
00343 }
00344 
00345 /*-Copyright Information------------------------------------------------------*/
00346 /* Copyright (c) 1999 by the University of Arizona Digital Image Analysis Lab */
00347 /*----------------------------------------------------------------------------*/
00348 /*-General Information--------------------------------------------------------*/
00349 /*                                                                            */
00350 /*   This procedure provides an interface to the SADIE function               */
00351 /*   RELIEF from Tcl/Tk.  It expects a tcl global array                       */
00352 /*   with these indices to exist:                                             */
00353 /*      array(inimg,addr)         --  SADIE image address                     */
00354 /*      array(phi)                --  double                                  */
00355 /*      array(theta)              --  double                                  */
00356 /*      array(dist)               --  double                                  */
00357 /*      array(outname)            --  char*                                   */
00358 /*                                                                            */
00359 /*----------------------------------------------------------------------------*/
00360 /*-Interface Information------------------------------------------------------*/
00361 int
00362 Sadie_Tools_ReliefCmd (ClientData client_data, Tcl_Interp * interp, int argc,
00363                        char *argv[])
00364 {
00365   Tcl_Obj *tclobj = NULL;
00366   Tcl_Obj *tclarrayname = NULL;
00367   Tcl_Obj *tclindexname = NULL;
00368   char msg[SLEN];
00369   char *array = NULL;
00370   char *tempstr = NULL;
00371   int strlen;
00372   int inimgaddr;
00373   IMAGE *inimg = NULL;
00374   int outimgaddr;
00375   IMAGE *outimg = NULL;
00376   char *outname = NULL;
00377   double phi, theta, dist;
00378 
00379   if (argc != 2)
00380     {
00381       Tcl_AppendResult (interp, "wrong # args: should be \"",
00382                         argv[0], " arrayname\"", (char *) NULL);
00383       return TCL_ERROR;
00384     }
00385   array = argv[1];
00386 
00387   /* Read input image array(inimg,addr) */
00388   tclarrayname = Tcl_NewStringObj (array, -1);
00389   tclindexname = Tcl_NewStringObj ("inimg,addr", -1);
00390   if (tclobj =
00391       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00392                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00393     {
00394       tempstr = Tcl_GetStringFromObj (tclobj, &strlen);
00395       if (strlen <= 0)
00396         return TCL_ERROR;
00397       sscanf (tempstr, "%x", &inimgaddr);
00398       inimg = (IMAGE *) inimgaddr;
00399     }
00400   else
00401     {
00402       return TCL_ERROR;
00403     }
00404   Tcl_DecrRefCount (tclarrayname);
00405   Tcl_DecrRefCount (tclindexname);
00406 
00407   /* Read the input double array(phi) */
00408   tclarrayname = Tcl_NewStringObj (array, -1);
00409   tclindexname = Tcl_NewStringObj ("phi", -1);
00410   if (tclobj =
00411       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00412                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00413     {
00414       if (Tcl_GetDoubleFromObj (interp, tclobj, &phi) == TCL_ERROR)
00415         return TCL_ERROR;
00416     }
00417   else
00418     {
00419       return TCL_ERROR;
00420     }
00421   Tcl_DecrRefCount (tclarrayname);
00422   Tcl_DecrRefCount (tclindexname);
00423 
00424   /* Read the input double array(theta) */
00425   tclarrayname = Tcl_NewStringObj (array, -1);
00426   tclindexname = Tcl_NewStringObj ("theta", -1);
00427   if (tclobj =
00428       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00429                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00430     {
00431       if (Tcl_GetDoubleFromObj (interp, tclobj, &theta) == TCL_ERROR)
00432         return TCL_ERROR;
00433     }
00434   else
00435     {
00436       return TCL_ERROR;
00437     }
00438   Tcl_DecrRefCount (tclarrayname);
00439   Tcl_DecrRefCount (tclindexname);
00440 
00441   /* Read the input double array(dist) */
00442   tclarrayname = Tcl_NewStringObj (array, -1);
00443   tclindexname = Tcl_NewStringObj ("dist", -1);
00444   if (tclobj =
00445       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00446                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00447     {
00448       if (Tcl_GetDoubleFromObj (interp, tclobj, &dist) == TCL_ERROR)
00449         return TCL_ERROR;
00450     }
00451   else
00452     {
00453       return TCL_ERROR;
00454     }
00455   Tcl_DecrRefCount (tclarrayname);
00456   Tcl_DecrRefCount (tclindexname);
00457 
00458   /* Read the output image 1 name */
00459   tclarrayname = Tcl_NewStringObj (array, -1);
00460   tclindexname = Tcl_NewStringObj ("outname", -1);
00461   if (tclobj =
00462       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00463                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00464     {
00465       outname = Tcl_GetStringFromObj (tclobj, &strlen);
00466       if (strlen <= 0)
00467         return TCL_ERROR;
00468     }
00469   else
00470     {
00471       return TCL_ERROR;
00472     }
00473   Tcl_DecrRefCount (tclarrayname);
00474   Tcl_DecrRefCount (tclindexname);
00475 
00476   /* Convert to radians */
00477   phi = (phi * (PI / 180.0));
00478   theta = (theta * (PI / 180.0));
00479 
00480   RELIEF (inimg, phi, theta, dist, &outimg);
00481 
00482   if (CHECKIMG (outimg))
00483     sprintf (outimg->text, "%s", outname);
00484   outimgaddr = (int) outimg;
00485 
00486   sprintf (msg, "%x", outimgaddr);
00487   Tcl_SetResult (interp, msg, TCL_VOLATILE);
00488 
00489   return TCL_OK;
00490 }
00491 
00492 /*-Copyright Information------------------------------------------------------*/
00493 /* Copyright (c) 1999 by the University of Arizona Digital Image Analysis Lab */
00494 /*----------------------------------------------------------------------------*/
00495 /*-General Information--------------------------------------------------------*/
00496 /*                                                                            */
00497 /*   This procedure provides an interface to the SADIE function               */
00498 /*   SCATTER from Tcl/Tk.  It expects a tcl global array                      */
00499 /*   with these indices to exist:                                             */
00500 /*      array(inimg,addr1)        --  SADIE image address                     */
00501 /*      array(inimg,addr2)        --  SADIE image address                     */
00502 /*      array(band1)              --  int                                     */
00503 /*      array(band2)              --  int                                     */
00504 /*      array(incr)               --  int                                     */
00505 /*      array(res)                --  int                                     */
00506 /*      array(outname)            --  char*                                   */
00507 /*                                                                            */
00508 /*----------------------------------------------------------------------------*/
00509 /*-Interface Information------------------------------------------------------*/
00510 int
00511 Sadie_Tools_ScatterCmd (ClientData client_data, Tcl_Interp * interp, int argc,
00512                         char *argv[])
00513 {
00514   Tcl_Obj *tclobj = NULL;
00515   Tcl_Obj *tclarrayname = NULL;
00516   Tcl_Obj *tclindexname = NULL;
00517   char msg[SLEN];
00518   char *array = NULL;
00519   char *tempstr = NULL;
00520   int strlen;
00521   int inimgaddr1, inimgaddr2;
00522   IMAGE *inimg1 = NULL, *inimg2 = NULL;
00523   int outimgaddr;
00524   IMAGE *outimg = NULL;
00525   char *outname = NULL;
00526   int band1, band2, incr, res;
00527 
00528   if (argc != 2)
00529     {
00530       Tcl_AppendResult (interp, "wrong # args: should be \"",
00531                         argv[0], " arrayname\"", (char *) NULL);
00532       return TCL_ERROR;
00533     }
00534   array = argv[1];
00535 
00536   /* Read input image array(inimg,addr1) */
00537   tclarrayname = Tcl_NewStringObj (array, -1);
00538   tclindexname = Tcl_NewStringObj ("inimg,addr1", -1);
00539   if (tclobj =
00540       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00541                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00542     {
00543       tempstr = Tcl_GetStringFromObj (tclobj, &strlen);
00544       if (strlen <= 0)
00545         return TCL_ERROR;
00546       sscanf (tempstr, "%x", &inimgaddr1);
00547       inimg1 = (IMAGE *) inimgaddr1;
00548     }
00549   else
00550     {
00551       return TCL_ERROR;
00552     }
00553   Tcl_DecrRefCount (tclarrayname);
00554   Tcl_DecrRefCount (tclindexname);
00555 
00556   /* Read input image array(inimg,addr2) */
00557   tclarrayname = Tcl_NewStringObj (array, -1);
00558   tclindexname = Tcl_NewStringObj ("inimg,addr2", -1);
00559   if (tclobj =
00560       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00561                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00562     {
00563       tempstr = Tcl_GetStringFromObj (tclobj, &strlen);
00564       if (strlen <= 0)
00565         return TCL_ERROR;
00566       sscanf (tempstr, "%x", &inimgaddr2);
00567       inimg2 = (IMAGE *) inimgaddr2;
00568     }
00569   else
00570     {
00571       return TCL_ERROR;
00572     }
00573   Tcl_DecrRefCount (tclarrayname);
00574   Tcl_DecrRefCount (tclindexname);
00575 
00576   /* Read the input integer array(band1) */
00577   tclarrayname = Tcl_NewStringObj (array, -1);
00578   tclindexname = Tcl_NewStringObj ("band1", -1);
00579   if (tclobj =
00580       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00581                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00582     {
00583       if (Tcl_GetIntFromObj (interp, tclobj, &band1) == TCL_ERROR)
00584         return TCL_ERROR;
00585     }
00586   else
00587     {
00588       return TCL_ERROR;
00589     }
00590   Tcl_DecrRefCount (tclarrayname);
00591   Tcl_DecrRefCount (tclindexname);
00592 
00593   /* Read the input integer array(band2) */
00594   tclarrayname = Tcl_NewStringObj (array, -1);
00595   tclindexname = Tcl_NewStringObj ("band2", -1);
00596   if (tclobj =
00597       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00598                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00599     {
00600       if (Tcl_GetIntFromObj (interp, tclobj, &band2) == TCL_ERROR)
00601         return TCL_ERROR;
00602     }
00603   else
00604     {
00605       return TCL_ERROR;
00606     }
00607   Tcl_DecrRefCount (tclarrayname);
00608   Tcl_DecrRefCount (tclindexname);
00609 
00610   /* Read the input integer array(incr) */
00611   tclarrayname = Tcl_NewStringObj (array, -1);
00612   tclindexname = Tcl_NewStringObj ("incr", -1);
00613   if (tclobj =
00614       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00615                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00616     {
00617       if (Tcl_GetIntFromObj (interp, tclobj, &incr) == TCL_ERROR)
00618         return TCL_ERROR;
00619     }
00620   else
00621     {
00622       return TCL_ERROR;
00623     }
00624   Tcl_DecrRefCount (tclarrayname);
00625   Tcl_DecrRefCount (tclindexname);
00626 
00627   /* Read the input integer array(res) */
00628   tclarrayname = Tcl_NewStringObj (array, -1);
00629   tclindexname = Tcl_NewStringObj ("res", -1);
00630   if (tclobj =
00631       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00632                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00633     {
00634       if (Tcl_GetIntFromObj (interp, tclobj, &res) == TCL_ERROR)
00635         return TCL_ERROR;
00636     }
00637   else
00638     {
00639       return TCL_ERROR;
00640     }
00641   Tcl_DecrRefCount (tclarrayname);
00642   Tcl_DecrRefCount (tclindexname);
00643 
00644   /* Read the output image 1 name */
00645   tclarrayname = Tcl_NewStringObj (array, -1);
00646   tclindexname = Tcl_NewStringObj ("outname", -1);
00647   if (tclobj =
00648       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00649                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00650     {
00651       outname = Tcl_GetStringFromObj (tclobj, &strlen);
00652       if (strlen <= 0)
00653         return TCL_ERROR;
00654     }
00655   else
00656     {
00657       return TCL_ERROR;
00658     }
00659   Tcl_DecrRefCount (tclarrayname);
00660   Tcl_DecrRefCount (tclindexname);
00661 
00662   band1--;
00663   band2--;
00664 
00665   SCATTER (inimg1, inimg2, band1, band2, incr, res, &outimg);
00666 
00667   if (CHECKIMG (outimg))
00668     sprintf (outimg->text, "%s", outname);
00669   outimgaddr = (int) outimg;
00670 
00671   sprintf (msg, "%x", outimgaddr);
00672   Tcl_SetResult (interp, msg, TCL_VOLATILE);
00673 
00674   return TCL_OK;
00675 }
00676 
00677 /*-Copyright Information------------------------------------------------------*/
00678 /* Copyright (c) 1999 by the University of Arizona Digital Image Analysis Lab */
00679 /*----------------------------------------------------------------------------*/
00680 /*-General Information--------------------------------------------------------*/
00681 /*                                                                            */
00682 /*   This procedure provides an interface to the SADIE function               */
00683 /*   RMSDIFF from Tcl/Tk.  It expects a tcl global array                      */
00684 /*   with these indices to exist:                                             */
00685 /*      array(inimg,addr1)        --  SADIE image address                     */
00686 /*      array(inimg,addr2)        --  SADIE image address                     */
00687 /*                                                                            */
00688 /*----------------------------------------------------------------------------*/
00689 /*-Interface Information------------------------------------------------------*/
00690 int
00691 Sadie_Tools_RMSCmd (ClientData client_data, Tcl_Interp * interp, int argc,
00692                     char *argv[])
00693 {
00694   Tcl_Obj *tclobj = NULL;
00695   Tcl_Obj *tclarrayname = NULL;
00696   Tcl_Obj *tclindexname = NULL;
00697   char msg[SLEN];
00698   char *array = NULL;
00699   char *tempstr = NULL;
00700   int strlen;
00701   int inimgaddr1, inimgaddr2;
00702   IMAGE *inimg1 = NULL, *inimg2 = NULL;
00703   double diff;
00704 
00705   if (argc != 2)
00706     {
00707       Tcl_AppendResult (interp, "wrong # args: should be \"",
00708                         argv[0], " arrayname\"", (char *) NULL);
00709       return TCL_ERROR;
00710     }
00711   array = argv[1];
00712 
00713   /* Read input image array(inimg,addr1) */
00714   tclarrayname = Tcl_NewStringObj (array, -1);
00715   tclindexname = Tcl_NewStringObj ("inimg,addr1", -1);
00716   if (tclobj =
00717       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00718                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00719     {
00720       tempstr = Tcl_GetStringFromObj (tclobj, &strlen);
00721       if (strlen <= 0)
00722         return TCL_ERROR;
00723       sscanf (tempstr, "%x", &inimgaddr1);
00724       inimg1 = (IMAGE *) inimgaddr1;
00725     }
00726   else
00727     {
00728       return TCL_ERROR;
00729     }
00730   Tcl_DecrRefCount (tclarrayname);
00731   Tcl_DecrRefCount (tclindexname);
00732 
00733   /* Read input image array(inimg,addr2) */
00734   tclarrayname = Tcl_NewStringObj (array, -1);
00735   tclindexname = Tcl_NewStringObj ("inimg,addr2", -1);
00736   if (tclobj =
00737       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00738                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00739     {
00740       tempstr = Tcl_GetStringFromObj (tclobj, &strlen);
00741       if (strlen <= 0)
00742         return TCL_ERROR;
00743       sscanf (tempstr, "%x", &inimgaddr2);
00744       inimg2 = (IMAGE *) inimgaddr2;
00745     }
00746   else
00747     {
00748       return TCL_ERROR;
00749     }
00750   Tcl_DecrRefCount (tclarrayname);
00751   Tcl_DecrRefCount (tclindexname);
00752 
00753   RMSDIFF (inimg1, inimg2, &diff);
00754 
00755   sprintf (msg, "%f", diff);
00756   Tcl_SetResult (interp, msg, TCL_VOLATILE);
00757 
00758   return TCL_OK;
00759 }
00760 
00761 /*-Copyright Information------------------------------------------------------*/
00762 /* Copyright (c) 1999 by the University of Arizona Digital Image Analysis Lab */
00763 /*----------------------------------------------------------------------------*/
00764 /*-General Information--------------------------------------------------------*/
00765 /*                                                                            */
00766 /*   This procedure initializes the all of the procedures                     */
00767 /*   in this file by registering them with Tcl.                               */
00768 /*                                                                            */
00769 /*----------------------------------------------------------------------------*/
00770 /*-Interface Information------------------------------------------------------*/
00771 int
00772 Sadie_Tools_Init (Tcl_Interp * interp)
00773 {
00774   Tcl_CreateCommand (interp, "Sadie_Tools_Destripe", Sadie_Tools_DestripeCmd,
00775                      (ClientData) NULL, NULL);
00776   Tcl_CreateCommand (interp, "Sadie_Tools_ContMap", Sadie_Tools_ContMapCmd,
00777                      (ClientData) NULL, NULL);
00778   Tcl_CreateCommand (interp, "Sadie_Tools_Relief", Sadie_Tools_ReliefCmd,
00779                      (ClientData) NULL, NULL);
00780   Tcl_CreateCommand (interp, "Sadie_Tools_Scatter", Sadie_Tools_ScatterCmd,
00781                      (ClientData) NULL, NULL);
00782   Tcl_CreateCommand (interp, "Sadie_Tools_RMS", Sadie_Tools_RMSCmd,
00783                      (ClientData) NULL, NULL);
00784   return TCL_OK;
00785 }

Generated on Sun May 18 15:36:17 2003 for tclSadie by doxygen1.3