dll/fgisPatterns.c

   1 #include <tcl.h>
   2 #include <string.h>
   3 #include <stdlib.h>
   4 #include <ctype.h>
   5 #include "fgis.h"
   6 struct { struct PATTERNS* next;
   7          char *name;
   8          int width;
   9          int height;
  10          int bits[1];
  11        } empty_patterns={NULL,"empty",0,0,{0}};
  12
  13 /* WARNING - this is internal function from tkImgBmap.c which is
  14    used here. It might not be exported from tk80.dll on Windows
  15    and might changed in future releases. It is prototyped in
  16    tkInt.h, but I prefer declare it explicitely in order to put this
  17    warning comment here */
  18 char * TkGetBitmapData(Tcl_Interp *interp, char *string,
  19         char *filename, int *widthPtr, int *heightPtr,
  20           int *hotXPtr, int *hotYPtr);
  21
  22 PATTERNS def_patterns=(PATTERNS)&empty_patterns;
  23 PATTERNS first_patterns=(PATTERNS)&empty_patterns;
  24
  25 /* Forward declarations of functions from this file*/
  26 PATTERNS Fgis_ParsePatterns(Tcl_Interp *interp,char *patterns);
  27 PATTERNS new_patterns(int width,int height,char *name);
  28 void print_patterns(Tcl_Interp *interp,PATTERNS ptn) ;
  29 void make_xbm(Tcl_Interp *interp,int index,PATTERNS data,int width,
  30            int height, int frame);
  31 int parse_xbm(Tcl_Interp *interp,int index,char *data,PATTERNS ptn);
  32
  33
  34
  35 EXPORT(PATTERNS, Fgis_GetPatterns)(Tcl_Interp *interp,char *name)
  36 {
  37   if (name==NULL||name[0]=='\0') {
  38       return def_patterns;
  39   } else {
  40     Tcl_CmdInfo info;char buffer[255]="Invalid pattern set name: ";
  41     if (!Tcl_GetCommandInfo(interp,name,&info)) return NULL;
  42     if (info.proc!=&Fgis_PatternObj) {
  43        strcat(buffer,name);
  44        Tcl_SetResult(interp,buffer,TCL_VOLATILE);
  45        return NULL;
  46     }
  47     return (PATTERNS)(info.clientData);
  48   }
  49 }
  50 /*
  51  * Implementation of ``patterns'' command
  52  *
  53  */
  54 EXPORT(int, Fgis_CreatePatterns)(ClientData clientData, Tcl_Interp *interp, int argc,
  55        char **argv)
  56 {    PATTERNS ptn;
  57      if (Fgis_CkArgs(interp,argc<2,argv[0],"command ?arg?")) {
  58         return TCL_ERROR;
  59      }
  60     if (!strcmp(argv[1],"read")) {
  61        FILE *f;
  62        int size;
  63        char *s;
  64        if (Fgis_CkArgs(interp,argc!=3,argv[0],"read filename")) {
  65           return TCL_ERROR;
  66        }
  67        if (!(f=fopen(argv[2],"rb"))) {
  68            Tcl_AppendResult(interp,"Cannot open ",argv[2],": ",
  69                   Tcl_PosixError(interp),NULL);
  70            return TCL_ERROR;
  71        }
  72        fseek(f,0,SEEK_END);
  73        size=ftell(f);
  74        fseek(f,0,SEEK_SET);
  75        s=Tcl_Alloc(size+1);
  76        fread(s,1,size,f);
  77        fclose(f);
  78        *(s+size)=0;
  79        if (!(ptn=Fgis_ParsePatterns(interp,s))) {
  80           Tcl_Free(s);
  81           return TCL_ERROR;
  82        }
  83        Tcl_Free(s);
  84     } else if (!strcmp(argv[1],"set")) {
  85        if (Fgis_CkArgs(interp,argc!=3,argv[0],"read string")) {
  86           return TCL_ERROR;
  87        }
  88        if (!(ptn=Fgis_ParsePatterns(interp,argv[2])))
  89           return TCL_ERROR;
  90     } else if (!strcmp(argv[1],"blank")) {
  91        int sizex,sizey;
  92        if (Fgis_CkArgs(interp,argc<3||argc>4,argv[0],"blank sizex ?sizey?")) {
  93           return TCL_ERROR;
  94        }
  95        if (Tcl_GetInt(interp,argv[2],&sizex)!=TCL_OK) {
  96           return TCL_ERROR;
  97        }
  98        if (argc==4) {
  99           if (Tcl_GetInt(interp,argv[3],&sizey)!=TCL_OK) {
 100               return TCL_ERROR;
 101           }
 102        } else {
 103           sizey=sizex;
 104        }
 105        if (sizex<0||sizex>32||sizey<0||sizey>32) {
 106           Tcl_SetResult(interp,"pattern size should be in range 0 - 32",
 107                 TCL_STATIC);
 108           return TCL_ERROR;
 109        }
 110        ptn=new_patterns(sizex,sizey,NULL);
 111     } else if (!strcmp(argv[1],"copy")) {
 112        PATTERNS old;
 113        int size;
 114        if (!(old=Fgis_GetPatterns(interp,argv[2]))) {
 115           return TCL_ERROR;
 116        }
 117        ptn=new_patterns(old->width,old->height,old->name);
 118        memmove(ptn,old,size);
 119     } else {
 120         Tcl_AppendResult(interp,"Wrong option. Should be one of ",
 121            " set, read, copy, blank",NULL);
 122         return TCL_ERROR;
 123     }
 124     return Fgis_CreateObjectCommand(interp,"pattern",Fgis_PatternObj,
 125          (ClientData)ptn,Fgis_DeletePatterns);
 126
 127 }
 128
 129 /*
 130  * Deletes pattern
 131  *
 132  */
 133 EXPORT(void, Fgis_DeletePatterns)(ClientData data) {
 134   PATTERNS ptn=(PATTERNS) data;
 135   if (ptn->name) Tcl_Free(ptn->name);
 136   Tcl_Free((char *)ptn);
 137 }
 138 /*
 139  * Implementation of pattern object command.
 140  *
 141  */
 142 EXPORT(int, Fgis_PatternObj)(ClientData data,Tcl_Interp *interp, int argc, char **argv)
 143 { if (Fgis_CkArgs(interp,argc<=1,argv[0],"option ?arg?")) {
 144     return TCL_ERROR;
 145   }
 146   if (!strcmp(argv[1],"print")) {
 147      if (Fgis_CkArgs(interp,argc!=2,argv[0],"print"))
 148          return TCL_ERROR;
 149      print_patterns(interp,(PATTERNS)data);
 150   } else if (!strcmp(argv[1],"set")) {
 151       int index;
 152       if (Fgis_CkArgs(interp,argc!=4,argv[0],"set index dataString")) {
 153          return TCL_ERROR;
 154       }
 155       if (Tcl_GetInt(interp,argv[2],&index)!=TCL_OK) {
 156          return TCL_ERROR;
 157       }
 158       if (index<0||index>255) {
 159          Tcl_SetResult(interp,"pattern index should be in 0..255 range",
 160              TCL_STATIC);
 161          return TCL_ERROR;
 162       }
 163       if (!parse_xbm(interp,index,argv[3],(PATTERNS)data)) {
 164         return TCL_ERROR;
 165       }
 166    } else if (!strcmp(argv[1],"get")) {
 167       int i,index,width,height,frame=0;
 168       if (Fgis_CkArgs(interp,argc<3,argv[0],"index ?-width n?  ?-height n? ?-frame bool?")) {
 169          return TCL_ERROR;
 170       }
 171       if (Tcl_GetInt(interp,argv[2],&index)!=TCL_OK) {
 172          return TCL_ERROR;
 173       }
 174       if (index<0||index>255) {
 175          Tcl_SetResult(interp,"pattern index should be in 0..255 range",
 176              TCL_STATIC);
 177          return TCL_ERROR;
 178       }
 179       i=3;
 180       width=((PATTERNS)data)->width;
 181       height=((PATTERNS)data)->height;
 182       while (i<argc-1) {
 183          if (!strcmp(argv[i],"-width")) {
 184            if (Tcl_GetInt(interp,argv[i+1],&width)!=TCL_OK) return TCL_ERROR;
 185          } else if (!strcmp(argv[i],"-height")) {
 186            if (Tcl_GetInt(interp,argv[i+1],&height)!=TCL_OK) return TCL_ERROR;
 187          } else if (!strcmp(argv[i],"-frame")) {
 188            if (Tcl_GetBoolean(interp,argv[i+1],&height)!=TCL_OK) return TCL_ERROR;
 189          } else {
 190             Tcl_SetResult(interp,"invalid option. Should be one of -width -height -frame",TCL_STATIC);
 191             return TCL_ERROR;
 192          }
 193          i+=2;
 194      }
 195      if (i!=argc) {
 196         Tcl_SetResult(interp,"option without argument",TCL_STATIC);
 197         return TCL_ERROR;
 198      }
 199          make_xbm(interp,index,(PATTERNS)data,width,height,frame);
 200   } else if (!strcmp(argv[1],"name")) {
 201      PATTERNS p = (PATTERNS) data;
 202      if (Fgis_CkArgs(interp,argc>3,argv[0],"name ?new name?")) {
 203         return TCL_ERROR;
 204      }
 205      if (argc==3) {
 206         int len;
 207         if (p->name) Tcl_Free(p->name);
 208         len = strlen(argv[2]);
 209         p->name=Tcl_Alloc(len>80?81:len+1);
 210         strncpy(p->name,argv[2],80);
 211         if (len>80) p->name[80]=0;
 212      }
 213      Tcl_SetResult(interp,p->name,TCL_VOLATILE);
 214   } else if (!strcmp(argv[1],"delete")) {
 215      if (Fgis_CkArgs(interp,argc!=2,argv[0],"delete")) return TCL_ERROR;
 216      Tcl_DeleteCommand(interp,argv[0]);
 217   } else {
 218       Tcl_SetResult(interp,"invalid option. Should be one of name, print, get, set, delete",TCL_STATIC);
 219       return TCL_ERROR;
 220   }
 221   return TCL_OK;
 222 }
 223 /*
 224  * Parses string, which looks like content of EPPL symbol file and
 225  * returns PATTERNS structure (or NULL, if there was parsing error)
 226  *
 227  */
 228 PATTERNS Fgis_ParsePatterns(Tcl_Interp *interp, char *str) {
 229    PATTERNS ptn;
 230    char namebuf[256]="";
 231    char hex[9] = {0,0,0,0,0,0,0,0,0};
 232    char *next_line,*p;
 233    char *name;
 234    int block_size,index, old_index;
 235    unsigned int *bitptr;
 236    int width,height;
 237
 238    Tcl_SetResult(interp,"Invalid pattern file",TCL_STATIC);
 239    if (sscanf(str,"%d %d%[^\n]",&width,&height,namebuf)<=2) {
 240       return NULL;
 241    }
 242    if (width<-32||width>-1||height<-32||height>-1) {
 243       return NULL;
 244    }
 245    width=-width;
 246    height=-height;
 247    name=namebuf+strlen(namebuf)-1;
 248    while (name>=namebuf&&isspace(*name)) name--;
 249    *(++name)=0;
 250    next_line =strchr(str,'\n');
 251    if (!next_line) return NULL;
 252    name=namebuf;
 253    while(*name&&isspace(*name))name++;
 254
 255    ptn=new_patterns(width,height,name);
 256    block_size=width<=16?4:8;
 257    while (*next_line&&*(++next_line)) {
 258        while(*next_line&&isspace(*next_line)) next_line++;
 259        if (!*next_line) break;
 260        p=next_line;
 261        index=strtol(next_line,&p,10);
 262        if (!isspace(*p)) {
 263           Fgis_DeletePatterns((ClientData)ptn);
 264           return NULL;
 265        }
 266        p++;
 267        if (index != old_index) {
 268           bitptr=ptn->bits+index*height;
 269           old_index = index;
 270        }
 271        while (*p&&*p!='\n' && *p!='\r') {
 272          strncpy(hex,p,block_size);
 273          p+=block_size;
 274          *(bitptr++)=strtol(hex,NULL,16);
 275        }
 276        next_line=p;
 277    }
 278    Tcl_ResetResult(interp);
 279    return ptn;
 280 }
 281
 282 PATTERNS new_patterns(int width,int height,char *name) {
 283  PATTERNS p=(PATTERNS)Tcl_Alloc(patternSize(width,height));
 284  char *name_ptr=NULL;
 285
 286  if (name && *name) {
 287       name_ptr=Tcl_Alloc(strlen(name)+1);
 288       strcpy(name_ptr,name);
 289  }
 290  p->width=width;
 291  p->height=height;
 292  p->next=NULL;
 293  p->name=name_ptr;
 294  memset(&p->bits,0,sizeof(int)*height*256);
 295  return p;
 296 }
 297 /*
 298    Puts in interp->result printable representation of pattern set
 299    ptn in EPPL symbol file format
 300  */
 301 void print_patterns(Tcl_Interp *interp,PATTERNS ptn)
 302 { int i,j,l;char *name="";
 303   unsigned int *a,*b;
 304   char buffer[256],num[9];
 305   char *fmt=ptn->width>16?"%08X":"%04X";
 306   int d=ptn->width>16?8:4;
 307   if (ptn->name) name=ptn->name;
 308   sprintf(buffer,"%3d %3d %s\n",-ptn->width,-ptn->height,name);
 309   Tcl_AppendResult(interp,buffer,NULL);
 310   for (i=0,a=ptn->bits;i<=255;i++,a+=ptn->height) {
 311     /* Check if pattern is empty */
 312     unsigned int sum=0;
 313     for (j=0,b=a;j<ptn->height;j++,b++) sum|=*b;
 314     if (!sum) continue;
 315     /* print pattern */
 316     sprintf(buffer,"%3d ",i);
 317     for (j=0,l=0,b=a;j<ptn->height;j++,b++) {
 318       sprintf(num,fmt,*b);
 319       strcat(buffer,num);
 320       l+=d;
 321       if (l>=64) {
 322         l=0;
 323         Tcl_AppendResult(interp,buffer,"\n",NULL);
 324         buffer[4]=0;
 325       }
 326     }
 327     if (l) Tcl_AppendResult(interp,buffer,"\n",NULL);
 328   }
 329 }
 330 /*
 331   Parses xbm file given by data argiment and replaces by it pattern N
 332   index in pattern set ptn
 333   returns 0 and leaves error message in interp if something goes wrong.
 334 */
 335 int parse_xbm(Tcl_Interp *interp,int index,char *data,PATTERNS ptn) {
 336 char *bitmap,*b;
 337 int width,height,hotX,hotY;
 338 int mask,  i,j, bm;
 339 unsigned int *p;
 340    bitmap = TkGetBitmapData(interp, data, NULL, &width, &height,
 341    &hotX, &hotY);
 342    if (!bitmap) return 0;
 343    if (width!=ptn->width || height!=ptn->height) {
 344        ckfree(bitmap);
 345        Tcl_SetResult(interp,"bitmap size doesn't match pattern size",
 346            TCL_STATIC);
 347        return 0;
 348    }
 349    b=bitmap;
 350    /*Now copy bitmap data into patterns structure*/
 351    for (i=0,p=ptn->bits+index*ptn->height;i<ptn->height;i++,p++) {
 352       *p=0;
 353       for(j=0,mask=1<<(ptn->width-1), bm=1;j<ptn->width;j++,mask>>=1) {
 354          if (*b&bm) *p|=mask;
 355          bm<<=1;
 356          if (bm>0x80) {
 357            b++; bm=1;
 358          }
 359       }
 360       if (bm!=1) b++;
 361    }
 362    ckfree(bitmap);
 363    return 1;
 364 }
 365 void make_xbm(Tcl_Interp *interp, int index,PATTERNS data,int width,
 366       int height, int frame)
 367 { char buffer[256];
 368   int i,j,row,bit;
 369   unsigned int mask, *bitp, current;
 370   int value;
 371   sprintf(buffer,"#define pattern_width %d\n#define pattern_height %d\n"
 372    "static char pattern_bits[] = {\n",width,height);
 373   Tcl_AppendResult(interp,buffer,NULL);
 374   for (i=0,row=33;i<height;i++,row++,bitp++) {
 375     if (row>=data->height) {
 376         row=0;
 377         bitp=data->bits+(index*(data->height));
 378     }
 379     current=*bitp;
 380     value=0;
 381     for (j=0,mask=0,bit=1;j<width;j++,mask>>=1) {
 382        if (!mask) {
 383           mask=1<<(data->width-1);
 384        }
 385        if (current & mask) value|=bit;
 386
 387        if ((bit<<=1)==0x100) {
 388           sprintf(buffer," 0x%02x,",value);
 389           Tcl_AppendResult(interp,buffer,NULL);
 390           bit=1;
 391           value=0;
 392        }
 393     }
 394     if (bit==1) {
 395       Tcl_AppendResult(interp,"\n",NULL);
 396     } else {
 397       sprintf(buffer,"0x%02x,\n",value);
 398       Tcl_AppendResult(interp,buffer,NULL);
 399     }
 400   }
 401   Tcl_AppendResult(interp,"};\n",NULL);
 402 }