dll/fgisPalette.c

   1 #include <string.h>
   2 #include <stdlib.h>
   3 #include <stdio.h>
   4 #include <tcl.h>
   5 #include "fgis.h"
   6 /*
   7  * fgisclr.c - palette handling for Fgis
   8  * Copyringht (C) by SoftWeyr, 1997
   9  */
  10 /*
  11  * Global variables
  12  */
  13
  14 /*
  15  *# Default palette array
  16  */
  17 int defarray[]={
  18 #include "defpal.h"
  19 };
  20
  21 PALETTE default_palette=defarray;
  22 /*
  23  * Creates new palette. Optionally fills from existing palette. If no existing
  24  * palette supplied, all colors will be white
  25  */
  26
  27 PALETTE new_palette(PALETTE copy_from)
  28 { PALETTE new_p= (PALETTE)Tcl_Alloc(256*sizeof(int));
  29   if (copy_from) {
  30     memcpy(new_p,copy_from,256*sizeof(int));
  31   } else {
  32     int i,*c;
  33     for (i=0,c=new_p;i<256;i++)
  34       *(c++)=0xffffff;
  35   }
  36   return new_p;
  37 }
  38 /*
  39  * Parses string, containing pallette in EPPL7 file format EPPL7
  40  */
  41 PALETTE parse_palette(Tcl_Interp *interp,char *string)
  42 { PALETTE pal;
  43   int index,r,g,b;
  44   char *start=string,*end, line[80];
  45   pal=new_palette(default_palette);
  46   /* ASSIGNMENT INSIDE IF */
  47   while (( end=strchr(start,'\n'))) {
  48     int n=(end-start);
  49     if (n==0) continue; /*won't bother with empty lines */
  50     if (n>79) n=79;
  51     strncpy(line,start,n);
  52     start=end+1;
  53     if (sscanf(line,"%d %d %d %d",&index,&r,&g,&b)!=4) {
  54         Tcl_Free((char *)pal);
  55         return NULL;
  56     }
  57     if (index>255||index<0)
  58         continue;
  59     pal[index]=(r*255/1000)<<16|(g*255/1000)<<8|(b*255/1000);
  60   } ;
  61   return pal;
  62 }
  63 /*
  64  * Returns index entry of palette in form #RRGGBB
  65  *
  66  */
  67
  68
  69 char *Xcolor_string(PALETTE palette,int index)
  70 { int value;
  71   static char buffer[24];
  72   if(index>=0&&index<255)
  73       value=palette[index];
  74   else
  75       value=palette[255];
  76   sprintf(buffer,"#%06x",value);
  77   return buffer;
  78 }
  79 /*
  80  * parses RGB specification in form #RRGGBB.
  81  * Returns integer value or 0x1000000 in case of error.
  82  */
  83 int ParseRGB(Tcl_Interp *interp,char *spec)
  84 {  int val;char *endptr;
  85    val= strtol(spec+1,&endptr,16);
  86     if ((*endptr)||(spec[0]!='#')||(strlen(spec)!=7)) {
  87        Tcl_SetResult(interp,"Only #RRGGBB color specification is supported",
  88            TCL_STATIC);
  89         return 0x1000000;
  90     }
  91     return val;
  92 }
  93 /*
  94  * Implements "palette" fgis command.
  95  * input - argv[1] subcommand, argv[2] parameter, if required.
  96  *   subcommands:
  97  *   read filename
  98  *   parse string
  99  *   copy palettename
 100  *   blank
 101  * Returns (in interp result) - name of newly created palette
 102  * Side effects: defines new Tcl command to handle this palette
 103  */
 104 EXPORT(int, Fgis_Palette)(ClientData data,Tcl_Interp *interp,int argc,char **argv)
 105 { PALETTE pal;
 106   if (argc<2) {
 107        Tcl_SetResult(interp,"Wrong # of args. Should be palette command ?arg?",
 108            TCL_STATIC); return TCL_ERROR;
 109   }
 110   if (!strcmp(argv[1],"read")) {
 111     Tcl_Channel f; /* no comments */
 112     int size; /* return value from Tcl_Read. its size,yes but used just for
 113                  error checking */
 114     char buf[MAX_PALETTE_SIZE];/* place to hold readed file */
 115
 116     if (Fgis_CkArgs(interp,argc!=3,argv[0]," read filename")) return TCL_ERROR;
 117     f=Tcl_OpenFileChannel(interp,argv[2],"r",0666);
 118     if (!f) return TCL_ERROR;
 119     size=Tcl_Read(f,buf,MAX_PALETTE_SIZE);
 120     Tcl_Close(interp,f);
 121     if (size==-1) {return TCL_ERROR;}
 122     if (!(pal=parse_palette(interp,buf))) return TCL_ERROR;
 123   } else if (!strcmp(argv[1],"parse")) {
 124    if (Fgis_CkArgs(interp,argc!=3,argv[0]," parse string")) return TCL_ERROR;
 125    if (!(pal=parse_palette(interp,argv[2]))) {
 126      return TCL_ERROR;
 127    }
 128   } else if (!strcmp(argv[1],"set")) {
 129      int listc,i;char **listv;
 130      if (Fgis_CkArgs(interp,argc!=3,argv[0]," set list")) return TCL_ERROR;
 131      pal=new_palette(default_palette);
 132      if (TCL_ERROR==Tcl_SplitList(interp,argv[2],&listc,&listv))
 133        return TCL_ERROR;
 134      for (i=0;i<listc;i++) {
 135        pal[i]=ParseRGB(interp,listv[i]);
 136        if (pal[i]==0x1000000) { Tcl_Free((char *)listv);return TCL_ERROR;}
 137      }
 138      Tcl_Free((char *)listv);
 139   } else if (!strcmp(argv[1],"copy")) {
 140     PALETTE oldpal;
 141     if (Fgis_CkArgs(interp,argc!=3,argv[0]," copy palettename")) return TCL_ERROR;
 142     oldpal=Fgis_GetPalette(interp,argv[2]);
 143     if (oldpal==NULL)
 144        return TCL_ERROR;
 145     pal=new_palette(oldpal);
 146   } else if (!strcmp(argv[1],"blank")) {
 147     if (Fgis_CkArgs(interp,argc!=2,argv[0]," blank")) return TCL_ERROR;
 148     pal=new_palette(NULL);
 149   } else {
 150    char buffer[255];
 151    sprintf(buffer,"Wrong option %s. Should be one of read parse set blank copy",
 152             argv[1]);
 153     Tcl_SetResult(interp,buffer,TCL_VOLATILE);
 154     return TCL_ERROR;
 155   }
 156   return Fgis_CreateObjectCommand(interp,"palette",Fgis_PaletteObj,
 157         (ClientData)pal, Fgis_DeletePalette);
 158 }
 159 /*
 160  * Obtain PALETTE pointer from name of command.
 161  * Returns NULL in case of error.
 162  */
 163
 164 EXPORT(PALETTE, Fgis_GetPalette)(Tcl_Interp *interp, char *name)
 165 {
 166     Tcl_CmdInfo info;char buffer[255]="Invalid palette: ";
 167     if (!Tcl_GetCommandInfo(interp,name,&info)) return NULL;
 168     if (info.proc!=&Fgis_PaletteObj) {
 169        strcat(buffer,name);
 170        Tcl_SetResult(interp,buffer,TCL_VOLATILE);
 171        return NULL;
 172     }
 173     return (PALETTE)(info.clientData);
 174 }
 175
 176 /*
 177  * implements palette object command;
 178  * Arguments argv[1]- subcommand argv[i] - parameters
 179  * Checks subcommand and calls appropriate function
 180  */
 181
 182 EXPORT(int, Fgis_PaletteObj)(ClientData data,Tcl_Interp *interp,int argc,char **argv)
 183 {
 184
 185   PALETTE clr=(PALETTE)data;
 186   char buffer[255];
 187   int read_only=0;
 188   /* default palette supposed to be in readonly memory */
 189   read_only=clr==default_palette;
 190   /* prepare command name for error message */
 191   strcpy(buffer,argv[0]);
 192   if (Fgis_CkArgs(interp,argc<2,argv[0]," command ?args?"))
 193         return TCL_ERROR;
 194   if (!strcmp(argv[1],"print")) {
 195     int i;
 196     if (Fgis_CkArgs(interp,argc!=2,argv[0]," print"))
 197        return TCL_ERROR;
 198     for (i=0;i<256;i++) {
 199       sprintf(buffer,"%3d %4d %4d %4d\n", i,
 200         (clr[i]>>16)*1000/255,
 201         ((clr[i]>>8) & 0xFF)*1000/255,
 202         (clr[i] & 0xff)*1000/255);
 203       Tcl_AppendResult(interp,buffer,NULL);
 204     }
 205     return TCL_OK;
 206   } else
 207   if (!strcmp(argv[1],"get")) {
 208      int index;
 209      if (Fgis_CkArgs(interp,argc!=3,argv[0],
 210                " get index"))
 211             return TCL_ERROR;
 212      if (Tcl_GetInt(interp,argv[2],&index)==TCL_ERROR) return TCL_ERROR;
 213      if (index<0||index>255) {
 214         Tcl_SetResult(interp,"#ffffff",TCL_STATIC);
 215      } else {
 216         Tcl_SetResult(interp,Xcolor_string(clr,index),TCL_VOLATILE);
 217      }
 218      return TCL_OK;
 219   }
 220   else
 221   if (!strcmp(argv[1],"set")) {
 222     int index,RGB;
 223        if (read_only) {
 224           Tcl_AppendResult(interp,argv[0]," is read only",NULL);
 225           return TCL_ERROR;
 226        }
 227    if (Fgis_CkArgs(interp,argc!=4,argv[0],
 228             " set index color"))
 229       return TCL_ERROR;
 230    if (Tcl_GetInt(interp,argv[2],&index)==TCL_ERROR) return TCL_ERROR;
 231    if (index<0||index>255) {
 232        Tcl_SetResult(interp, "Palette index must be from 0 to 255",
 233            TCL_STATIC);
 234        return TCL_ERROR;
 235    }
 236    if ((RGB=ParseRGB(interp,argv[3]))>0xFFFFFF) return TCL_ERROR;
 237    clr[index]=RGB;
 238    return TCL_OK;
 239   }
 240   else
 241   if (!strcmp(argv[1],"list")) {
 242    int i;
 243    if (Fgis_CkArgs(interp,argc!=2,argv[0]," list"))
 244      return TCL_ERROR;
 245    for(i=0;i<256;i++)
 246    { Tcl_AppendElement(interp,Xcolor_string(clr,i));
 247    }
 248    return TCL_OK;
 249   }
 250   else
 251   if (!strcmp(argv[1],"delete")) {
 252    if (Fgis_CkArgs(interp,argc!=2,argv[0]," delete")) return TCL_ERROR;
 253    if (read_only) {
 254     Tcl_AppendResult(interp,buffer," is read only",NULL);
 255     return TCL_ERROR;
 256    }
 257    Tcl_DeleteCommand(interp,argv[0]);
 258    return TCL_OK;
 259   }
 260   else
 261   { Tcl_SetResult(interp,"Wrong option. Should be one of print, get, set, "
 262       " list, delete", TCL_STATIC);
 263     return TCL_ERROR;
 264   }
 265  return TCL_OK;
 266 }
 267
 268 EXPORT(void, Fgis_DeletePalette)(ClientData data)
 269 {
 270  if (data == default_palette) return;
 271  Tcl_Free((char *)data);
 272 }