7 * fgisclr.c - palette handling for Fgis
8 * Copyringht (C) by SoftWeyr, 1997
15 *# Default palette array
21 PALETTE default_palette=defarray;
23 * Creates new palette. Optionally fills from existing palette. If no existing
24 * palette supplied, all colors will be white
27 PALETTE new_palette(PALETTE copy_from)
28 { PALETTE new_p= (PALETTE)Tcl_Alloc(256*sizeof(int));
30 memcpy(new_p,copy_from,256*sizeof(int));
33 for (i=0,c=new_p;i<256;i++)
39 * Parses string, containing pallette in EPPL7 file format EPPL7
41 PALETTE parse_palette(Tcl_Interp *interp,char *string)
44 char *start=string,*end, line[80];
45 pal=new_palette(default_palette);
46 /* ASSIGNMENT INSIDE IF */
47 while (( end=strchr(start,'\n'))) {
49 if (n==0) continue; /*won't bother with empty lines */
51 strncpy(line,start,n);
53 if (sscanf(line,"%d %d %d %d",&index,&r,&g,&b)!=4) {
54 Tcl_Free((char *)pal);
57 if (index>255||index<0)
59 pal[index]=(r*255/1000)<<16|(g*255/1000)<<8|(b*255/1000);
64 * Returns index entry of palette in form #RRGGBB
69 char *Xcolor_string(PALETTE palette,int index)
71 static char buffer[24];
72 if(index>=0&&index<255)
76 sprintf(buffer,"#%06x",value);
80 * parses RGB specification in form #RRGGBB.
81 * Returns integer value or 0x1000000 in case of error.
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",
94 * Implements "palette" fgis command.
95 * input - argv[1] subcommand, argv[2] parameter, if required.
101 * Returns (in interp result) - name of newly created palette
102 * Side effects: defines new Tcl command to handle this palette
104 EXPORT(int, Fgis_Palette)(ClientData data,Tcl_Interp *interp,int argc,char **argv)
107 Tcl_SetResult(interp,"Wrong # of args. Should be palette command ?arg?",
108 TCL_STATIC); return TCL_ERROR;
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
114 char buf[MAX_PALETTE_SIZE];/* place to hold readed file */
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);
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]))) {
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))
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;}
138 Tcl_Free((char *)listv);
139 } else if (!strcmp(argv[1],"copy")) {
141 if (Fgis_CkArgs(interp,argc!=3,argv[0]," copy palettename")) return TCL_ERROR;
142 oldpal=Fgis_GetPalette(interp,argv[2]);
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);
151 sprintf(buffer,"Wrong option %s. Should be one of read parse set blank copy",
153 Tcl_SetResult(interp,buffer,TCL_VOLATILE);
156 return Fgis_CreateObjectCommand(interp,"palette",Fgis_PaletteObj,
157 (ClientData)pal, Fgis_DeletePalette);
160 * Obtain PALETTE pointer from name of command.
161 * Returns NULL in case of error.
164 EXPORT(PALETTE, Fgis_GetPalette)(Tcl_Interp *interp, char *name)
166 Tcl_CmdInfo info;char buffer[255]="Invalid palette: ";
167 if (!Tcl_GetCommandInfo(interp,name,&info)) return NULL;
168 if (info.proc!=&Fgis_PaletteObj) {
170 Tcl_SetResult(interp,buffer,TCL_VOLATILE);
173 return (PALETTE)(info.clientData);
177 * implements palette object command;
178 * Arguments argv[1]- subcommand argv[i] - parameters
179 * Checks subcommand and calls appropriate function
182 EXPORT(int, Fgis_PaletteObj)(ClientData data,Tcl_Interp *interp,int argc,char **argv)
185 PALETTE clr=(PALETTE)data;
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?"))
194 if (!strcmp(argv[1],"print")) {
196 if (Fgis_CkArgs(interp,argc!=2,argv[0]," print"))
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);
207 if (!strcmp(argv[1],"get")) {
209 if (Fgis_CkArgs(interp,argc!=3,argv[0],
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);
216 Tcl_SetResult(interp,Xcolor_string(clr,index),TCL_VOLATILE);
221 if (!strcmp(argv[1],"set")) {
224 Tcl_AppendResult(interp,argv[0]," is read only",NULL);
227 if (Fgis_CkArgs(interp,argc!=4,argv[0],
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",
236 if ((RGB=ParseRGB(interp,argv[3]))>0xFFFFFF) return TCL_ERROR;
241 if (!strcmp(argv[1],"list")) {
243 if (Fgis_CkArgs(interp,argc!=2,argv[0]," list"))
246 { Tcl_AppendElement(interp,Xcolor_string(clr,i));
251 if (!strcmp(argv[1],"delete")) {
252 if (Fgis_CkArgs(interp,argc!=2,argv[0]," delete")) return TCL_ERROR;
254 Tcl_AppendResult(interp,buffer," is read only",NULL);
257 Tcl_DeleteCommand(interp,argv[0]);
261 { Tcl_SetResult(interp,"Wrong option. Should be one of print, get, set, "
262 " list, delete", TCL_STATIC);
268 EXPORT(void, Fgis_DeletePalette)(ClientData data)
270 if (data == default_palette) return;
271 Tcl_Free((char *)data);