home *** CD-ROM | disk | FTP | other *** search
- /* Wimp document window commands for tcl */
- /* (c) C.T.Stretch */
- /* Wed,20 Jul 1994 */
-
- #include "h.WInt"
- #include "h.colourtrans"
-
- typedef struct line
- { short l,r;
- char t[4];
- } line;
-
- typedef struct document
- { struct document *next;
- struct view *viewlist;
- line ***lines;
- char *name,*title,*close;
- tcl_menu *menu;
- int nl,mnl;
- int width,ht,ps,lmargin,rmargin,indent,just,proc,up,down,setp;
- os_colour fg,bg;
- font_f font;
- font_table ft;
- } document;
-
- Tcl_HashTable documentTable;
-
- static document *documentlist;
- static int overlap;
- static wimp_window tw=
- {
- {240,198,1106,800},
- 0, 0, (wimp_w)-1, 0x7f01000f,
- 0x7, 0x2, 0x7, 0xFF,
- 0x3, 0x1, 0xc, 0x0,
- {0,-784,1280,0},
- 0x13d, 0x3000, (osspriteop_area*)0x1, 64, 512,
- "",
- 0
- };
-
- /*
- * --
- *
- *
- *
- *
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- */
-
- bool document_redraw(void)
- { document *t;
- view *v;
- wimp_draw *d=(wimp_draw*)█
- for(t=documentlist;t;t=t->next) for(v=t->viewlist;v;v=v->next)
- if(v->w==block.redraw.w)
- { int more=wimp_redraw_window(d);
- int bx,by,tl,bl,i;
- bx=d->box.x0-d->xscroll;
- by=d->box.y1-d->yscroll;
- while(more)
- { colourtrans_set_gcol(t->bg,colourtrans_SET_BG,os_ACTION_OVERWRITE,0);
- os_writec(os_VDU_CLG);
- tl=(by-d->clip.y1+t->down)/t->ht;
- if(tl<0) tl=0;
- bl=1+(by-d->clip.y0+t->up)/t->ht;
- if(bl>t->nl) bl=t->nl;
- for(i=tl;i<bl;i++)
- { line *l=t->lines[i>>8][i&0xFF];
- colourtrans_set_font_colours(t->font,t->bg,t->fg,14,0,0,0);
- if(l->r)
- { os_plot(os_MOVE_TO,bx+l->r,by-i*t->ht);
- font_paint(t->font,l->t,font_OS_UNITS|font_JUSTIFY,
- bx+l->l,by-i*t->ht,0,0,0);
- }
- else
- font_paint(t->font,l->t,font_OS_UNITS,bx+l->l,by-i*t->ht,0,0,0);
- }
- more=wimp_get_rectangle(d);
- }
- return TRUE;
- }
- return FALSE;
- }
-
- tcl_menu *document_menu(void)
- { document *t;
- view *v;
- for(t=documentlist;t;t=t->next) for(v=t->viewlist;v;v=v->next)
- if(v->w==block.pointer.w)
- { substr['w'-'a']=t->name;
- return t->menu;
- }
- return FALSE;
- }
-
- static void dropview(view *v,document *t)
- { wimp_delete_window(v->w);
- unlink(&(t->viewlist),v);
- ckfree(v);
- }
-
- static void document_free(document *t)
- { int i;
- for(i=0;i<t->nl;i++) ckfree(t->lines[i>>8][i&0xFF]);
- for(i=0;i<(t->nl+255)>>8;i++) ckfree(t->lines[i]);
- ckfree(t->lines);
- ckfree(t->name);
- if(t->title!=progname) ckfree(t->title);
- ckfree(t->close);
- if(t->menu!=menu_NONE) menu_free(t->menu);
- release_fonts(&(t->ft));
- ckfree(t);
- substr['w'-'a']=0;
- }
-
- bool document_close(void)
- { document *d;
- view *v;
- Tcl_HashEntry *p;
- int n;
- for(d=documentlist;d;d=d->next) for(v=d->viewlist;v;v=v->next)
- if(v->w==block.close.w)
- { if(d->viewlist->next) { dropview(v,d);return TRUE;}
- else
- { if(d->close)
- { substr['w'-'a']=d->name;
- checkEval(d->close,"document close");
- n=getconstant(w_Interp->result);
- if(n==1) return TRUE;
- if(n!=0) {dropview(v,d);return TRUE;}
- }
- dropview(v,d);
- p=Tcl_FindHashEntry(&documentTable,d->name);
- if(!p)
- { msg("Odd close request",0,0);
- return TRUE;
- }
- Tcl_DeleteHashEntry(p);
- unlink(&documentlist,d);
- substr['w'-'a']=0;
- document_free(d);
- return TRUE;
- }
- }
- return FALSE;
- }
-
- static void setext(document *d,int m)
- { view *v;
- os_box b;
- b.x0=0;b.x1=d->width;b.y1=d->ht;b.y0=-d->ht*d->nl+d->ht/2;
- for(v=d->viewlist;v;v=v->next)
- { wimp_set_extent(v->w,&b);
- wimp_force_redraw(v->w,0,b.y0,d->width,d->up-d->ht*m);
- }
- v=d->viewlist;
- if(v)
- { wimp_open *wo=(wimp_open*)█
- block.open.w=v->w;
- wimp_get_window_state((wimp_window_state*)&block);
- wo->yscroll=b.y0+wo->visible.y1-wo->visible.y0;
- wimp_open_window(wo);
- }
- }
-
- static void setcolour(char *p,os_colour fg,os_colour bg)
- { p[0]=19;
- p[1]=bg>>8;p[2]=bg>>16;p[3]=bg>>24;
- p[4]=fg>>8;p[5]=fg>>16;p[6]=fg>>24;
- p[7]=14;
- }
-
- static line *addline(document *t,int n)
- { line *l;
- if((t->nl&0xFF)==0)
- { if((t->nl>>8)>=t->mnl)
- { line ***lt=ckalloc((256+t->mnl)*sizeof(line**));
- memcpy(lt,t->lines,t->mnl*sizeof(line**));
- free(t->lines);
- t->lines=lt;
- t->mnl+=256;
- }
- t->lines[t->nl>>8]=ckalloc(256*sizeof(line*));
- }
- l=ckalloc(sizeof(line)+n-3);
- t->lines[t->nl>>8][t->nl&0xFF]=l;
- t->nl++;
- return l;
- }
-
- static int linelen(document *t,char **args,int nargs)
- { int n=nargs-1,i;
- char *q;
- for(i=0;i<nargs;i++) n+=strlen(args[i]);
- if(t->proc)
- { for(i=0;i<nargs;i++)
- { char *p;
- for(p=args[i];*p;p++) if(*p=='|')
- { q=p+1;p=strchr(q,'|');
- if(!p) return -1;
- n-=p-q+2;
- switch(*q)
- { case '|':n++;break;
- case 'f':case 'F':n+=2;break;
- case 'c':n+=8;break;
- default:return -1;
- }
- }
- }
- }
- if(n<0) return 0;
- return n;
- }
-
-
- static void getline(char *out,document *t,char **args,int nargs)
- { int i;
- char *q;
- if(!nargs) {*out=0;return;}
- if(t->proc)
- { for(i=0;i<nargs;i++)
- { char *p;
- os_colour c;
- for(p=args[i];*p;p++) if(*p=='|')
- { q=p+1;p=strchr(q,'|');
- switch(*q)
- { case '|':*out++='|';break;
- case 'f':
- case 'F':*out++=26;
- *p=0;
- *out++=find_font(q,t->ps,&(t->ft));
- *p='|';
- break;
- case 'c':*p=0;
- c=getcolour(q+1);
- *p='|';
- setcolour(out,c,t->bg);out+=8;
- break;
- }
- }
- else
- { if(*p<' '||*p=='\b') *p=' ';
- *out++=*p;
- }
- *out++=' ';
- }
- out[-1]=0;
- }
- else
- { q=out;
- out+=sprintf(out,"%s",args[0]);
- for(i=1;i<nargs;i++) out+=sprintf(out," %s",args[i]);
- for(;*q;q++) if(*q<' '||*q=='\b') *q=' ';
- }
- }
-
- static char *splitline(document *t,char *p,int left,int width)
- { line *l;
- char *sp,*q;
- int n=0;
- font_scan_block fsb[1];
- static os_colour col;
- static font_f fnt;
- bool nospace=FALSE;
- if(!p) { col=t->fg;fnt=t->font;return 0;};
- fsb->space.x=0;fsb->space.y=0;fsb->letter.x=0;fsb->letter.y=0;
- fsb->split_char=' ';
- sp=0;
- fsb->bbox.x0=0;fsb->bbox.y0=0;fsb->bbox.x1=0;fsb->bbox.y1=0;
- font_scan_string(fnt,p,font_GIVEN_BLOCK|font_RETURN_BBOX|font_GIVEN_FONT,
- width*font_OS_UNIT,INT_MAX,fsb,0,0,&sp,0,0,0);
- if(p==sp&&*p)
- { nospace=TRUE;
- font_scan_string(fnt,p,font_RETURN_CARET_POS|font_GIVEN_FONT,
- width*font_OS_UNIT,INT_MAX,0,0,0,&sp,0,0,0);
- if(p==sp) { msg("Nothing fits",0,0);sp=p+strlen(p);}
- }
- if(col!=t->fg) n+=8;
- if(fnt!=t->font) n+=2;
- l=addline(t,sp-p+n);
- q=l->t;
- l->l=left;l->r=0;
- if(fnt!=t->font) { *q++=26;*q++=fnt;}
- if(col!=t->fg) { setcolour(q,col,t->bg);q+=8;}
- memcpy(q,p,sp-p);q[sp-p]=0;
- while(*sp==' ') sp++;
- if(*sp&&t->just) l->r=t->rmargin;
- if(nospace)
- { fsb->space.x=0;fsb->space.y=0;fsb->letter.x=0;fsb->letter.y=0;
- fsb->split_char=-1;
- font_scan_string(fnt,l->t,font_RETURN_BBOX|font_GIVEN_BLOCK|font_GIVEN_FONT,
- INT_MAX,INT_MAX,fsb,0,0,0,0,0,0);
- }
- mp_to_os(&(fsb->bbox));
- if(fsb->bbox.y0<t->down) t->down=fsb->bbox.y0;
- if(fsb->bbox.y1>t->up) t->up=fsb->bbox.y1;
- for(p=l->t;*p;p++) switch(*p)
- { case 26:fnt=*++p;break;
- case 19:col=(p[6]<<24)+(p[5]<<16)+(p[4]<<8);
- p+=7;
- break;
- }
- return sp;
- }
-
- int w_TextCmd(ClientData dummy,Tcl_Interp *interp,int argc,char **argv)
- { document *t;
- Tcl_HashEntry *p;
- if(argc<3) return wrong(WNA,"w_text <name> <command> ...");
- /* *********** create a document *************** */
- if(!strcmp(argv[2],"create"))
- { int new=0,m;
- p=Tcl_CreateHashEntry(&documentTable,argv[1],&new);
- if(!new) return wrong("Text already exists: ",argv[1]);
- t=ckcalloc(sizeof(document));
- t->name=scopy(argv[1]);
- t->title=progname;
- t->fg=os_COLOUR_BLACK;
- t->bg=os_COLOUR_WHITE;
- t->menu=menu_NONE;
- for(m=3;m<argc-1;m++)
- { if(!strcmp(argv[m],"-width"))
- { t->width=getsize(argv[++m],os_INCH);
- continue;
- }
- if(!strcmp(argv[m],"-height"))
- { t->ht=getsize(argv[++m],os_INCH);
- continue;
- }
- if(!strcmp(argv[m],"-size"))
- { t->ps=getsize(argv[++m],16*72);
- continue;
- }
- if(!strcmp(argv[m],"-bg"))
- { t->bg=getcolour(argv[++m]);
- continue;
- }
- if(!strcmp(argv[m],"-fg"))
- { t->fg=getcolour(argv[++m]);
- continue;
- }
- if(!strcmp(argv[m],"-menu"))
- { t->menu=menu_make(argv[++m],t->name);
- if(t->menu==0)
- { t->menu=menu_NONE;
- return TCL_ERROR;
- }
- continue;
- }
- if(!strcmp(argv[m],"-title")) { t->title=scopy(argv[++m]);continue;}
- if(!strcmp(argv[m],"-close")) { t->close=scopy(argv[++m]);continue;}
- }
- if(t->width<=0) t->width=800;
- if(t->ps<=0) t->ps=20*16;
- if(t->ht<=0) t->ht=t->ps/6;
- t->rmargin=t->width;
- t->font=find_font("fn",t->ps,&(t->ft));
- if(!t->font) return wrong("Can't open any font",0);
- t->next=documentlist;
- documentlist=t;
- Tcl_SetHashValue(p,t);
- return TCL_OK;
- }
- p=Tcl_FindHashEntry(&documentTable,argv[1]);
- if(!p) return wrong("No such document: ",argv[1]);
- t=(document*)Tcl_GetHashValue(p);
- /* *********** open a window *************** */
- if(!strcmp(argv[2],"open"))
- { view *v=ckalloc(sizeof(view));
- int x,y;
- screensize(&x,&y);
- if(overlap>y/2-INSET) overlap=0;
- tw.title_data.indirected_text.text=t->title;
- tw.title_data.indirected_text.validation=(char*)-1;
- tw.title_data.indirected_text.size=strlen(t->title);
- tw.extent.x1=t->width;
- tw.extent.y1=t->ht;
- tw.extent.y0=-(t->nl)*t->ht+t->ht/2;
- tw.visible.y1=y-INSET-overlap;
- tw.visible.y0=tw.visible.y1-(tw.extent.y1-tw.extent.y0);
- if(tw.visible.y0<INSET) tw.visible.y0=INSET;
- tw.yscroll=tw.extent.y1;
- tw.visible.x0=INSET+overlap/2;
- tw.visible.x1=tw.visible.x0+t->width;
- if(tw.visible.x1>x-INSET) tw.visible.x1=x-INSET;
- v->w=wimp_create_window(&tw);
- v->next=t->viewlist;
- t->viewlist=v;
- block.open.w=v->w;
- wimp_get_window_state((wimp_window_state*)&block);
- wimp_open_window((wimp_open*)&block);
- overlap+=40;
- return TCL_OK;
- }
- /* *********** set options *************** */
- if(!strcmp(argv[2],"options"))
- { int i;
- for(i=3;i<argc;i++)
- { if(argv[i][0]=='-') switch(argv[i][1])
- { case 'l':t->lmargin=getsize(argv[i]+2,os_INCH);continue;
- case 'r':t->rmargin=t->width-getsize(argv[i]+2,os_INCH);continue;
- case 'i':t->indent=getsize(argv[i]+2,os_INCH);continue;
- case 'j':t->just=(getconstant(argv[i]+2)==1);continue;
- case 'p':t->proc=(getconstant(argv[i]+2)==1);continue;
- case 'L':t->setp=0;continue;
- case 'C':t->setp=1;continue;
- case 'R':t->setp=2;continue;
- }
- return wrong("Bad document option: ",argv[i]);
- }
- if((t->indent>=t->rmargin)||(t->lmargin>=t->rmargin))
- { t->indent=0;t->lmargin=0;t->rmargin=t->width;
- }
- return TCL_OK;
- }
- /* *********** print a line *************** */
- if(!strcmp(argv[2],"print"))
- { int n=linelen(t,argv+3,argc-3);
- int m=t->nl;
- font_scan_block fsb[1];
- line *l;
- if(n<0) return wrong("bad '|' sequence",0);
- l=addline(t,n);l->r=0;
- getline(l->t,t,argv+3,argc-3);
- fsb->space.x=0;fsb->space.y=0;fsb->letter.x=0;fsb->letter.y=0;
- fsb->split_char=-1;
- font_scan_string(t->font,l->t,
- font_RETURN_BBOX|font_GIVEN_BLOCK|font_GIVEN_FONT,
- INT_MAX,INT_MAX,fsb,0,0,0,0,0,0);
- mp_to_os(&(fsb->bbox));
- if(fsb->bbox.y0<t->down) t->down=fsb->bbox.y0;
- if(fsb->bbox.y1>t->up) t->up=fsb->bbox.y1;
- l->l=t->lmargin+
- t->setp*((t->rmargin-t->lmargin)-(fsb->bbox.x1-fsb->bbox.x0))/2;
- setext(t,m);
- return TCL_OK;
- }
- /* *********** write a paragraph *************** */
- if(!strcmp(argv[2],"write"))
- { int n;
- int m=t->nl;
- char *p,*q;
- n=linelen(t,argv+3,argc-3);
- if(n<0) return wrong("bad '|' sequence",0);
- p=ckalloc(n+1);
- getline(p,t,argv+3,argc-3);
- splitline(t,0,0,0);
- q=splitline(t,p,t->indent,t->rmargin-t->indent);
- for(;*q;) q=splitline(t,q,t->lmargin,t->rmargin-t->lmargin);
- ckfree(p);
- setext(t,m);
- return TCL_OK;
- }
- /* *********** unknown command *************** */
- return wrong("unknown w_text command: ",argv[2]);
- }
-
-