dll/fgisMisc.c

   1 #include <tcl.h>
   2 #include <stdlib.h>
   3 #include <string.h>
   4 #include "fgis.h"
   5 /*
   6  * Utility functions, I need to program fgis
   7  * Copyright (c) Softweyr, 1997
   8  */
   9 /*
  10  * If passed condition is true, puts standard error message, appended
  11  * by msg argument to interp->result.
  12  * Returns cond
  13  *
  14  */
  15 int Fgis_CkArgs(Tcl_Interp *interp,int cond,char *cmd, char *msg)
  16 { static char buffer[256]="Wrong # args. Should be ";
  17   if (cond) {
  18    Tcl_ResetResult(interp);
  19    Tcl_AppendResult(interp,buffer,cmd," ",msg,NULL);
  20   }
  21   return cond;
  22 }
  23 /*
  24  * Get integer value from command argument and checks it for valid range.
  25  * ARGUMENTS:
  26  *     interp: Tcl interpreter to leave error message
  27  *     argc, argv - command arguments
  28  *     index - position of argument in question in argv
  29  *     min, max - range limits
  30  *     name - string name of parameter to report errors more clearly
  31  * RETURNS:
  32  *    TCL_OK on success, TCL_ERROR on failure
  33  * SIDE EFFECTS:
  34  *    Places read integer in location, specified by result
  35  */
  36
  37 int Fgis_GetInt(Tcl_Interp *interp,int argc,char **argv,int index,
  38                 int min, int max,int *result, char *name)
  39 {
  40     int tmp;/* Temporary place to hold result */
  41     char msg[1024]; /* place to format error messages */
  42
  43     if (index==argc) {
  44         Tcl_SetResult(interp, "Integer value expected",TCL_STATIC);
  45         return TCL_ERROR;
  46     }
  47
  48      if (Tcl_GetInt(interp,argv[index],&tmp)!=TCL_OK)
  49         return TCL_ERROR;
  50      if (tmp<=min||tmp>=max) {
  51         sprintf(msg,"Invalid %s: %d. Should be between %d and %d",
  52                 name,tmp,min,max);
  53         Tcl_SetResult(interp,msg,TCL_VOLATILE);
  54         return TCL_ERROR;
  55      }
  56      *result=tmp;
  57      return TCL_OK;
  58 }
  59 char *inttostr(long src,char *dest)
  60 { sprintf(dest,"%ld",src);
  61   return dest;
  62 }
  63 \f
  64 /*
  65  * Searches for free command name with given prefix and creates command
  66  * with it. Places name of command into interp->result
  67  * Returns TCL_OK on success, TCL_ERROR otherwise
  68  */
  69 int Fgis_CreateObjectCommand(Tcl_Interp *interp,char *prefix,
  70            Tcl_CmdProc *proc,ClientData data,Tcl_CmdDeleteProc deleteProc)
  71
  72 {   int num=0;
  73     static char token[30],*numstart;
  74     Tcl_CmdInfo info;
  75     strcpy(token,prefix);
  76     numstart=token+strlen(prefix);
  77     while (1) {
  78       inttostr(num,numstart);
  79       if (Tcl_GetCommandInfo(interp,token,&info)) num++; else break;
  80     }
  81     Tcl_SetResult(interp,token,TCL_VOLATILE);
  82     if (!Tcl_CreateCommand(interp,token,proc,data,deleteProc)) {
  83          (*deleteProc)(data); return TCL_ERROR;
  84     } else {
  85        return TCL_OK;
  86     }
  87 }
  88
  89 \f
  90 /*
  91  *  Standard TclDeleteProc for commads, which have no ClientData
  92  *  Does nothing, successifully
  93  */
  94 EXPORT(void, Fgis_DefDeleteProc)(ClientData clientdata)
  95 {
  96 }
  97 \f
  98 /*
  99  * Fgis_GetLimits - parses four-element list of doubles, putting them
 100  * into four specified global variables
 101  * ARGUMENTS: interp - Tcl interpreter to return error
 102  *            list - string to parse
 103  *            X1,Y1,X2,Y2 - double variables to put results
 104  * RETURNS: TCL_OK on success, TCL_ERROR otherwise
 105  * SIDE EFFECTS: Fills four double variables
 106  */
 107 int Fgis_GetLimits(Tcl_Interp *interp,char *list,double *X1,double *Y1,
 108                    double *X2,double *Y2)
 109 {
 110     int no_error;/* Temporary flag, to pass success around Tcl_Free */
 111     int listc; char **listv; /* for TclSplitList */
 112     double x1,y1,x2,y2; /* Temporary place for results to avoid overriding if
 113                         error occurs */
 114
 115     if(Tcl_SplitList(interp,list,&listc,&listv)==TCL_ERROR)
 116      return TCL_ERROR;
 117     if (listc!=4) {
 118     Tcl_SetResult(interp,"Invalid limits list",TCL_STATIC);
 119     Tcl_Free((char *)listv);
 120     return TCL_ERROR;
 121     }
 122     no_error = (Tcl_GetDouble(interp,listv[0],&x1)==TCL_OK) &&
 123              (Tcl_GetDouble(interp,listv[1],&y1)==TCL_OK) &&
 124              (Tcl_GetDouble(interp,listv[2],&x2)==TCL_OK) &&
 125              (Tcl_GetDouble(interp,listv[3],&y2)==TCL_OK);
 126     Tcl_Free((char*)listv);
 127     if (no_error) {
 128         *X1=x1; *Y1=y1; *X2=x2; *Y2=y2;
 129         return TCL_OK;
 130     } else {
 131        return TCL_ERROR;
 132     }
 133 }