dll/fgisInit.c

   1 /*
   2  *fgisInit.c -
   3  *initialization procedure for Fgis package
   4  * Copyright (C) by SoftWeyr, 1997
   5  */
   6 #include <string.h>
   7 #include <math.h>
   8 #include <stdlib.h>
   9 #include <stdio.h>
  10
  11 #include <tcl.h>
  12 #include <tk.h>
  13 #include "fgis.h"
  14
  15 int check_for_rc(Tcl_Interp *interp,char *home,char *path);
  16 /* Global variables */
  17 \f
  18 /*
  19  * Initialization procedure for Environmental Planning Tcl extension
  20  * Return value TCL_OK if success
  21  * Side effects:
  22  * defines commands raster vector palette fgisPlanchet_mapx fgisPlanchet_mapy
  23  * fgisPlanchet_scrx fgisPlanchet_scry fgisPlanchet_fit defaultpalette
  24  * defines default (1:1) reclass table
  25  * defines fGIS_HOME variable to directory, containing fgis.rc
  26  *     Directories are searched in following order
  27  *     FGIS_HOME as defined in Makefile
  28  *     ~/lib/fgis
  29  * executes fgis.rc
  30  */
  31 EXPORT(int, Fgis_Init)(Tcl_Interp *interp)
  32 {
  33   char *fGIS_HOME;
  34   char buffer[1024];
  35 /* Defining commands */
  36
  37 /* Palette objects */
  38     if (!Tcl_CreateCommand(interp,"palette",Fgis_Palette,NULL,
  39             Fgis_DefDeleteProc))
  40         return TCL_ERROR;
  41     if (!Tcl_CreateCommand(interp,"defaultpalette",Fgis_PaletteObj,
  42        (ClientData)default_palette,Fgis_DeletePalette))
  43        return TCL_ERROR;
  44 /* Pattern objects */
  45     if (!Tcl_CreateCommand(interp,"patterns",Fgis_CreatePatterns,
  46           NULL,Fgis_DefDeleteProc))
  47         return TCL_ERROR;
  48 /* Raster objects */
  49     if (!Tcl_CreateCommand(interp,"raster",Fgis_Raster,
  50             NULL,Fgis_DeleteRaster))
  51         return TCL_ERROR;
  52 /* Vector objects */
  53     if (!Tcl_CreateCommand(interp,"vector",Fgis_Vector,NULL,Fgis_DefDeleteProc))
  54        return TCL_ERROR;
  55   /* Tk dependent fgis commands. Should eventually go into separate package*/
  56   /* Object Drawing */
  57    if (!Tcl_CreateCommand(interp,"fgisRasterColorImage",Fgis_RasterImage,
  58        (ClientData)1,Fgis_DefDeleteProc)) return TCL_ERROR;
  59    if (!Tcl_CreateCommand(interp,"fgisRasterBWImage",Fgis_RasterImage,
  60       NULL,Fgis_DefDeleteProc)) return TCL_ERROR;
  61   /* planchet widget subcommands, written on C */
  62     if (!Tcl_CreateCommand(interp,"fgisPlanchet_mapx",Fgis_MapX,NULL,
  63        Fgis_DefDeleteProc))
  64         return TCL_ERROR;
  65     if (!Tcl_CreateCommand(interp,"fgisPlanchet_mapy",Fgis_MapY,NULL,
  66             Fgis_DefDeleteProc))
  67
  68         return TCL_ERROR;
  69     if (!Tcl_CreateCommand(interp,"fgisPlanchet_scrx",Fgis_ScrX,NULL,
  70             Fgis_DefDeleteProc))
  71         return TCL_ERROR;
  72     if (!Tcl_CreateCommand(interp,"fgisPlanchet_scry",Fgis_ScrY,NULL,
  73         Fgis_DefDeleteProc))
  74         return TCL_ERROR;
  75     if (!Tcl_CreateCommand(interp,"fgisPlanchet_fit",Fgis_Fit,NULL,
  76         Fgis_DefDeleteProc))
  77         return TCL_ERROR;
  78     if (!Tcl_CreateCommand(interp,"projection",Fgis_Projection,NULL,
  79         Fgis_DefDeleteProc))
  80         return TCL_ERROR;
  81
  82     /* Searching for fgis.rc and executing it */
  83     /* First, check if fGIS_HOME already set */
  84     if ((fGIS_HOME=Tcl_GetVar(interp,"fGIS_HOME",TCL_GLOBAL_ONLY))==NULL) {
  85          fGIS_HOME=buffer;
  86          /* Check if compilied in default is valid */
  87          if (!check_for_rc(interp,fGIS_HOME,FGIS_HOME)&&
  88 #ifdef __unix__
  89              !check_for_rc(interp,fGIS_HOME,"/usr/local/lib/fgis")&&
  90              !check_for_rc(interp,fGIS_HOME,"/usr/lib/fgis")&&
  91              !check_for_rc(interp,fGIS_HOME,"~/fgis")
  92 #else
  93              !check_for_rc(interp,fGIS_HOME,"C:/FGIS") &&
  94              !check_for_rc(interp,fGIS_HOME,"C:/Program Files/fGIS") &&
  95              !check_for_rc(interp,fGIS_HOME,"C:/TCL/LIB/fGIS")
  96 #endif
  97             ) {
  98                  Tcl_SetResult(interp,"Cannot determine fGIS home directory",
  99                          TCL_STATIC);
 100                  return TCL_ERROR;
 101          };
 102         Tcl_SetVar(interp,"fGIS_HOME",fGIS_HOME,TCL_GLOBAL_ONLY);
 103     }
 104
 105     if (Tcl_EvalFile(interp,FGIS_HOME "/fgis.rc")!=TCL_OK) {
 106             Tcl_SetResult(interp,"Error in initialization file",TCL_STATIC);
 107             return TCL_ERROR;
 108     }
 109     /* Providing package for Tcl versions, which supports it */
 110 #if (TCL_MAJOR_VERSION>7)||((TCL_MAJOR_VERSION==7)&&(TCL_MINOR_VERSION>=5))
 111     Tcl_PkgProvide(interp,"Fgis","0.1");
 112 #endif
 113     return TCL_OK;
 114 }
 115
 116 int check_for_rc (Tcl_Interp *interp,char *home,char *path)
 117 { char buffer[1024];
 118   int result;
 119   sprintf(buffer,"file readable [file join {%s} fgis.rc]",path);
 120   Tcl_Eval(interp,buffer);
 121   if (Tcl_GetInt(interp,interp->result,&result)==TCL_OK&& result) {
 122       strcpy(home,path);
 123       return 1;
 124   }
 125   return 0;
 126 }