]> www.wagner.pp.ru Git - oss/fgis.git/blob - dll/fgisPalette.c
The second attempt to automate building :-) A lot of work here should be
[oss/fgis.git] / 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 }