Sadie_Classify.c Source File

00001 /*
00002    ##########################################
00003    # Sadie_Classify.c -
00004    #   Set of routines for linking SADIE classify routines to tcl/tk.
00005    #
00006    # RCS: $Id: Sadie_Classify.c,v 2.4 1999/02/11 14:31:30 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_Classify.c,v 2.4 1999/02/11 14:31:30 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 /*   LVLSLICE from Tcl/Tk.  It expects a tcl global array                     */
00047 /*   with these indices to exist:                                             */
00048 /*      array(inimg,addr)         --  SADIE image address                     */
00049 /*      array(numclasses)         --  int                                     */
00050 /*      array(thresh)             --  PIXEL                                   */
00051 /*      array(imgarray)           --  char*                                   */
00052 /*      array(outname)            --  char*                                   */
00053 /*      imgarray(class,1-numclasses,1-numregions) --  int                     */
00054 /*                                                                            */
00055 /*----------------------------------------------------------------------------*/
00056 /*-Interface Information------------------------------------------------------*/
00057 int
00058 Sadie_Classify_LvlSliceCmd (ClientData client_data, Tcl_Interp * interp,
00059                             int argc, char *argv[])
00060 {
00061   short i, j, k, l;
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   char *imgarray = NULL;
00069   int strlen;
00070   int inimgaddr;
00071   IMAGE *inimg = NULL;
00072   int outimgaddr;
00073   IMAGE *outimg = NULL;
00074   char *outname = NULL;
00075   int numclasses, included;
00076   PIXEL thresh;
00077   double tempdouble;
00078   PIXEL *grng = NULL;
00079   ROIPtr r = NULL;
00080   char index[20];
00081   long m;
00082 
00083   if (argc != 2)
00084     {
00085       Tcl_AppendResult (interp, "wrong # args: should be \"",
00086                         argv[0], " arrayname\"", (char *) NULL);
00087       return TCL_ERROR;
00088     }
00089   array = argv[1];
00090 
00091   /* Read input image array(inimg,addr) */
00092   tclarrayname = Tcl_NewStringObj (array, -1);
00093   tclindexname = Tcl_NewStringObj ("inimg,addr", -1);
00094   if (tclobj =
00095       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00096                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00097     {
00098 
00099       tempstr = Tcl_GetStringFromObj (tclobj, &strlen);
00100       if (strlen <= 0)
00101         return TCL_ERROR;
00102       sscanf (tempstr, "%x", &inimgaddr);
00103       inimg = (IMAGE *) inimgaddr;
00104     }
00105   else
00106     {
00107       return TCL_ERROR;
00108     }
00109   Tcl_DecrRefCount (tclarrayname);
00110   Tcl_DecrRefCount (tclindexname);
00111 
00112   /* Read the input integer array(numclasses) */
00113   tclarrayname = Tcl_NewStringObj (array, -1);
00114   tclindexname = Tcl_NewStringObj ("numclasses", -1);
00115   if (tclobj =
00116       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00117                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00118     {
00119 
00120       if (Tcl_GetIntFromObj (interp, tclobj, &numclasses) == TCL_ERROR)
00121         return TCL_ERROR;
00122     }
00123   else
00124     {
00125       return TCL_ERROR;
00126     }
00127   Tcl_DecrRefCount (tclarrayname);
00128   Tcl_DecrRefCount (tclindexname);
00129 
00130   /* Read the input PIXEL array(thresh) */
00131   tclarrayname = Tcl_NewStringObj (array, -1);
00132   tclindexname = Tcl_NewStringObj ("thresh", -1);
00133   if (tclobj =
00134       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00135                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00136     {
00137 
00138       if (Tcl_GetDoubleFromObj (interp, tclobj, &tempdouble) == TCL_ERROR)
00139         return TCL_ERROR;
00140       thresh = (PIXEL) tempdouble;
00141     }
00142   else
00143     {
00144       return TCL_ERROR;
00145     }
00146   Tcl_DecrRefCount (tclarrayname);
00147   Tcl_DecrRefCount (tclindexname);
00148 
00149   /* Read the input image array name */
00150   tclarrayname = Tcl_NewStringObj (array, -1);
00151   tclindexname = Tcl_NewStringObj ("inimg,array", -1);
00152   if (tclobj =
00153       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00154                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00155     {
00156 
00157       imgarray = Tcl_GetStringFromObj (tclobj, &strlen);
00158       if (strlen <= 0)
00159         return TCL_ERROR;
00160     }
00161   else
00162     {
00163       return TCL_ERROR;
00164     }
00165   Tcl_DecrRefCount (tclarrayname);
00166   Tcl_DecrRefCount (tclindexname);
00167 
00168   /* Read the output image 1 name */
00169   tclarrayname = Tcl_NewStringObj (array, -1);
00170   tclindexname = Tcl_NewStringObj ("outname", -1);
00171   if (tclobj =
00172       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00173                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00174     {
00175 
00176       outname = Tcl_GetStringFromObj (tclobj, &strlen);
00177       if (strlen <= 0)
00178         return TCL_ERROR;
00179     }
00180   else
00181     {
00182       return TCL_ERROR;
00183     }
00184   Tcl_DecrRefCount (tclarrayname);
00185   Tcl_DecrRefCount (tclindexname);
00186 
00187   /* Allocate space for the class boundary array */
00188   if (!
00189       (grng =
00190        (PIXEL *) malloc (numclasses * inimg->nbnd * 2 * sizeof (PIXEL))))
00191     {
00192       Tcl_AppendResult (interp, "Could not allocate memory!", (char *) NULL);
00193       return TCL_ERROR;
00194     }
00195 
00196   /* Get the class boundary information */
00197   for (i = 0; i < numclasses * inimg->nbnd * 2; i++)
00198     {
00199       grng[i] = 0.0;
00200     }
00201 
00202   for (i = 0; i < numclasses; i++)
00203     {
00204       m = 0L;
00205       for (l = 0, r = inimg->regions; r != NULL; r = r->next, l++)
00206         {
00207           sprintf (index, "class,%d,%d", i + 1, l + 1);
00208           /* Read the input integer array(class,i,l) */
00209           tclarrayname = Tcl_NewStringObj (imgarray, -1);
00210           tclindexname = Tcl_NewStringObj (index, -1);
00211           if (tclobj =
00212               Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00213                               TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00214             {
00215 
00216               if (Tcl_GetIntFromObj (interp, tclobj, &included) == TCL_ERROR)
00217                 return TCL_ERROR;
00218             }
00219           else
00220             {
00221               return TCL_ERROR;
00222             }
00223           Tcl_DecrRefCount (tclarrayname);
00224           Tcl_DecrRefCount (tclindexname);
00225           if (included)
00226             {
00227               for (j = 0; j < inimg->nbnd; j++)
00228                 {
00229                   grng[i * inimg->nbnd * 2 + j * 2 + 0] +=
00230                     r->nval * r->mean[j];
00231                   grng[i * inimg->nbnd * 2 + j * 2 + 1] +=
00232                     r->nval * (r->mean[j] * r->mean[j] +
00233                                r->dev[j] * r->dev[j]);
00234                 }
00235               m += r->nval;
00236             }
00237         }
00238       if (m > 0L)
00239         {
00240           for (j = 0; j < inimg->nbnd; j++)
00241             {
00242               grng[i * inimg->nbnd * 2 + j * 2 + 0] /= m;
00243               grng[i * inimg->nbnd * 2 + j * 2 + 1] =
00244                 sqrt (grng[i * inimg->nbnd * 2 + j * 2 + 1] / m -
00245                       grng[i * inimg->nbnd * 2 + j * 2 +
00246                            0] * grng[i * inimg->nbnd * 2 + j * 2 + 0]);
00247               gmin =
00248                 grng[i * inimg->nbnd * 2 + j * 2 + 0] -
00249                 thresh * grng[i * inimg->nbnd * 2 + j * 2 + 1];
00250               gmax =
00251                 grng[i * inimg->nbnd * 2 + j * 2 + 0] +
00252                 thresh * grng[i * inimg->nbnd * 2 + j * 2 + 1];
00253               grng[i * inimg->nbnd * 2 + j * 2 + 0] = gmin;
00254               grng[i * inimg->nbnd * 2 + j * 2 + 1] = gmax;
00255             }
00256         }
00257       else
00258         {
00259           sprintf (msg, " No training area defined for class %d.", i + 1);
00260           MESSAGE ('E', msg);
00261           goto the_end;
00262         }
00263     }
00264 
00265   LVLSLICE (inimg, grng, numclasses, &outimg);
00266 
00267   if (CHECKIMG (outimg))
00268     sprintf (outimg->text, "%s", outname);
00269   outimgaddr = (int) outimg;
00270 
00271   sprintf (msg, "%x", outimgaddr);
00272   Tcl_SetResult (interp, msg, TCL_VOLATILE);
00273 
00274 the_end:
00275   if (grng)
00276     free (grng);
00277 
00278   return TCL_OK;
00279 }
00280 
00281 /*-Copyright Information------------------------------------------------------*/
00282 /* Copyright (c) 1999 by the University of Arizona Digital Image Analysis Lab */
00283 /*----------------------------------------------------------------------------*/
00284 /*-General Information--------------------------------------------------------*/
00285 /*                                                                            */
00286 /*   This procedure provides an interface to the SADIE function               */
00287 /*   MINDIST from Tcl/Tk.  It expects a tcl global array                      */
00288 /*   with these indices to exist:                                             */
00289 /*      array(inimg,addr)         --  SADIE image address                     */
00290 /*      array(numclasses)         --  int                                     */
00291 /*      array(option)             --  int                                     */
00292 /*      array(inimg,array)        --  char*                                   */
00293 /*      array(outname)            --  char*                                   */
00294 /*      imgarray(class,1-numclasses,1-numregions) --  int                     */
00295 /*                                                                            */
00296 /*----------------------------------------------------------------------------*/
00297 /*-Interface Information------------------------------------------------------*/
00298 int
00299 Sadie_Classify_MinDistCmd (ClientData client_data, Tcl_Interp * interp,
00300                            int argc, char *argv[])
00301 {
00302   short i, j, k, l;
00303   long m, n;
00304   Tcl_Obj *tclobj = NULL;
00305   Tcl_Obj *tclarrayname = NULL;
00306   Tcl_Obj *tclindexname = NULL;
00307   char msg[SLEN];
00308   char *array = NULL;
00309   char *tempstr = NULL;
00310   char *imgarray = NULL;
00311   int strlen;
00312   int inimgaddr;
00313   IMAGE *inimg = NULL;
00314   int outimgaddr;
00315   IMAGE *outimg = NULL;
00316   char *outname = NULL;
00317   int numclasses, option, included;
00318   char index[20];
00319   ROIPtr r = NULL;
00320   double *mean = NULL, *cov = NULL;
00321 
00322   if (argc != 2)
00323     {
00324       Tcl_AppendResult (interp, "wrong # args: should be \"",
00325                         argv[0], " arrayname\"", (char *) NULL);
00326       return TCL_ERROR;
00327     }
00328   array = argv[1];
00329 
00330   /* Read input image array(inimg,addr) */
00331   tclarrayname = Tcl_NewStringObj (array, -1);
00332   tclindexname = Tcl_NewStringObj ("inimg,addr", -1);
00333   if (tclobj =
00334       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00335                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00336     {
00337 
00338       tempstr = Tcl_GetStringFromObj (tclobj, &strlen);
00339       if (strlen <= 0)
00340         return TCL_ERROR;
00341       sscanf (tempstr, "%x", &inimgaddr);
00342       inimg = (IMAGE *) inimgaddr;
00343     }
00344   else
00345     {
00346       return TCL_ERROR;
00347     }
00348   Tcl_DecrRefCount (tclarrayname);
00349   Tcl_DecrRefCount (tclindexname);
00350 
00351   /* Read the input integer array(numclasses) */
00352   tclarrayname = Tcl_NewStringObj (array, -1);
00353   tclindexname = Tcl_NewStringObj ("numclasses", -1);
00354   if (tclobj =
00355       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00356                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00357     {
00358 
00359       if (Tcl_GetIntFromObj (interp, tclobj, &numclasses) == TCL_ERROR)
00360         return TCL_ERROR;
00361     }
00362   else
00363     {
00364       return TCL_ERROR;
00365     }
00366   Tcl_DecrRefCount (tclarrayname);
00367   Tcl_DecrRefCount (tclindexname);
00368 
00369   /* Read the input integer array(option) */
00370   tclarrayname = Tcl_NewStringObj (array, -1);
00371   tclindexname = Tcl_NewStringObj ("option", -1);
00372   if (tclobj =
00373       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00374                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00375     {
00376 
00377       if (Tcl_GetIntFromObj (interp, tclobj, &option) == TCL_ERROR)
00378         return TCL_ERROR;
00379     }
00380   else
00381     {
00382       return TCL_ERROR;
00383     }
00384   Tcl_DecrRefCount (tclarrayname);
00385   Tcl_DecrRefCount (tclindexname);
00386 
00387   /* Read the input image array name */
00388   tclarrayname = Tcl_NewStringObj (array, -1);
00389   tclindexname = Tcl_NewStringObj ("inimg,array", -1);
00390   if (tclobj =
00391       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00392                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00393     {
00394 
00395       imgarray = Tcl_GetStringFromObj (tclobj, &strlen);
00396       if (strlen <= 0)
00397         return TCL_ERROR;
00398     }
00399   else
00400     {
00401       return TCL_ERROR;
00402     }
00403   Tcl_DecrRefCount (tclarrayname);
00404   Tcl_DecrRefCount (tclindexname);
00405 
00406   /* Read the output image 1 name */
00407   tclarrayname = Tcl_NewStringObj (array, -1);
00408   tclindexname = Tcl_NewStringObj ("outname", -1);
00409   if (tclobj =
00410       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00411                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00412     {
00413 
00414       outname = Tcl_GetStringFromObj (tclobj, &strlen);
00415       if (strlen <= 0)
00416         return TCL_ERROR;
00417     }
00418   else
00419     {
00420       return TCL_ERROR;
00421     }
00422   Tcl_DecrRefCount (tclarrayname);
00423   Tcl_DecrRefCount (tclindexname);
00424 
00425   /* Allocate space for the mean array */
00426   if (!
00427       (mean =
00428        (double *) malloc ((inimg->nbnd * numclasses) * sizeof (double))))
00429     {
00430       Tcl_AppendResult (interp, "Memory request failed!", (char *) NULL);
00431       return TCL_ERROR;
00432     }
00433 
00434   /* Allocate space for the covariance array */
00435   if (!
00436       (cov =
00437        (double *) malloc ((inimg->nbnd * inimg->nbnd) * sizeof (double))))
00438     {
00439       Tcl_AppendResult (interp, "Memory request failed!", (char *) NULL);
00440       return TCL_ERROR;
00441     }
00442 
00443   /* Get the class boundary information */
00444   for (i = 0; i < numclasses * inimg->nbnd; i++)
00445     {
00446       mean[i] = 0.0;
00447     }
00448   for (i = 0; i < inimg->nbnd * inimg->nbnd; i++)
00449     {
00450       cov[i] = 0.0;
00451     }
00452 
00453   m = 0L;
00454   for (i = 0; i < numclasses; i++)
00455     {
00456       n = 0L;
00457       for (l = 0, r = inimg->regions; r != NULL; r = r->next, l++)
00458         {
00459           sprintf (index, "class,%d,%d", i + 1, l + 1);
00460           /* Read the input integer array(class,i,l) */
00461           tclarrayname = Tcl_NewStringObj (imgarray, -1);
00462           tclindexname = Tcl_NewStringObj (index, -1);
00463           if (tclobj =
00464               Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00465                               TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00466             {
00467 
00468               if (Tcl_GetIntFromObj (interp, tclobj, &included) == TCL_ERROR)
00469                 return TCL_ERROR;
00470             }
00471           else
00472             {
00473               return TCL_ERROR;
00474             }
00475           Tcl_DecrRefCount (tclarrayname);
00476           Tcl_DecrRefCount (tclindexname);
00477 
00478           if (included)
00479             {
00480               for (j = 0; j < inimg->nbnd; j++)
00481                 {
00482                   mean[i * inimg->nbnd + j] += r->nval * r->mean[j];
00483                 }
00484               n += r->nval;
00485               for (j = 0; j < inimg->nbnd * inimg->nbnd; j++)
00486                 {
00487                   cov[j] += r->nval * r->cov[j];
00488                 }
00489               m += r->nval;
00490             }
00491         }
00492       if (n > 0L)
00493         {
00494           for (j = 0; j < inimg->nbnd; j++)
00495             {
00496               mean[i * inimg->nbnd + j] /= n;
00497             }
00498         }
00499       else
00500         {
00501           sprintf (msg, " No training area defined for class %d.", i + 1);
00502           MESSAGE ('E', msg);
00503           goto the_end;
00504         }
00505     }
00506   if (m > 0L)
00507     {
00508       for (i = 0; i < inimg->nbnd * inimg->nbnd; i++)
00509         {
00510           cov[i] /= m;
00511         }
00512     }
00513   else
00514     {
00515       MESSAGE ('E', " No classes defined.");
00516       goto the_end;
00517     }
00518 
00519   MINDIST (inimg, option, numclasses, mean, cov, &outimg);
00520 
00521   if (CHECKIMG (outimg))
00522     sprintf (outimg->text, "%s", outname);
00523   outimgaddr = (int) outimg;
00524 
00525   sprintf (msg, "%x", outimgaddr);
00526   Tcl_SetResult (interp, msg, TCL_VOLATILE);
00527 
00528 the_end:
00529   if (mean)
00530     free (mean);
00531   if (cov)
00532     free (cov);
00533 
00534   return TCL_OK;
00535 }
00536 
00537 /*-Copyright Information------------------------------------------------------*/
00538 /* Copyright (c) 1999 by the University of Arizona Digital Image Analysis Lab */
00539 /*----------------------------------------------------------------------------*/
00540 /*-General Information--------------------------------------------------------*/
00541 /*                                                                            */
00542 /*   This procedure provides an interface to the SADIE function               */
00543 /*   MAXLIKE from Tcl/Tk.  It expects a tcl global array                      */
00544 /*   with these indices to exist:                                             */
00545 /*      array(inimg,addr)         --  SADIE image address                     */
00546 /*      array(numclasses)         --  int                                     */
00547 /*      array(prob)               --  double                                  */
00548 /*      array(inimg,array)        --  char*                                   */
00549 /*      array(outname)            --  char*                                   */
00550 /*      imgarray(class,1-numclasses,1-numregions) --  int                     */
00551 /*                                                                            */
00552 /*----------------------------------------------------------------------------*/
00553 /*-Interface Information------------------------------------------------------*/
00554 int
00555 Sadie_Classify_MaxLikeCmd (ClientData client_data, Tcl_Interp * interp,
00556                            int argc, char *argv[])
00557 {
00558   short i, j, k, l;
00559   Tcl_Obj *tclobj = NULL;
00560   Tcl_Obj *tclarrayname = NULL;
00561   Tcl_Obj *tclindexname = NULL;
00562   char msg[SLEN];
00563   char *array = NULL;
00564   char *tempstr = NULL;
00565   char *imgarray = NULL;
00566   int strlen;
00567   int inimgaddr;
00568   IMAGE *inimg = NULL;
00569   int outimgaddr;
00570   IMAGE *outimg = NULL;
00571   char *outname = NULL;
00572   int numclasses, included;
00573   double theprob;
00574   double *prob = NULL, *cov = NULL;
00575   ROIPtr r = NULL;
00576   char index[20];
00577   long n;
00578 
00579   if (argc != 2)
00580     {
00581       Tcl_AppendResult (interp, "wrong # args: should be \"",
00582                         argv[0], " arrayname\"", (char *) NULL);
00583       return TCL_ERROR;
00584     }
00585   array = argv[1];
00586 
00587   /* Read input image array(inimg,addr) */
00588   tclarrayname = Tcl_NewStringObj (array, -1);
00589   tclindexname = Tcl_NewStringObj ("inimg,addr", -1);
00590   if (tclobj =
00591       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00592                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00593     {
00594 
00595       tempstr = Tcl_GetStringFromObj (tclobj, &strlen);
00596       if (strlen <= 0)
00597         return TCL_ERROR;
00598       sscanf (tempstr, "%x", &inimgaddr);
00599       inimg = (IMAGE *) inimgaddr;
00600     }
00601   else
00602     {
00603       return TCL_ERROR;
00604     }
00605   Tcl_DecrRefCount (tclarrayname);
00606   Tcl_DecrRefCount (tclindexname);
00607 
00608   /* Read the input integer array(numclasses) */
00609   tclarrayname = Tcl_NewStringObj (array, -1);
00610   tclindexname = Tcl_NewStringObj ("numclasses", -1);
00611   if (tclobj =
00612       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00613                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00614     {
00615 
00616       if (Tcl_GetIntFromObj (interp, tclobj, &numclasses) == TCL_ERROR)
00617         return TCL_ERROR;
00618     }
00619   else
00620     {
00621       return TCL_ERROR;
00622     }
00623   Tcl_DecrRefCount (tclarrayname);
00624   Tcl_DecrRefCount (tclindexname);
00625 
00626   /* Read the input double array(prob) */
00627   tclarrayname = Tcl_NewStringObj (array, -1);
00628   tclindexname = Tcl_NewStringObj ("prob", -1);
00629   if (tclobj =
00630       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00631                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00632     {
00633 
00634       if (Tcl_GetDoubleFromObj (interp, tclobj, &theprob) == 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   /* Allocate space for the prob array */
00645   if (!(prob = (double *) malloc (numclasses * sizeof (double))))
00646     {
00647       Tcl_AppendResult (interp, "Memory request failed!", (char *) NULL);
00648       return TCL_ERROR;
00649     }
00650 
00651   /* Allocate space for the covariance array */
00652   if (!
00653       (cov =
00654        (double *) malloc ((numclasses * inimg->nbnd * inimg->nbnd) *
00655                           sizeof (double))))
00656     {
00657       Tcl_AppendResult (interp, "Memory request failed!", (char *) NULL);
00658       return TCL_ERROR;
00659     }
00660 
00661   /* Get the class boundary information */
00662   for (i = 0; i < numclasses * inimg->nbnd * inimg->nbnd; i++)
00663     {
00664       cov[i] = 0.0;
00665     }
00666 
00667   /* Read the input image array name */
00668   tclarrayname = Tcl_NewStringObj (array, -1);
00669   tclindexname = Tcl_NewStringObj ("inimg,array", -1);
00670   if (tclobj =
00671       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00672                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00673     {
00674 
00675       imgarray = Tcl_GetStringFromObj (tclobj, &strlen);
00676       if (strlen <= 0)
00677         return TCL_ERROR;
00678     }
00679   else
00680     {
00681       return TCL_ERROR;
00682     }
00683   Tcl_DecrRefCount (tclarrayname);
00684   Tcl_DecrRefCount (tclindexname);
00685 
00686   for (i = 0; i < numclasses; i++)
00687     {
00688       prob[i] = theprob;
00689 
00690       n = 0L;
00691       for (l = 0, r = inimg->regions; r != NULL; r = r->next, l++)
00692         {
00693           sprintf (index, "class,%d,%d", i + 1, l + 1);
00694           /* Read the input integer array(class,i,l) */
00695           tclarrayname = Tcl_NewStringObj (imgarray, -1);
00696           tclindexname = Tcl_NewStringObj (index, -1);
00697           if (tclobj =
00698               Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00699                               TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00700             {
00701 
00702               if (Tcl_GetIntFromObj (interp, tclobj, &included) == TCL_ERROR)
00703                 return TCL_ERROR;
00704             }
00705           else
00706             {
00707               return TCL_ERROR;
00708             }
00709           Tcl_DecrRefCount (tclarrayname);
00710           Tcl_DecrRefCount (tclindexname);
00711 
00712           if (included)
00713             {
00714               n += r->nval;
00715               for (j = 0; j < inimg->nbnd * inimg->nbnd; j++)
00716                 {
00717                   cov[i * inimg->nbnd * inimg->nbnd + j] +=
00718                     r->nval * r->cov[j];
00719                 }
00720             }
00721         }
00722       if (n > 0L)
00723         {
00724           for (j = 0; j < inimg->nbnd * inimg->nbnd; j++)
00725             {
00726               cov[i * inimg->nbnd * inimg->nbnd + j] /= n;
00727             }
00728         }
00729       else
00730         {
00731           sprintf (msg, " No training area defined for class %d.", i + 1);
00732           MESSAGE ('E', msg);
00733           goto the_end;
00734         }
00735     }
00736 
00737   /* Read the output image 1 name */
00738   tclarrayname = Tcl_NewStringObj (array, -1);
00739   tclindexname = Tcl_NewStringObj ("outname", -1);
00740   if (tclobj =
00741       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00742                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00743     {
00744 
00745       outname = Tcl_GetStringFromObj (tclobj, &strlen);
00746       if (strlen <= 0)
00747         return TCL_ERROR;
00748     }
00749   else
00750     {
00751       return TCL_ERROR;
00752     }
00753   Tcl_DecrRefCount (tclarrayname);
00754   Tcl_DecrRefCount (tclindexname);
00755 
00756   MAXLIKE (inimg, numclasses, cov, prob, &outimg);
00757 
00758   if (CHECKIMG (outimg))
00759     sprintf (outimg->text, "%s", outname);
00760   outimgaddr = (int) outimg;
00761 
00762   sprintf (msg, "%x", outimgaddr);
00763   Tcl_SetResult (interp, msg, TCL_VOLATILE);
00764 
00765 the_end:
00766   if (prob)
00767     free (prob);
00768   if (cov)
00769     free (cov);
00770 
00771   return TCL_OK;
00772 }
00773 
00774 /*-Copyright Information------------------------------------------------------*/
00775 /* Copyright (c) 1999 by the University of Arizona Digital Image Analysis Lab */
00776 /*----------------------------------------------------------------------------*/
00777 /*-General Information--------------------------------------------------------*/
00778 /*                                                                            */
00779 /*   This procedure provides an interface to the SADIE function               */
00780 /*   CLUSTER from Tcl/Tk.  It expects a tcl global array                      */
00781 /*   with these indices to exist:                                             */
00782 /*      array(inimg,addr)         --  SADIE image address                     */
00783 /*      array(iter)               --  int                                     */
00784 /*      array(classes)            --  int                                     */
00785 /*      array(min)                --  int                                     */
00786 /*      array(incr)               --  int                                     */
00787 /*      array(merging)            --  PIXEL                                   */
00788 /*      array(outlier)            --  PIXEL                                   */
00789 /*      array(outname)            --  char*                                   */
00790 /*                                                                            */
00791 /*----------------------------------------------------------------------------*/
00792 /*-Interface Information------------------------------------------------------*/
00793 int
00794 Sadie_Classify_ClusterCmd (ClientData client_data, Tcl_Interp * interp,
00795                            int argc, char *argv[])
00796 {
00797   Tcl_Obj *tclobj = NULL;
00798   Tcl_Obj *tclarrayname = NULL;
00799   Tcl_Obj *tclindexname = NULL;
00800   char msg[SLEN];
00801   char *array = NULL;
00802   char *tempstr = NULL;
00803   int strlen;
00804   int inimgaddr;
00805   IMAGE *inimg = NULL;
00806   int outimgaddr;
00807   IMAGE *outimg = NULL;
00808   char *outname = NULL;
00809   int iter, classes, min, incr;
00810   PIXEL merging, outlier;
00811   double tempdouble;
00812 
00813   if (argc != 2)
00814     {
00815       Tcl_AppendResult (interp, "wrong # args: should be \"",
00816                         argv[0], " arrayname\"", (char *) NULL);
00817       return TCL_ERROR;
00818     }
00819   array = argv[1];
00820 
00821   /* Read input image array(inimg,addr) */
00822   tclarrayname = Tcl_NewStringObj (array, -1);
00823   tclindexname = Tcl_NewStringObj ("inimg,addr", -1);
00824   if (tclobj =
00825       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00826                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00827     {
00828 
00829       tempstr = Tcl_GetStringFromObj (tclobj, &strlen);
00830       if (strlen <= 0)
00831         return TCL_ERROR;
00832       sscanf (tempstr, "%x", &inimgaddr);
00833       inimg = (IMAGE *) inimgaddr;
00834     }
00835   else
00836     {
00837       return TCL_ERROR;
00838     }
00839   Tcl_DecrRefCount (tclarrayname);
00840   Tcl_DecrRefCount (tclindexname);
00841 
00842   /* Read the input integer array(iter) */
00843   tclarrayname = Tcl_NewStringObj (array, -1);
00844   tclindexname = Tcl_NewStringObj ("iter", -1);
00845   if (tclobj =
00846       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00847                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00848     {
00849 
00850       if (Tcl_GetIntFromObj (interp, tclobj, &iter) == TCL_ERROR)
00851         return TCL_ERROR;
00852     }
00853   else
00854     {
00855       return TCL_ERROR;
00856     }
00857   Tcl_DecrRefCount (tclarrayname);
00858   Tcl_DecrRefCount (tclindexname);
00859 
00860   /* Read the input integer array(classes) */
00861   tclarrayname = Tcl_NewStringObj (array, -1);
00862   tclindexname = Tcl_NewStringObj ("classes", -1);
00863   if (tclobj =
00864       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00865                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00866     {
00867 
00868       if (Tcl_GetIntFromObj (interp, tclobj, &classes) == TCL_ERROR)
00869         return TCL_ERROR;
00870     }
00871   else
00872     {
00873       return TCL_ERROR;
00874     }
00875   Tcl_DecrRefCount (tclarrayname);
00876   Tcl_DecrRefCount (tclindexname);
00877 
00878   /* Read the input integer array(min) */
00879   tclarrayname = Tcl_NewStringObj (array, -1);
00880   tclindexname = Tcl_NewStringObj ("min", -1);
00881   if (tclobj =
00882       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00883                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00884     {
00885 
00886       if (Tcl_GetIntFromObj (interp, tclobj, &min) == TCL_ERROR)
00887         return TCL_ERROR;
00888     }
00889   else
00890     {
00891       return TCL_ERROR;
00892     }
00893   Tcl_DecrRefCount (tclarrayname);
00894   Tcl_DecrRefCount (tclindexname);
00895 
00896   /* Read the input integer array(incr) */
00897   tclarrayname = Tcl_NewStringObj (array, -1);
00898   tclindexname = Tcl_NewStringObj ("incr", -1);
00899   if (tclobj =
00900       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00901                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00902     {
00903 
00904       if (Tcl_GetIntFromObj (interp, tclobj, &incr) == TCL_ERROR)
00905         return TCL_ERROR;
00906     }
00907   else
00908     {
00909       return TCL_ERROR;
00910     }
00911   Tcl_DecrRefCount (tclarrayname);
00912   Tcl_DecrRefCount (tclindexname);
00913 
00914   /* Read the input PIXEL array(merging) */
00915   tclarrayname = Tcl_NewStringObj (array, -1);
00916   tclindexname = Tcl_NewStringObj ("merging", -1);
00917   if (tclobj =
00918       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00919                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00920     {
00921 
00922       if (Tcl_GetDoubleFromObj (interp, tclobj, &tempdouble) == TCL_ERROR)
00923         return TCL_ERROR;
00924       merging = (PIXEL) tempdouble;
00925     }
00926   else
00927     {
00928       return TCL_ERROR;
00929     }
00930   Tcl_DecrRefCount (tclarrayname);
00931   Tcl_DecrRefCount (tclindexname);
00932 
00933   /* Read the input PIXEL array(outlier) */
00934   tclarrayname = Tcl_NewStringObj (array, -1);
00935   tclindexname = Tcl_NewStringObj ("outlier", -1);
00936   if (tclobj =
00937       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00938                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00939     {
00940 
00941       if (Tcl_GetDoubleFromObj (interp, tclobj, &tempdouble) == TCL_ERROR)
00942         return TCL_ERROR;
00943       outlier = (PIXEL) tempdouble;
00944     }
00945   else
00946     {
00947       return TCL_ERROR;
00948     }
00949   Tcl_DecrRefCount (tclarrayname);
00950   Tcl_DecrRefCount (tclindexname);
00951 
00952   /* Read the output image 1 name */
00953   tclarrayname = Tcl_NewStringObj (array, -1);
00954   tclindexname = Tcl_NewStringObj ("outname", -1);
00955   if (tclobj =
00956       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
00957                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
00958     {
00959 
00960       outname = Tcl_GetStringFromObj (tclobj, &strlen);
00961       if (strlen <= 0)
00962         return TCL_ERROR;
00963     }
00964   else
00965     {
00966       return TCL_ERROR;
00967     }
00968   Tcl_DecrRefCount (tclarrayname);
00969   Tcl_DecrRefCount (tclindexname);
00970 
00971   CLUSTER (inimg, iter, classes, min, merging, 1, incr, incr, outlier,
00972            &outimg);
00973 
00974   if (CHECKIMG (outimg))
00975     sprintf (outimg->text, "%s", outname);
00976   outimgaddr = (int) outimg;
00977 
00978   sprintf (msg, "%x", outimgaddr);
00979   Tcl_SetResult (interp, msg, TCL_VOLATILE);
00980 
00981   return TCL_OK;
00982 }
00983 
00984 /*-Copyright Information------------------------------------------------------*/
00985 /* Copyright (c) 1999 by the University of Arizona Digital Image Analysis Lab */
00986 /*----------------------------------------------------------------------------*/
00987 /*-General Information--------------------------------------------------------*/
00988 /*                                                                            */
00989 /*   This procedure provides an interface to the SADIE function               */
00990 /*   SEGMENT from Tcl/Tk.  It expects a tcl global array                      */
00991 /*   with these indices to exist:                                             */
00992 /*      array(inimg,addr)         --  SADIE image address                     */
00993 /*      array(steps)              --  int                                     */
00994 /*      array(sigma)              --  double                                  */
00995 /*      array(thresh)             --  PIXEL                                   */
00996 /*      array(outname)            --  char*                                   */
00997 /*                                                                            */
00998 /*----------------------------------------------------------------------------*/
00999 /*-Interface Information------------------------------------------------------*/
01000 int
01001 Sadie_Classify_SegmentCmd (ClientData client_data, Tcl_Interp * interp,
01002                            int argc, char *argv[])
01003 {
01004   Tcl_Obj *tclobj = NULL;
01005   Tcl_Obj *tclarrayname = NULL;
01006   Tcl_Obj *tclindexname = NULL;
01007   char msg[SLEN];
01008   char *array = NULL;
01009   char *tempstr = NULL;
01010   int strlen;
01011   int inimgaddr;
01012   IMAGE *inimg = NULL;
01013   int outimgaddr;
01014   IMAGE *outimg = NULL;
01015   char *outname = NULL;
01016   int steps;
01017   double sigma;
01018   PIXEL thresh;
01019   double tempdouble;
01020 
01021   if (argc != 2)
01022     {
01023       Tcl_AppendResult (interp, "wrong # args: should be \"",
01024                         argv[0], " arrayname\"", (char *) NULL);
01025       return TCL_ERROR;
01026     }
01027   array = argv[1];
01028 
01029   /* Read input image array(inimg,addr) */
01030   tclarrayname = Tcl_NewStringObj (array, -1);
01031   tclindexname = Tcl_NewStringObj ("inimg,addr", -1);
01032   if (tclobj =
01033       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
01034                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
01035     {
01036 
01037       tempstr = Tcl_GetStringFromObj (tclobj, &strlen);
01038       if (strlen <= 0)
01039         return TCL_ERROR;
01040       sscanf (tempstr, "%x", &inimgaddr);
01041       inimg = (IMAGE *) inimgaddr;
01042     }
01043   else
01044     {
01045       return TCL_ERROR;
01046     }
01047   Tcl_DecrRefCount (tclarrayname);
01048   Tcl_DecrRefCount (tclindexname);
01049 
01050   /* Read the input integer array(steps) */
01051   tclarrayname = Tcl_NewStringObj (array, -1);
01052   tclindexname = Tcl_NewStringObj ("steps", -1);
01053   if (tclobj =
01054       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
01055                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
01056     {
01057 
01058       if (Tcl_GetIntFromObj (interp, tclobj, &steps) == TCL_ERROR)
01059         return TCL_ERROR;
01060     }
01061   else
01062     {
01063       return TCL_ERROR;
01064     }
01065   Tcl_DecrRefCount (tclarrayname);
01066   Tcl_DecrRefCount (tclindexname);
01067 
01068   /* Read the input double array(sigma) */
01069   tclarrayname = Tcl_NewStringObj (array, -1);
01070   tclindexname = Tcl_NewStringObj ("sigma", -1);
01071   if (tclobj =
01072       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
01073                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
01074     {
01075 
01076       if (Tcl_GetDoubleFromObj (interp, tclobj, &sigma) == TCL_ERROR)
01077         return TCL_ERROR;
01078     }
01079   else
01080     {
01081       return TCL_ERROR;
01082     }
01083   Tcl_DecrRefCount (tclarrayname);
01084   Tcl_DecrRefCount (tclindexname);
01085 
01086   /* Read the input PIXEL array(thresh) */
01087   tclarrayname = Tcl_NewStringObj (array, -1);
01088   tclindexname = Tcl_NewStringObj ("thresh", -1);
01089   if (tclobj =
01090       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
01091                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
01092     {
01093 
01094       if (Tcl_GetDoubleFromObj (interp, tclobj, &tempdouble) == TCL_ERROR)
01095         return TCL_ERROR;
01096       thresh = (PIXEL) tempdouble;
01097     }
01098   else
01099     {
01100       return TCL_ERROR;
01101     }
01102   Tcl_DecrRefCount (tclarrayname);
01103   Tcl_DecrRefCount (tclindexname);
01104 
01105   /* Read the output image 1 name */
01106   tclarrayname = Tcl_NewStringObj (array, -1);
01107   tclindexname = Tcl_NewStringObj ("outname", -1);
01108   if (tclobj =
01109       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
01110                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
01111     {
01112 
01113       outname = Tcl_GetStringFromObj (tclobj, &strlen);
01114       if (strlen <= 0)
01115         return TCL_ERROR;
01116     }
01117   else
01118     {
01119       return TCL_ERROR;
01120     }
01121   Tcl_DecrRefCount (tclarrayname);
01122   Tcl_DecrRefCount (tclindexname);
01123 
01124   SEGMENT (inimg, steps, sigma, thresh, &outimg);
01125 
01126   if (CHECKIMG (outimg))
01127     sprintf (outimg->text, "%s", outname);
01128   outimgaddr = (int) outimg;
01129 
01130   sprintf (msg, "%x", outimgaddr);
01131   Tcl_SetResult (interp, msg, TCL_VOLATILE);
01132 
01133   return TCL_OK;
01134 }
01135 
01136 /*-Copyright Information------------------------------------------------------*/
01137 /* Copyright (c) 1999 by the University of Arizona Digital Image Analysis Lab */
01138 /*----------------------------------------------------------------------------*/
01139 /*-General Information--------------------------------------------------------*/
01140 /*                                                                            */
01141 /*   This procedure provides an interface to the SADIE function               */
01142 /*   SIGMAP from Tcl/Tk.  It expects a tcl global array                       */
01143 /*   with these indices to exist:                                             */
01144 /*      array(lblmap,addr)        --  SADIE image address                     */
01145 /*      array(origimg,addr)       --  SADIE image address                     */
01146 /*      array(outname)            --  char*                                   */
01147 /*                                                                            */
01148 /*----------------------------------------------------------------------------*/
01149 /*-Interface Information------------------------------------------------------*/
01150 int
01151 Sadie_Classify_SigMapCmd (ClientData client_data, Tcl_Interp * interp,
01152                           int argc, char *argv[])
01153 {
01154   Tcl_Obj *tclobj = NULL;
01155   Tcl_Obj *tclarrayname = NULL;
01156   Tcl_Obj *tclindexname = NULL;
01157   char msg[SLEN];
01158   char *array = NULL;
01159   char *tempstr = NULL;
01160   int strlen;
01161   int lblmapaddr, origimgaddr;
01162   IMAGE *lblmap = NULL, *origimg = NULL;
01163   int outimgaddr;
01164   IMAGE *outimg = NULL;
01165   char *outname = NULL;
01166 
01167   if (argc != 2)
01168     {
01169       Tcl_AppendResult (interp, "wrong # args: should be \"",
01170                         argv[0], " arrayname\"", (char *) NULL);
01171       return TCL_ERROR;
01172     }
01173   array = argv[1];
01174 
01175   /* Read input image array(lblmap,addr) */
01176   tclarrayname = Tcl_NewStringObj (array, -1);
01177   tclindexname = Tcl_NewStringObj ("lblmap,addr", -1);
01178   if (tclobj =
01179       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
01180                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
01181     {
01182 
01183       tempstr = Tcl_GetStringFromObj (tclobj, &strlen);
01184       if (strlen <= 0)
01185         return TCL_ERROR;
01186       sscanf (tempstr, "%x", &lblmapaddr);
01187       lblmap = (IMAGE *) lblmapaddr;
01188     }
01189   else
01190     {
01191       return TCL_ERROR;
01192     }
01193   Tcl_DecrRefCount (tclarrayname);
01194   Tcl_DecrRefCount (tclindexname);
01195 
01196   /* Read input image array(origimg,addr) */
01197   tclarrayname = Tcl_NewStringObj (array, -1);
01198   tclindexname = Tcl_NewStringObj ("origimg,addr", -1);
01199   if (tclobj =
01200       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
01201                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
01202     {
01203 
01204       tempstr = Tcl_GetStringFromObj (tclobj, &strlen);
01205       if (strlen <= 0)
01206         return TCL_ERROR;
01207       sscanf (tempstr, "%x", &origimgaddr);
01208       origimg = (IMAGE *) origimgaddr;
01209     }
01210   else
01211     {
01212       return TCL_ERROR;
01213     }
01214   Tcl_DecrRefCount (tclarrayname);
01215   Tcl_DecrRefCount (tclindexname);
01216 
01217   /* Read the output image 1 name */
01218   tclarrayname = Tcl_NewStringObj (array, -1);
01219   tclindexname = Tcl_NewStringObj ("outname", -1);
01220   if (tclobj =
01221       Tcl_ObjGetVar2 (interp, tclarrayname, tclindexname,
01222                       TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG))
01223     {
01224 
01225       outname = Tcl_GetStringFromObj (tclobj, &strlen);
01226       if (strlen <= 0)
01227         return TCL_ERROR;
01228     }
01229   else
01230     {
01231       return TCL_ERROR;
01232     }
01233   Tcl_DecrRefCount (tclarrayname);
01234   Tcl_DecrRefCount (tclindexname);
01235 
01236   SIGMAP (lblmap, origimg, &outimg);
01237 
01238   if (CHECKIMG (outimg))
01239     sprintf (outimg->text, "%s", outname);
01240   outimgaddr = (int) outimg;
01241 
01242   sprintf (msg, "%x", outimgaddr);
01243   Tcl_SetResult (interp, msg, TCL_VOLATILE);
01244 
01245   return TCL_OK;
01246 }
01247 
01248 /*-Copyright Information------------------------------------------------------*/
01249 /* Copyright (c) 1999 by the University of Arizona Digital Image Analysis Lab */
01250 /*----------------------------------------------------------------------------*/
01251 /*-General Information--------------------------------------------------------*/
01252 /*                                                                            */
01253 /*   This procedure initializes the all of the procedures                     */
01254 /*   in this file by registering them with Tcl.                               */
01255 /*                                                                            */
01256 /*----------------------------------------------------------------------------*/
01257 /*-Interface Information------------------------------------------------------*/
01258 int
01259 Sadie_Classify_Init (Tcl_Interp * interp)
01260 {
01261   Tcl_CreateCommand (interp, "Sadie_Classify_LvlSlice",
01262                      Sadie_Classify_LvlSliceCmd, (ClientData) NULL, NULL);
01263   Tcl_CreateCommand (interp, "Sadie_Classify_MinDist",
01264                      Sadie_Classify_MinDistCmd, (ClientData) NULL, NULL);
01265   Tcl_CreateCommand (interp, "Sadie_Classify_MaxLike",
01266                      Sadie_Classify_MaxLikeCmd, (ClientData) NULL, NULL);
01267   Tcl_CreateCommand (interp, "Sadie_Classify_Cluster",
01268                      Sadie_Classify_ClusterCmd, (ClientData) NULL, NULL);
01269   Tcl_CreateCommand (interp, "Sadie_Classify_Segment",
01270                      Sadie_Classify_SegmentCmd, (ClientData) NULL, NULL);
01271   Tcl_CreateCommand (interp, "Sadie_Classify_SigMap",
01272                      Sadie_Classify_SigMapCmd, (ClientData) NULL, NULL);
01273   return TCL_OK;
01274 }