home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 3 / TheARMClub_PDCD3.iso / hensa / programming / tcl / tclsrc / c / WimpBox < prev    next >
Encoding:
Text File  |  1996-03-10  |  29.7 KB  |  1,054 lines
  1. /* Dialog box commands for tcl */
  2. /* (c) C.T.Stretch */
  3. /* Mon,08 Aug 1994 */
  4.  
  5. #include "tclInt.h"
  6. #undef UCHAR
  7. #include "h.wimp"
  8. #include "h.WInt"
  9. #include "h.RISCOSint"
  10. #include "h.dragasprite"
  11.  
  12. enum ictypes { IHLIST,IVLIST,IBOX,ISPRITE,ISAVE,IACTION,IDEFAULT,
  13.                IINFO,IDISPLAY,IWATCH,IOPTION,IRADIO,IWRITE,ILAST};
  14. /*Note ictypes>ISAVE are equalised*/
  15. /*Note ictypes>IDEFAULT have 4? parameters*/
  16.  
  17. typedef struct icdata
  18. { char *t;           /*Name*/
  19.   int w,h,n;         /*Width, height, no. of icons*/
  20. } icdata;
  21.  
  22. icdata icd[ILAST]=
  23. { {"hlist",  0  ,0  ,0},
  24.   {"vlist",  0  ,0  ,0},
  25.   {"box",    0  ,0  ,2},
  26.   {"sprite", 100,100,1},
  27.   {"save",   192,176,2},
  28.   {"action", 28 ,60 ,1},
  29.   {"default",44 ,76 ,1},
  30.   {"info",   80 ,60 ,2},
  31.   {"display",80 ,60 ,2},
  32.   {"watch"  ,80 ,60 ,2},
  33.   {"option", 60 ,52 ,1},
  34.   {"radio",  60 ,52 ,1},
  35.   {"write",  80 ,68 ,2}
  36. };
  37.  
  38. #define GAP 8
  39. #define HALFGAP (GAP/2)
  40. #define CHWIDTH 16
  41.  
  42. enum actions { ANONE,AACTION,ADISPLAY,AWATCH,
  43.                AOPTION,ARADIO1,ARADIO2,AWRITE,ADRAG};
  44.  
  45. static wimp_window progInfo=
  46. { {0,0,0,0},
  47.   0, 0, (wimp_w)-1, 0x84000012,
  48.   0x7, 0x2, 0x7, 0x1,
  49.   0xc, 0xe, 0xc, 0x0,
  50.   {0,0,0,0},
  51.   0x13d, 0x0, (osspriteop_area*)0x1, 0, 0,
  52.   "",
  53.   0
  54. };
  55.  
  56. #define TRACEFLAGS TCL_TRACE_WRITES|TCL_GLOBAL_ONLY
  57. #define BSIZE(n) ((int)sizeof(boxnode)+(n-1)*(int)sizeof(boxnode*))
  58. #define WSIZE(n) ((int)sizeof(wimp_window)+(n-1)*(int)sizeof(wimp_icon))
  59.  
  60. typedef struct boxnode /* A node of the tree used to parse dbox descriptions */
  61. { int type;                          /* object type from enum ictypes */
  62.   int w,h;                           /* width and height in os units */
  63.   int n1,n2,n3,n4;                   /* integers describing object */
  64.   char *s1,*s2,*s3;                  /* strings describing object */
  65.   struct boxnode *blist[UNKNOWN];    /* subobjects */
  66. } boxnode;
  67.  
  68. typedef struct dbox    /* A permanent object describing a dbox */
  69. { wimp_window *ww;                   /* window template  */
  70.   int *t;                            /* list of action types */
  71.   char **s;                          /* list of script strings */
  72.   char *d;                           /* script for default icon */
  73.   char *e;                           /* script for Cancel icon */
  74.   bool tagged;                       /* TRUE for tagged dbox*/
  75.   int c;                             /* icon to place caret (-1 for none)*/
  76. } dbox;
  77.  
  78. typedef struct openbox   /* A list of these describes the open dboxes */
  79. { struct openbox *next;  /* linkedlist pointer */
  80.   wimp_w w;              /* window handle */
  81.   char *tag;             /* dbox tag */
  82.   dbox *db;              /* the dbox that this is an instance of */
  83. } openbox;
  84.  
  85. typedef struct watchdata
  86. { struct watchdata *next;
  87.   openbox *ob;
  88.   int  ic;
  89. } watchdata;
  90.  
  91.  
  92. Tcl_HashTable boxTable;
  93. static openbox *openboxlist;
  94. static watchdata *watchdatalist;
  95.  
  96. /* variables that hold information about an icon drag */
  97. static char *dragleaf,*dragscript;
  98. static int dragtype;
  99. static openbox *dragopenbox;
  100.  
  101. /* vertical position to open a permanent dbox. */
  102. static int offset=600;
  103.  
  104. /*The remaining variables are used temporarily during dbox creation */
  105. static int nicons,inum;
  106. static int *dbt;
  107. static char **dbs;
  108. static char *dd,*ee;
  109. static char *esg[16];
  110. static int esg_first;
  111. static wimp_icon *nexticon;
  112. static int careticon;
  113.  
  114. #define USFLAGS osspriteop_USER_AREA|osspriteop_NAME
  115. #define SSFLAGS osspriteop_NAME
  116.  
  117. static char *update(ClientData,Tcl_Interp*,char*,char*,int);
  118.  
  119. /*static void ckpfree(void *p) { fprintf(stderr,"free p=%p\n",p);ckfree(p);}*/
  120.  
  121. /*
  122.  *   box_find  --
  123.  *      Looks up the name of a dbox in the hash table.
  124.  *      Returns 0 if not found or a pointer to the structure.
  125.  *      Result is void* so the dbox structures need not be defined
  126.  *      outside this file.
  127.  *
  128.  * Results:
  129.  *      Returns a pointer to a dbox or 0.
  130.  *
  131.  * Side effects:
  132.  *      None.
  133.  *
  134.  */
  135.  
  136. extern void *box_find(char *name)
  137. { Tcl_HashEntry *p;
  138.   p=Tcl_FindHashEntry(&boxTable,name);
  139.   if(!p) return 0;
  140.   return Tcl_GetHashValue(p);
  141. }
  142.  
  143. static void freebox(openbox *ob)
  144. { dbox *db=ob->db;
  145.   int ni=db->ww->icon_count;
  146.   int i;
  147.   wimp_window *ww=db->ww;
  148.   for(i=0;i<ni;i++) switch(db->t[i])
  149.   { case AWATCH:{ watchdata *wd;
  150.                   for(wd=watchdatalist;wd;wd=wd->next) if(wd->ob==ob&&wd->ic==i)
  151.                   { Tcl_UntraceVar2(w_Interp,db->s[i],ob->tag,TRACEFLAGS,
  152.                      update,(ClientData)wd);
  153.                     unlink(&watchdatalist,wd);
  154.                     ckfree(wd);
  155.                     break; /* from for loop */
  156.                   }
  157.                 }
  158.     /*Deliberate fall through*/
  159.     case ADISPLAY:case AWRITE:
  160.                   ckfree(ww->icons[i].data.indirected_text.text);
  161.   }
  162.   wimp_delete_window(ob->w);
  163.   unlink(&openboxlist,ob);
  164.   ckfree(ob->tag);
  165.   ckfree(ob);
  166.   substr['d'-'a']=0;
  167. }
  168.  
  169. /*
  170.  *   box_close --
  171.  *      Called after a close event is returned from wimp_poll.
  172.  *      If the window is a dialog box it is deleted and the openbox
  173.  *      structure is removed from the list.
  174.  
  175.  * Results:
  176.  *      Returns true if the window was a dialog box.
  177.  *
  178.  * Side effects:
  179.  *      None.
  180.  *
  181. */
  182.  
  183. bool box_close(void)
  184. { openbox *ob;
  185.   for(ob=openboxlist;ob;ob=ob->next)
  186.   if(ob->w==block.close.w)
  187.   { freebox(ob);
  188.     return TRUE;
  189.   }
  190.   return FALSE;
  191. }
  192.  
  193. /*
  194.  *   closebox  --
  195.  *      Deletes a dialog box after a user selection.
  196.  *      Removes it from the openbox list.
  197.  *      Disposes of any open menu.
  198.  *
  199.  * Results:
  200.  *      None.
  201.  *
  202.  * Side effects:
  203.  *      None.
  204.  *
  205. */
  206.  
  207. static void closebox(openbox *ob)
  208. { wimp_create_menu((wimp_menu*)-1,0,0);
  209.   freebox(ob);
  210. }
  211.  
  212. /*
  213.  *   getvars  --
  214.  *      Scans the objects of an open dialog box and sets the corresponding
  215.  *      Tcl variables.
  216.  *
  217.  * Results:
  218.  *      None.
  219.  *
  220.  * Side effects:
  221.  *      None.
  222.  *
  223. */
  224.  
  225. static void getvars(openbox *ob)
  226. { int i,j;
  227.   dbox *db=ob->db;
  228.   int ni=db->ww->icon_count;
  229.   wimp_window *ww=db->ww;
  230.   substr['d'-'a']=ob->tag;
  231.   for(i=0;i<ni;i++) switch(db->t[i])
  232.   { case AOPTION:{ wimp_icon_state *wis=(wimp_icon_state*)█
  233.                    bool b;
  234.                    wis->w=ob->w;
  235.                    wis->i=i;
  236.                    wimp_get_icon_state(wis);
  237.                    b=wis->icon.flags&wimp_ICON_SELECTED;
  238.                    Tcl_SetVar2(w_Interp,db->s[i],ob->tag,
  239.                      (b)?"1":"0",TCL_GLOBAL_ONLY);
  240.                    break;
  241.                  }
  242.     case ARADIO1:{ wimp_i *wi=(wimp_i*)█
  243.                    wimp_which_icon(ob->w,wi,0x003f0000,
  244.                      0x00200000|(ww->icons[i].flags&0x000f0000));
  245.                    j=wi[0];
  246.                    if(j>0)
  247.                    Tcl_SetVar2(w_Interp,db->s[i],ob->tag,
  248.                      ww->icons[j].data.indirected_text.text,TCL_GLOBAL_ONLY);
  249.                    break;
  250.                  }
  251.      case AWRITE:{ wimp_icon_state *wis=(wimp_icon_state*)█
  252.                    wis->w=ob->w;
  253.                    wis->i=i;
  254.                    wimp_get_icon_state(wis);
  255.                    Tcl_SetVar2(w_Interp,db->s[i],ob->tag,
  256.                      wis->icon.data.indirected_text.text,TCL_GLOBAL_ONLY);
  257.                    break;
  258.                   }
  259.   }
  260. }
  261.  
  262. /*
  263.  *   box_key  --
  264.  *      Called after a key event is returned by wimp_poll.
  265.  *      If the window is an open dialog box it takes the relevant action.
  266.  *
  267.  * Results:
  268.  *      Returns TRUE if the window was a dbox and key dealt with.
  269.  *
  270.  * Side effects:
  271.  *      None.
  272.  *
  273. */
  274.  
  275. bool box_key(void)
  276. { openbox *ob;
  277.   char *s;
  278.   for(ob=openboxlist;ob;ob=ob->next)
  279.   if(ob->w==block.key.w) switch(block.key.c)
  280.   { case 13:s=ob->db->d;goto run ;
  281.     case 27:s=ob->db->e;goto run;
  282.     default:return FALSE;
  283.   }
  284.   run:if(s)
  285.   { getvars(ob);
  286.     sprintf(substr['b'-'a'],"s");
  287.     checkEval(s,"key action");
  288.     if(!strcmp(w_Interp->result,"0")) closebox(ob);
  289.   }
  290.   return TRUE;
  291. }
  292.  
  293. /*
  294.  *   box_click  --
  295.  *      Called after a mouse (except menu) event is returned by wimp_poll.
  296.  *      If the window is an open dialog box it takes the relevant action.
  297.  *      For a drag event is starts a sprite drag, it sets the variables
  298.  *      dragtype, dragscript, dragleaf and dragopenbox.
  299.  *
  300.  * Results:
  301.  *      Returns TRUE if the window was a dbox.
  302.  *
  303.  * Side effects:
  304.  *      None.
  305.  *
  306. */
  307.  
  308. extern bool box_click(void)
  309. { openbox *ob;
  310.   dbox *db;
  311.   for(ob=openboxlist;ob;ob=ob->next)
  312.   if(ob->w==block.pointer.w)
  313.   { wimp_i ic=block.pointer.i;
  314.     wimp_window *ww;
  315.     db=ob->db;
  316.     if(block.pointer.buttons==wimp_DRAG_SELECT) switch(db->t[ic])
  317.     { case ADRAG:{ os_box sbox;
  318.                    wimp_window_state state[1];
  319.                    wimp_icon_state *wis=(wimp_icon_state*)█
  320.                    char *s;
  321.                    ww=db->ww;
  322.                    state->w=ob->w;
  323.                    wimp_get_window_state(state);
  324.                    sbox.x0=state->visible.x0+ww->icons[ic].extent.x0;
  325.                    sbox.x1=sbox.x0+68;
  326.                    sbox.y0=state->visible.y1+ww->icons[ic].extent.y0;
  327.                    sbox.y1=sbox.y0+68;
  328.                    dragasprite_start(
  329.                               dragasprite_HPOS_CENTRE|dragasprite_VPOS_CENTRE|
  330.                               dragasprite_BOUND_POINTER|dragasprite_DROP_SHADOW,
  331.                               (osspriteop_area*)1,
  332.                               ww->icons[ic].data.indirected_text.text,&sbox,0);
  333.                    wis->w=ob->w;
  334.                    wis->i=ic;
  335.                    wimp_get_icon_state(wis);
  336.                    dragtype=
  337.                     (int)strtol(wis->icon.data.indirected_text.text+5,0,16);
  338.                    wis->w=ob->w;
  339.                    wis->i=ic+1;
  340.                    wimp_get_icon_state(wis);
  341.                    dragleaf=wis->icon.data.indirected_text.text;
  342.                    s=strrchr(dragleaf,'.');
  343.                    if(s) dragleaf=s+1;
  344.                    dragscript=db->s[ic];
  345.                    dragopenbox=ob;
  346.                  }
  347.     }
  348.     else switch(db->t[ic])
  349.     { case AACTION:if(db->s[ic]==0) closebox(ob);
  350.                    else
  351.                    { setbutton();
  352.                      getvars(ob);
  353.                      checkEval(db->s[ic],"action button");
  354.                      if(getconstant(w_Interp->result)==0) closebox(ob);
  355.                    }
  356.                    break;
  357.     }
  358.     return TRUE;
  359.   }
  360.   return FALSE;
  361. }
  362.  
  363. /*
  364.  *   box_dragged --
  365.  *      Called after a user_drag_box event is returned from wimp_poll
  366.  *      sends a data_save message to the window under the ponter.
  367.  *      Stops the sprite drag.
  368.  *
  369.  * Results:
  370.  *      None.
  371.  *
  372.  * Side effects:
  373.  *      None.
  374.  *
  375. */
  376.  
  377. void box_dragged(void)
  378. { wimp_pointer wp[1];
  379.   wimp_message wm;
  380.   if(!dragscript) return;
  381.   dragasprite_stop();
  382.   wimp_get_pointer_info(wp);
  383.   if(!wp->w) return;
  384.   wm.size=256;
  385.   wm.your_ref=0;
  386.   wm.action=message_DATA_SAVE;
  387.   wm.data.data_xfer.w=wp->w;
  388.   wm.data.data_xfer.i=wp->i;
  389.   wm.data.data_xfer.pos=wp->pos;
  390.   wm.data.data_xfer.est_size=0;
  391.   wm.data.data_xfer.file_type=dragtype;
  392.   sprintf(wm.data.data_xfer.file_name,dragleaf);
  393.   wimp_send_message_to_window(wimp_USER_MESSAGE_RECORDED,&wm,wp->w,wp->i);
  394. }
  395.  
  396. /*
  397.  *   box_dragsave --
  398.  *      Called after the receipt of a data_save_acknowledge message.
  399.  *      Sets the variables from dragopenbox.
  400.  *      Sets w_file and the %t substitution.
  401.  *      Evaluates dragscript.
  402.  *      If dragscript indicates success returns a data_load message.
  403.  *      If the script indicates closes the dbox
  404.  *      Zeros dragopenbox and dragscript to avoid possible confusion
  405.  *      from spurious messages.
  406.  *
  407.  * Results:
  408.  *      None.
  409.  *
  410.  * Side effects:
  411.  *      None.
  412.  *
  413. */
  414.  
  415. void box_dragsave(wimp_message *m)
  416. { wimp_message_data_xfer *dx=&(m->data.data_xfer);
  417.   wimp_message wm;
  418.   wimp_t from=m->sender;
  419.   int res;
  420.   wm.size=256;
  421.   wm.your_ref=m->my_ref;
  422.   wm.action=message_DATA_LOAD;
  423.   wm.data.data_xfer=m->data.data_xfer;
  424.   if(!dragscript) return;
  425.   if(dragopenbox) getvars(dragopenbox);
  426.   Tcl_SetVar2(w_Interp,"w_file",0,dx->file_name,TCL_GLOBAL_ONLY);
  427.   sprintf(substr['t'-'a'],"%d",dx->file_type);
  428.   checkEval(dragscript,"save drag");
  429.   dragscript=0;
  430.   res=getconstant(w_Interp->result);
  431.   if(res<'2') wimp_send_message(wimp_USER_MESSAGE_RECORDED,&wm,from);
  432.   if(!(res&1)&&dragopenbox) closebox(dragopenbox);
  433.   dragopenbox=0;
  434. }
  435.  
  436. /*
  437.  *   box_dragload --
  438.  *      Called in response to a wimp_dataload message.
  439.  *      If the message is to a writeable icon in a dbox it copies the
  440.  *      file name into the icon if it fits.
  441.  *
  442.  * Results:
  443.  *      TRUE if the message was to a dbox.
  444.  *
  445.  * Side effects:
  446.  *      None.
  447.  *
  448. */
  449.  
  450. bool box_dragload(wimp_message *m)
  451. { openbox *ob;
  452.   wimp_message_data_xfer *dx=&(m->data.data_xfer);
  453.   for(ob=openboxlist;ob;ob=ob->next)
  454.   if(ob->w==dx->w)
  455.   { wimp_i ic=dx->i;
  456.     dbox *db=ob->db;
  457.     wimp_window *ww=db->ww;
  458.     if(ic>=0&&db->t[ic]==AWRITE)
  459.     { int n=ww->icons[ic].data.indirected_text.size;
  460.       char *t=ww->icons[ic].data.indirected_text.text;
  461.       if(n>strlen(dx->file_name))
  462.       { strcpy(t,dx->file_name);
  463.         wimp_set_icon_state(dx->w,ic,0,0);
  464.       }
  465.     }
  466.     return TRUE;
  467.   }
  468.   return FALSE;
  469. }
  470.  
  471. /*
  472.  *   freeboxtree --
  473.  *      Frees the boxtree after a dbox has been created.
  474.  *
  475.  * Results:
  476.  *      None.
  477.  *
  478.  * Side effects:
  479.  *      None.
  480.  *
  481. */
  482.  
  483. static void freeboxtree(boxnode *bn)
  484. { int i;
  485.   switch(bn->type)
  486.   { case IHLIST:
  487.     case IVLIST:for(i=0;i<bn->n1;i++) freeboxtree(bn->blist[i]);
  488.                 break;
  489.       case IBOX:freeboxtree(bn->blist[0]);
  490.                 break;
  491.   }
  492.   ckfree(bn);
  493. }
  494.  
  495. /*
  496.  *   equalize --
  497.  *      Scans a vertical or horizontal list node in the box tree.
  498.  *      If consecutive objects of the same type are found their sizes
  499.  *      are set to the maximum. Objects of type HLIST VLIST BOX and SPRITE
  500.  *      are not considered, and are ignored when considering consecutiveness.
  501.  *
  502.  * Results:
  503.  *      None.
  504.  *
  505.  * Side effects:
  506.  *      None.
  507.  *
  508. */
  509.  
  510. static void equalize(boxnode *bn,int n)
  511. { int i,j,k,gtype,n1,n2,n3=-1;
  512.   boxnode *gn;
  513.   for(i=0;i<n;i++)
  514.   { gn=bn->blist[i];
  515.     if(gn->type>ISAVE)
  516.     { if(gn->type==gtype)
  517.       { if(gn->n1>n1) { n1=gn->n1;for(j=k;j<i;j++) bn->blist[j]->n1=n1;}
  518.         else gn->n1=n1;
  519.         if(gn->n2>n2) { n2=gn->n2;for(j=k;j<i;j++) bn->blist[j]->n2=n2;}
  520.         else gn->n2=n2;
  521.         if(gn->n3>n3) { n3=gn->n3;for(j=k;j<i;j++) bn->blist[j]->n3=n3;}
  522.         else gn->n2=n2;
  523.       }
  524.       else
  525.       { gtype=gn->type;
  526.         n1=gn->n1;n2=gn->n2;n3=gn->n3;
  527.         k=i;
  528.       }
  529.     }
  530.   }
  531. }
  532.  
  533. /*
  534.  *   getboxtree --
  535.  *      The construction of a dbox from a textual description proceeds
  536.  *      in two stages. First a tree structure is constructed from the
  537.  *      text. This is then used to make a dbox structure, including a
  538.  *      window template with icon descriptions. This recursive procedure
  539.  *      creates the boxtree.
  540.  *
  541.  * Results:
  542.  *      Returns a node of a box tree or zero for error.
  543.  *
  544.  * Side effects:
  545.  *      Uses some temporary global variables.
  546.  *
  547. */
  548.  
  549. static boxnode *getboxtree(char *desc)
  550. { boxnode *bn,*gn;
  551.   int nargs,i,type;
  552.   char **args;
  553.   if(Tcl_SplitList(w_Interp,desc,&nargs,&args)) return 0;
  554.   if(nargs<2) return wrong0(WNA,"<component> ...");
  555.   for(type=0;type<ILAST;type++) if(!strcmp(args[0],icd[type].t))break;
  556.   if(type>=ILAST) return wrong0("Unknown dbox component: ",args[0]);
  557.   switch(type)
  558.   { case IHLIST:
  559.     case IVLIST:bn=ckalloc(BSIZE(nargs-1));
  560.                 bn->n1=nargs-1;
  561.                 for(i=0;i<nargs-1;i++)
  562.                 { bn->blist[i]=getboxtree(args[i+1]);
  563.                   if(bn->blist[i]==0) return wrong0("empty vlist",0);
  564.                   bn->w=0;bn->h=0;
  565.                 }
  566.                 break;
  567.       case IBOX:if(nargs!=3) return wrong0(WNA,"box <name> <component>");
  568.                 bn=ckalloc(BSIZE(1));
  569.                 bn->s1=scopy(args[1]);
  570.                 bn->n1=strlen(bn->s1);
  571.                 bn->blist[0]=getboxtree(args[2]);
  572.                 if(bn->blist[0]==0) return wrong0("empty hlist",0);
  573.                 bn->w=64+bn->blist[0]->w;
  574.                 bn->h=72+bn->blist[0]->h;
  575.                 if(bn->n1*CHWIDTH+80>bn->w) bn->w=bn->n1*CHWIDTH+80;
  576.                 break;
  577.    case ISPRITE:bn=ckalloc(BSIZE(0));
  578.                 bn->s1=scopy(args[1]);
  579.                 bn->n1=(int)spriteinfo(bn->s1,&(bn->w),&(bn->h),TRUE);
  580.                 if(bn->n1==0) bn->n1=1;
  581.                 bn->w+=GAP;
  582.                 bn->h+=GAP;
  583.                 break;
  584.      case ISAVE:if(nargs!=4)
  585.                   return wrong0(WNA,"save <filetype> <variable> <script>");
  586.                 bn=ckalloc(BSIZE(0));
  587.                 bn->n1=typenumber(args[1]);
  588.                 if(bn->n1>=0&&bn->n1<4096)
  589.                 { bn->s1=ckalloc(9);
  590.                   sprintf(bn->s1,"file_%03.3x",bn->n1);
  591.                 }
  592.                 else
  593.                 { char *s="file_xxx";
  594.                   if(bn->n1==0x1000) s="directory";
  595.                   if(bn->n1==0x2000) s="application";
  596.                   bn->s1=scopy(s);
  597.                 }
  598.                 bn->s2=scopy(args[2]);
  599.                 bn->s3=scopy(args[3]);
  600.                 bn->w=192;
  601.                 bn->h=176;
  602.                 break;
  603.         default:bn=ckalloc(BSIZE(0));
  604.                 if(nargs<3&&type>IDEFAULT)
  605.                   return wrong0("Component requires more arguments: ",args[0]);
  606.                 bn->n1=strlen(args[1]);
  607.                 bn->n2=0;bn->n3=0;bn->n4=0;
  608.                 bn->s1=scopy(args[1]);
  609.                 bn->s2=(nargs==2)?0:scopy(args[2]);
  610.                 bn->s3=0;
  611.                 bn->h=icd[type].h;
  612.   }
  613.   nicons+=icd[type].n;
  614.   bn->type=type;
  615.   switch(type)
  616.   { case IHLIST:equalize(bn,nargs-1);
  617.                 for(i=0;i<nargs-1;i++)
  618.                 { gn=bn->blist[i];
  619.                   if(gn->type>ISAVE)
  620.                     gn->w=icd[gn->type].w+(gn->n1+gn->n2+gn->n3)*CHWIDTH;
  621.                   bn->w+=gn->w;
  622.                   if(gn->h>bn->h) bn->h=gn->h;
  623.                 }
  624.                 break;
  625.     case IVLIST:equalize(bn,nargs-1);
  626.                 for(i=0;i<nargs-1;i++)
  627.                 { gn=bn->blist[i];
  628.                   if(gn->type>ISAVE)
  629.                   gn->w=icd[gn->type].w+(gn->n1+gn->n2+gn->n3)*CHWIDTH;
  630.                   bn->h+=gn->h;
  631.                   if(gn->w>bn->w) bn->w=gn->w;
  632.                 }
  633.                 break;
  634.      case IINFO:bn->n2=strlen(args[2]);
  635.                 break;
  636.   case IDISPLAY:if(nargs>3) bn->n2=atoi(args[3]);
  637.                 if(bn->n2<1) bn->n2=20;
  638.                 break;
  639.     case IWRITE:case IWATCH:
  640.                 if(nargs>3) bn->n2=atoi(args[3]);
  641.                 if(nargs>4) bn->n4=atoi(args[4]);
  642.                 if(bn->n2<1) bn->n2=20;
  643.                 if(bn->n4<1) bn->n4=256;
  644.                 break;
  645.   }
  646.   if(type>ISAVE) bn->w=icd[type].w+(bn->n1+bn->n2+bn->n3)*CHWIDTH;
  647.   return bn;
  648. }
  649.  
  650. /*
  651.  *   puticon --
  652.  *      Sets the size and flags of an icon. Increments nexticon to point
  653.  *      to the space for the next icon's data. Increments the count of
  654.  *      icons in the box.
  655.  *
  656.  * Results:
  657.  *      None.
  658.  *
  659.  * Side effects:
  660.  *      None.
  661.  *
  662. */
  663.  
  664. static void puticon(bits flags,int x0,int x1,int y0,int y1)
  665. { nexticon->extent.x0=x0;
  666.   nexticon->extent.x1=x1;
  667.   nexticon->extent.y1=-y1;
  668.   nexticon->extent.y0=-y0;
  669.   nexticon->flags=flags;
  670.   nexticon++;inum++;
  671. }
  672.  
  673. /*
  674.  *   setind --
  675.  *      Sets the indirected icon data
  676.  *
  677.  * Results:
  678.  *      None.
  679.  *
  680.  * Side effects:
  681.  *      None.
  682.  *
  683. */
  684.  
  685. static void setind(char *t,char *v,int s)
  686. { nexticon->data.indirected_text.text=t;
  687.   nexticon->data.indirected_text.validation=v;
  688.   nexticon->data.indirected_text.size=s;
  689. }
  690.  
  691. /*
  692.  *   group --
  693.  *      Determines the esg of a radio button icon from its variable name
  694.  *
  695.  * Results:
  696.  *      An esg number.
  697.  *
  698.  * Side effects:
  699.  *      If this is the first use of this radio button variable name
  700.  *      in this dbox the name is stored in esg[esgnumber]. The fact
  701.  *      that this was first is stored in esg_first.
  702.  *
  703.  */
  704.  
  705. static bits group(char *s)
  706. { bits i;
  707.   for(i=1;i<16;i++)
  708.   { if(esg[i]==0) { esg[i]=s;esg_first=ARADIO1;break;}
  709.     if(!strcmp(s,esg[i])) { esg_first=ARADIO2;break;}
  710.   }
  711.   if(i>15) i=15;
  712.   return i<<wimp_ICON_ESG_SHIFT;
  713. }
  714.  
  715. /*
  716.  *   seticons --
  717.  *      Adds the icon definitions to a dbox template.
  718.  *      adds the action data for the icons to dbt and dbs.
  719.  *
  720.  * Results:
  721.  *      None.
  722.  *
  723.  * Side effects:
  724.  *      Uses some temporary global variables.
  725.  *
  726.  */
  727.  
  728. static void seticons(boxnode *bn,int w,int h,int in,int dn)
  729. { int i,xg,yg,out,type=bn->type;
  730.   bits g;
  731.   xg=w-bn->w;
  732.   yg=h-bn->h;
  733.   switch(type)
  734.   { case IHLIST:xg=xg/(bn->n1+1);
  735.                for(i=0;i<bn->n1;i++)
  736.                { in+=xg;
  737.                  seticons(bn->blist[i],bn->blist[i]->w,h,in,dn);
  738.                  in+=bn->blist[i]->w;
  739.                }
  740.                break;
  741.     case IVLIST:yg=yg/(bn->n1+1);
  742.                for(i=0;i<bn->n1;i++)
  743.                { dn+=yg;
  744.                  seticons(bn->blist[i],w,bn->blist[i]->h,in,dn);
  745.                  dn+=bn->blist[i]->h;
  746.                }
  747.                break;
  748.      case IBOX:in+=xg/2+16;dn+=yg/2+24;
  749.                setind("","R4",0);
  750.                out=in+bn->w-32;
  751.                puticon(0x1700011D,in,out,dn+bn->h-32,dn);
  752.                setind(bn->s1,(char*)-1,bn->n1);
  753.                out=in+48+CHWIDTH*bn->n1;
  754.                puticon(0x17000139,in+32,out,dn+24,dn-20);
  755.                seticons(bn->blist[0],bn->w-64,bn->h-72,in+16,dn+32);
  756.                break;
  757.   case ISPRITE:in+=xg/2;dn+=yg/2;
  758.                setind(bn->s1,(char*)(bn->n1),strlen(bn->s1));
  759.                puticon(0x1700013a,in,in+bn->w,dn+bn->h,dn);
  760.                break;
  761.     case ISAVE:in+=xg/2;dn+=yg/2;
  762.                dbt[inum]=ADRAG;dbs[inum]=bn->s3;
  763.                setind(bn->s1,(char*)1,strlen(bn->s1)+1);
  764.                puticon(0x1700613a,in+62,in+130,dn+76,dn+8);
  765.                dbt[inum]=AWRITE;dbs[inum]=bn->s2;
  766.                if(careticon<0) careticon=inum;
  767.                setind(0,"A~ ;Kta;Pptr_write",256);
  768.                puticon(0x0700f13d,in+8,in+184,dn+144,dn+92);
  769.                break;
  770.     case IINFO:case IDISPLAY:case IWATCH:
  771.                in+=xg/2+HALFGAP;dn+=yg/2+HALFGAP;
  772.                setind(bn->s1,0,bn->n1);
  773.                out=in+CHWIDTH*bn->n1+32;
  774.                puticon(0x17000311,in,out,dn+icd[type].h-GAP,dn);
  775.                in=out+GAP;
  776.                if(type==IDISPLAY) {dbt[inum]=ADISPLAY;dbs[inum]=bn->s2;}
  777.                if(type==IWATCH) {dbt[inum]=AWATCH;dbs[inum]=bn->s2;}
  778.                setind(bn->s2,"R2",(type==IWATCH)?bn->n4:bn->n2);
  779.                out=in+CHWIDTH*bn->n2+32;
  780.                puticon(0x1700013d,in,out,dn+icd[type].h-GAP,dn);
  781.                break;
  782.  case IDEFAULT:dd=bn->s2;/*Deliberate fall through*/
  783.   case IACTION:if(!strcmp(bn->s1,"Cancel")) ee=bn->s2;
  784.                in+=xg/2+HALFGAP;dn+=yg/2+HALFGAP;
  785.                setind(bn->s1,(type==IACTION)?"R5.3":"R6,3",bn->n1);
  786.                dbt[inum]=AACTION;dbs[inum]=bn->s2;
  787.                out=in+CHWIDTH*bn->n1+32;
  788.                puticon((type==IACTION)?0x1702313d:0x170f313d,
  789.                          in,out,dn+icd[type].h-GAP,dn);
  790.                break;
  791.   case IOPTION:in+=xg/2+HALFGAP;dn+=yg/2+HALFGAP;
  792.                setind(bn->s1,"soptoff,opton",bn->n1);
  793.                dbt[inum]=AOPTION;dbs[inum]=bn->s2;
  794.                out=in+CHWIDTH*bn->n1+52;
  795.                puticon(0x1720b113,in,out,dn+icd[type].h-GAP,dn);
  796.                break;
  797.    case IRADIO:in+=xg/2+HALFGAP;dn+=yg/2+HALFGAP;
  798.                setind(bn->s1,"sradiooff,radioon",bn->n1);
  799.                g=group(bn->s2);
  800.                dbt[inum]=esg_first;dbs[inum]=bn->s2;
  801.                out=in+CHWIDTH*bn->n1+52;
  802.                puticon(0x1720b113|g,in,out,dn+icd[type].h-GAP,dn);
  803.                break;
  804.     case IWRITE:in+=xg/2+HALFGAP;dn+=yg/2+HALFGAP;
  805.                setind(bn->s1,0,bn->n1);
  806.                out=in+CHWIDTH*bn->n1+32;
  807.                puticon(0x17000311,in,out,dn+icd[type].h-GAP,dn);
  808.                in=out+GAP;
  809.                dbt[inum]=AWRITE;dbs[inum]=bn->s2;
  810.                if(careticon<0) careticon=inum;
  811.                setind(0,"Kta;Pptr_write",bn->n4);
  812.                out=in+CHWIDTH*bn->n2+32;
  813.                puticon(0x0700f13d,in,out,dn+icd[type].h-GAP,dn);
  814.                break;
  815.   }
  816. }
  817.  
  818. /*
  819.  *   makedbox --
  820.  *      Creates a dbox structure from a box tree.
  821.  *
  822.  * Results:
  823.  *      Returns a dbox pointer or zero for error
  824.  *
  825.  * Side effects:
  826.  *      Uses some temporary global variables.
  827.  *
  828. */
  829.  
  830. static dbox *makedbox(boxnode *bn)
  831. { dbox *db=ckcalloc(sizeof(dbox));
  832.   wimp_window *ww=ckalloc(WSIZE(nicons));
  833.   int x,y;
  834.   screensize(&x,&y);
  835.   db->t=ckcalloc(nicons*sizeof(int));
  836.   db->s=ckcalloc(nicons*sizeof(char*));
  837.   dbt=db->t;dbs=db->s;dd=0;ee=0;
  838.   careticon=-1;
  839.   inum=0;
  840.   *ww=progInfo;
  841.   if(bn->w>1600||bn->h>1200)
  842.   { sprintf(w_Interp->result,
  843.     "dbox too large %d x %d",bn->w,bn->h);
  844.     return 0;
  845.   }
  846.   ww->visible.x0=(x-bn->w)/2;
  847.   if(offset>y-INSET) offset=y-INSET;
  848.   offset-=bn->h+40;
  849.   if(offset<INSET) offset=y-INSET-bn->h;
  850.   ww->visible.y0=offset;
  851.   ww->visible.x1=ww->visible.x0+bn->w;
  852.   ww->visible.y1=ww->visible.y0+bn->h;
  853.   ww->extent.x1=bn->w;
  854.   ww->extent.y0=-bn->h;
  855.   ww->icon_count=nicons;
  856.   db->ww=ww;
  857.   nexticon=db->ww->icons;
  858.   seticons(bn,bn->w,bn->h,0,0);
  859.   db->d=dd;db->e=ee;db->c=careticon;
  860.   return db;
  861. }
  862.  
  863. /*
  864.  *   update --
  865.  *      Called by a variable trace to update a watch icon
  866.  *
  867.  * Results:
  868.  *      None.
  869.  *
  870.  * Side effects:
  871.  *      None.
  872.  *
  873. */
  874.  
  875. static char *update(ClientData d,Tcl_Interp *interp,char *n1,char *n2,int flags)
  876. { char *v=Tcl_GetVar2(interp,n1,n2,flags&TCL_GLOBAL_ONLY);
  877.   char *t;
  878.   int n;
  879.   wimp_icon_state *wis=(wimp_icon_state*)█
  880.   wis->w=((watchdata*)d)->ob->w;
  881.   wis->i=((watchdata*)d)->ic;
  882.   wimp_get_icon_state(wis);
  883.   t=wis->icon.data.indirected_text.text;
  884.   n=wis->icon.data.indirected_text.size;
  885.   if(v) strncpy(t,v,n);else t[0]=0;
  886.   t[n-1]=0;
  887.   wimp_set_icon_state(wis->w,wis->i,0,0);
  888.   return 0;
  889. }
  890.  
  891. /*
  892.  *   box_fillin --
  893.  *      Sets the dialog box fields corresponding to Tcl variables
  894.  *
  895.  * Results:
  896.  *      None.
  897.  *
  898.  * Side effects:
  899.  *      None.
  900.  *
  901. */
  902.  
  903. static void box_fillin(dbox *db,char *tag,openbox *ob)
  904. { wimp_window *ww=db->ww;
  905.   int ni=ww->icon_count;
  906.   int i,n;
  907.   bool truth;
  908.   char *s,*t;
  909.   for(i=0;i<ni;i++) switch(db->t[i])
  910.   {   case ADISPLAY:s=Tcl_GetVar2(w_Interp,db->s[i],tag,TCL_GLOBAL_ONLY);
  911.                   if(!s) s="";
  912.                   ww->icons[i].data.indirected_text.text=scopy(s);
  913.                   break;
  914.      case AOPTION:s=Tcl_GetVar2(w_Interp,db->s[i],tag,TCL_GLOBAL_ONLY);
  915.                   if(!s) truth=FALSE;
  916.                   else truth=strcmp(s,"0");
  917.                   if(truth) ww->icons[i].flags|=wimp_ICON_SELECTED;
  918.                   else ww->icons[i].flags&=~wimp_ICON_SELECTED;
  919.                   break;
  920.       case ARADIO1:case ARADIO2:
  921.                   s=Tcl_GetVar2(w_Interp,db->s[i],tag,TCL_GLOBAL_ONLY);
  922.                   if(!s) truth=FALSE;
  923.                   else truth=!strcmp(s,ww->icons[i].data.indirected_text.text);
  924.                   if(truth) ww->icons[i].flags|=wimp_ICON_SELECTED;
  925.                   else ww->icons[i].flags&=~wimp_ICON_SELECTED;
  926.                   break;
  927.       case AWATCH:{ watchdata *wd=ckalloc(sizeof(struct watchdata));
  928.                     wd->next=watchdatalist;
  929.                     watchdatalist=wd;
  930.                     wd->ob=ob;
  931.                     wd->ic=i;
  932.                     Tcl_TraceVar2(w_Interp,db->s[i],tag,
  933.                                   TRACEFLAGS,update,(ClientData)wd);
  934.                   }
  935.                   /*Deliberate fall through*/
  936.       case AWRITE:n=ww->icons[i].data.indirected_text.size;
  937.                   t=ckalloc(n);
  938.                   ww->icons[i].data.indirected_text.text=t;
  939.                   s=Tcl_GetVar2(w_Interp,db->s[i],tag,TCL_GLOBAL_ONLY);
  940.                   if(s) strncpy(t,s,n);else t[0]=0;
  941.                   t[n-1]=0;
  942.                   break;
  943.   }
  944. }
  945.  
  946. /*
  947.  *   box_submenu --
  948.  *      Opens a transient dbox
  949.  *
  950.  * Results:
  951.  *      None.
  952.  *
  953.  * Side effects:
  954.  *      None.
  955.  *
  956. */
  957.  
  958. extern void box_submenu(void *d,char *tag,int x,int y)
  959. { openbox *ob=ckalloc(sizeof(openbox));
  960.   dbox *db=d;
  961.   if(!db->tagged) tag=0;
  962.   if(tag) tag=scopy(tag);
  963.   box_fillin(db,tag,ob);
  964.   if(xwimp_create_window(db->ww,&(ob->w))) return;
  965.   ob->tag=tag;
  966.   ob->db=db;
  967.   ob->next=openboxlist;
  968.   openboxlist=ob;
  969.   block.open.w=ob->w;
  970.   wimp_create_sub_menu((wimp_menu*)ob->w,x,y);
  971. }
  972.  
  973. /*
  974.  *   box_open --
  975.  *      Implements the w_box <name> open  command
  976.  *
  977.  * Results:
  978.  *      A standard Tcl result
  979.  *
  980.  * Side effects:
  981.  *      None.
  982.  *
  983. */
  984.  
  985. static int box_open(void *d,char *tag)
  986. { openbox *ob=ckalloc(sizeof(openbox));
  987.   dbox* db=d;
  988.   box_fillin(db,tag,ob);
  989.   if(xwimp_create_window(db->ww,&(ob->w)))
  990.      return wrong("Unable to create window",0);
  991.   ob->tag=tag;
  992.   ob->db=db;
  993.   ob->next=openboxlist;
  994.   openboxlist=ob;
  995.   block.open.w=ob->w;
  996.   wimp_get_window_state((wimp_window_state*)&block);
  997.   wimp_open_window((wimp_open*)&block);
  998.   if(db->c>=0) wimp_set_caret_position(ob->w,db->c,0,0,-1,1000);
  999.   return TCL_OK;
  1000. }
  1001.  
  1002. /*
  1003.  *   w_BoxCmd --
  1004.  *      Implements the Tcl w_box command
  1005.  *
  1006.  * Results:
  1007.  *      A standard Tcl result.
  1008.  *
  1009.  * Side effects:
  1010.  *      Creating a box uses various temporary global variables
  1011.  *
  1012. */
  1013.  
  1014. int w_BoxCmd(ClientData dummy,Tcl_Interp *interp,int argc,char **argv)
  1015. { dbox *db;
  1016.   Tcl_HashEntry *p;
  1017.   if(argc<3) return wrong(WNA,"w_box <name> <command> ...");
  1018.   /* *********** create a dbox *************** */
  1019.   if(!strcmp(argv[2],"create"))
  1020.   { boxnode *bn;
  1021.     int new;
  1022.     if(argc!=5&&(argc!=6||strcmp(argv[5],"-tag")))
  1023.     return wrong(WNA,"w_box <name> create <title> <component> ?-tag?");
  1024.     nicons=0;
  1025.     for(new=0;new<16;new++) esg[new]=0;
  1026.     bn=getboxtree(argv[4]);
  1027.     if(nicons==0) return wrong("dbox has no icons",0);
  1028.     if(!bn) return TCL_ERROR;
  1029.     db=makedbox(bn);
  1030.     if(db==0) return TCL_ERROR;
  1031.     freeboxtree(bn);
  1032.     db->tagged=(argc==6);
  1033.     db->ww->title_data.indirected_text.text=scopy(argv[3]);
  1034.     db->ww->title_data.indirected_text.validation=(char*)-1;
  1035.     db->ww->title_data.indirected_text.size=strlen(argv[3]);
  1036.     p=Tcl_CreateHashEntry(&boxTable,argv[1],&new);
  1037.     if(!new)
  1038.     { Tcl_AppendResult(interp,"box already exists ",argv[1],0);
  1039.       return TCL_ERROR;
  1040.     }
  1041.     Tcl_SetHashValue(p,db);
  1042.     return TCL_OK;
  1043.   }
  1044.   p=Tcl_FindHashEntry(&boxTable,argv[1]);
  1045.   if(!p) return wrong("No such dbox",argv[1]);
  1046.   db=(dbox*)Tcl_GetHashValue(p);
  1047.   /* *********** open a persistent dbox *************** */
  1048.   if(!strcmp(argv[2],"open")) return box_open(db,(argc>3)?scopy(argv[3]):0);
  1049.   return wrong("unknown w_box command",argv[2]);
  1050. }
  1051.  
  1052.  
  1053.  
  1054.