home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v92.tgz / v92.tar / v92 / src / runtime / fwindow.r < prev    next >
Text File  |  1996-03-22  |  49KB  |  2,054 lines
  1. /*
  2.  * File: fwindow.r - Icon graphics interface
  3.  *
  4.  * Contents: Active, Bg, Color, CopyArea, Couple,
  5.  *  DrawArc, DrawCircle, DrawCurve, DrawImage, DrawLine,
  6.  *  DrawSegment, DrawPoint, DrawPolygon, DrawString,
  7.  *  DrawRectangle, EraseArea, Event, Fg, FillArc, FillCircle,
  8.  *  FillRectangle, FillPolygon, Font, FreeColor, GotoRC, GotoXY,
  9.  *  NewColor, Pattern, PaletteChars, PaletteColor, PaletteKey,
  10.  *  Pending, QueryPointer, ReadImage, TextWidth, Uncouple,
  11.  *  WAttrib, WDefault, WFlush, WSync, WriteImage
  12.  */
  13.  
  14. #ifdef Graphics
  15.  
  16. /*
  17.  * Global variables.
  18.  *  A poll counter for use in interp.c,
  19.  *  the binding for the console window - FILE * for simplicity,
  20.  *  &col, &row, &x, &y, &interval, timestamp, and modifier keys.
  21.  */
  22. int pollctr;
  23. FILE *ConsoleBinding = NULL;
  24. /*
  25.  * the global buffer used as work space for printing string, etc 
  26.  */
  27. char ConsoleStringBuf[MaxReadStr * 48];
  28. char *ConsoleStringBufPtr = ConsoleStringBuf;
  29. unsigned long ConsoleFlags = 0;             /* Console flags */
  30.  
  31.  
  32.  
  33. "Active() - produce the next active window"
  34.  
  35. function{0,1} Active()
  36.    abstract {
  37.       return file
  38.       }
  39.    body {
  40.       wsp ws;
  41.       if (!wstates || !(ws = getactivewindow())) fail;
  42.       return ws->filep;
  43.       }
  44. end
  45.  
  46.  
  47. "Alert(w,volume) - Alert the user"
  48.  
  49. function{1} Alert(argv[argc])
  50.    abstract {
  51.       return file
  52.       }
  53.    body {
  54.       wbp w;
  55.       int warg = 0;
  56.       C_integer volume;
  57.       OptWindow(w);
  58.  
  59.       if (argc == warg) volume = 0;
  60.       else if (!def:C_integer(argv[warg], 0, volume))
  61.         runerr(101, argv[warg]);
  62.       walert(w, volume);
  63.       ReturnWindow;
  64.       }
  65. end
  66.  
  67. "Bg(w,s) - background color"
  68.  
  69. function{0,1} Bg(argv[argc])
  70.    abstract {
  71.       return string
  72.       }
  73.    body {
  74.       wbp w;
  75.       char sbuf1[MaxCvtLen];
  76.       int len;
  77.       tended char *tmp;
  78.       int warg = 0;
  79.       OptWindow(w);
  80.  
  81.       /*
  82.        * If there is a (non-window) argument we are setting by
  83.        * either a mutable color (negative int) or a string name.
  84.        */
  85.       if (argc - warg > 0) {
  86.      if (is:integer(argv[warg])) {    /* mutable color or packed RGB */
  87.         if (isetbg(w, IntVal(argv[warg])) == Failed) fail;
  88.         }
  89.      else {
  90.         if (!cnv:C_string(argv[warg], tmp))
  91.            runerr(103,argv[warg]);
  92.         if(setbg(w, tmp) == Failed) fail;
  93.         }
  94.          }
  95.  
  96.       /*
  97.        * In any event, this function returns the current background color.
  98.        */
  99.       getbg(w, sbuf1);
  100.       len = strlen(sbuf1);
  101.       Protect(tmp = alcstr(sbuf1, len), runerr(0));
  102.       return string(len, tmp);
  103.       }
  104. end
  105.  
  106.  
  107. "Clip(w, x, y, w, h) - set context clip rectangle"
  108.  
  109. function{1} Clip(argv[argc])
  110.    abstract {
  111.       return file
  112.       }
  113.    body {
  114.       wbp w;
  115.       int warg = 0, r;
  116.       C_integer x, y, width, height;
  117.       wcp wc;
  118.       OptWindow(w);
  119.  
  120.       wc = w->context;
  121.  
  122.       if (argc <= warg) {
  123.          wc->clipx = wc->clipy = 0;
  124.          wc->clipw = wc->cliph = -1;
  125.          unsetclip(w);
  126.          }
  127.       else {
  128.          r = rectargs(w, argc, argv, warg, &x, &y, &width, &height);
  129.          if (r >= 0)
  130.             runerr(101, argv[r]);
  131.          wc->clipx = x;
  132.          wc->clipy = y;
  133.          wc->clipw = width;
  134.          wc->cliph = height;
  135.          setclip(w);
  136.          }
  137.  
  138.       ReturnWindow;
  139.       }
  140. end
  141.  
  142.  
  143. "Clone(w, attribs...) - create a new context bound to w's canvas"
  144.  
  145. function{1} Clone(argv[argc])
  146.    abstract {
  147.       return file
  148.       }
  149.    body {
  150.       wbp w, w2;
  151.       int warg = 0, n;
  152.       tended struct descrip sbuf, sbuf2;
  153.       char answer[128];
  154.       OptWindow(w);
  155.  
  156.       Protect(w2 = alc_wbinding(), runerr(0));
  157.       w2->window = w->window;
  158.       w2->window->refcount++;
  159.  
  160.       if (argc>warg && is:file(argv[warg])) {
  161.      if ((BlkLoc(argv[warg])->file.status & Fs_Window) == 0)
  162.         runerr(140,argv[warg]);
  163.      if ((BlkLoc(argv[warg])->file.status & (Fs_Read|Fs_Write)) == 0)
  164.         runerr(142,argv[warg]);
  165.      if (ISCLOSED((wbp)BlkLoc(argv[warg])->file.fd))
  166.         runerr(142,argv[warg]);
  167.      Protect(w2->context =
  168.          clone_context((wbp)BlkLoc(argv[warg])->file.fd), runerr(0));
  169.      warg++;
  170.      }
  171.       else {
  172.      Protect(w2->context = clone_context(w), runerr(0));
  173.      }
  174.  
  175.       for (n = warg; n < argc; n++) {
  176.      if (!is:null(argv[n])) {
  177.         if (!cnv:tmp_string(argv[n], sbuf))
  178.            runerr(109, argv[n]);
  179.         switch (wattrib(w2, StrLoc(argv[n]), StrLen(argv[n]), &sbuf2, answer)) {
  180.         case Failed: fail;
  181.         case Error: runerr(0, argv[n]);
  182.            }
  183.         }
  184.      }
  185.  
  186.       Protect(BlkLoc(result) =
  187.            (union block *)alcfile((FILE *)w2, Fs_Window|Fs_Read|Fs_Write,
  188.                       &emptystr),runerr(0));
  189.       result.dword = D_File;
  190.       return result;
  191.       }
  192. end
  193.  
  194.  
  195.  
  196. "Color(argv[]) - return or set color map entries"
  197.  
  198. function{0,1} Color(argv[argc])
  199.    abstract {
  200.       return file ++ string
  201.       }
  202.    body {
  203.       wbp w;
  204.       int warg = 0;
  205.       int i, len;
  206.       C_integer n;
  207.       char *colorname, *srcname;
  208.       tended char *tmp;
  209.  
  210.       OptWindow(w);
  211.       if (argc - warg == 0) runerr(101);
  212.  
  213.       if (argc - warg == 1) {            /* if this is a query */
  214.          CnvCInteger(argv[warg], n)
  215.          if ((colorname = get_mutable_name(w, n)) == NULL)
  216.             fail;
  217.          len = strlen(colorname);
  218.          Protect(tmp = alcstr(colorname, len), runerr(0));
  219.          return string(len, colorname);
  220.          }
  221.  
  222.       CheckArgMultiple(2);
  223.  
  224.       for (i = warg; i < argc; i += 2) {
  225.          CnvCInteger(argv[i], n)
  226.          if ((colorname = get_mutable_name(w, n)) == NULL)
  227.             fail;
  228.  
  229.          if (is:integer(argv[i+1])) {        /* copy another mutable  */
  230.             if (IntVal(argv[i+1]) >= 0)
  231.                runerr(205, argv[i+1]);        /* must be negative */
  232.             if ((srcname = get_mutable_name(w, IntVal(argv[i+1]))) == NULL)
  233.                fail;
  234.             if (set_mutable(w, n, srcname) == Failed) fail;
  235.             strcpy(colorname, srcname);
  236.             }
  237.    
  238.          else {                    /* specified by name */
  239.             tended char *tmp;
  240.             if (!cnv:C_string(argv[i+1],tmp))
  241.                runerr(103,argv[i+1]);
  242.    
  243.             if (set_mutable(w, n, tmp) == Failed) fail;
  244.             strcpy(colorname, tmp);
  245.             }
  246.          }
  247.  
  248.       ReturnWindow;
  249.       }
  250. end
  251.  
  252.  
  253. "ColorValue(w,s) - produce RGB components from string color name"
  254.  
  255. function{0,1} ColorValue(argv[argc])
  256.    abstract {
  257.       return string
  258.       }
  259.    body {
  260.       wbp w;
  261.       C_integer n;
  262.       int warg = 0, len;
  263.       long r, g, b;
  264.       tended char *s;
  265.       char tmp[24], *t;
  266.  
  267.       if (is:file(argv[0]) && (BlkLoc(argv[0])->file.status & Fs_Window)) {
  268.          w = (wbp)BlkLoc(argv[0])->file.fd;        /* explicit window */    
  269.          warg = 1;
  270.          }
  271.       else if (is:file(kywd_xwin[XKey_Window]) &&
  272.             (BlkLoc(kywd_xwin[XKey_Window])->file.status & Fs_Window))
  273.          w = (wbp)BlkLoc(kywd_xwin[XKey_Window])->file.fd;    /* &window */
  274.       else
  275.          w = NULL;            /* no window (but proceed anyway) */
  276.  
  277.       if (!(warg < argc))
  278.          runerr(103);
  279.  
  280.       if (cnv:C_integer(argv[warg], n)) {
  281.          if (w != NULL && (t = get_mutable_name(w, n)))
  282.             Protect(s = alcstr(t, (word)strlen(t)), runerr(306));
  283.          else
  284.             fail;
  285.          }
  286.       else if (!cnv:C_string(argv[warg], s))
  287.          runerr(103,argv[warg]);
  288.  
  289.       if (parsecolor(w, s, &r, &g, &b) == Succeeded) {
  290.          sprintf(tmp,"%d,%d,%d", r, g, b);
  291.      len = strlen(tmp);
  292.      Protect(s = alcstr(tmp,len), runerr(306));
  293.      return string(len, s);
  294.          }
  295.       fail;
  296.       }
  297. end
  298.  
  299.  
  300. "CopyArea(w,w2,x,y,width,height,x2,y2) - copy area"
  301.  
  302. function{0,1} CopyArea(argv[argc]) /* w,w2,x,y,width,height,x2,y2 */
  303.    abstract {
  304.       return file
  305.       }
  306.    body {
  307.       int warg = 0, n, r;
  308.       C_integer x, y, width, height, x2, y2, width2, height2;
  309.       wbp w, w2;
  310.       OptWindow(w);
  311.  
  312.       /*
  313.        * 2nd window defaults to value of first window
  314.        */
  315.       if (argc>warg && is:file(argv[warg])) {
  316.      if ((BlkLoc(argv[warg])->file.status & Fs_Window) == 0)
  317.         runerr(140,argv[warg]);
  318.      if ((BlkLoc(argv[warg])->file.status & (Fs_Read|Fs_Write)) == 0)
  319.         runerr(142,argv[warg]);
  320.      w2 = (wbp)BlkLoc(argv[warg])->file.fd;
  321.      if (ISCLOSED(w2))
  322.         runerr(142,argv[warg]);
  323.      warg++;
  324.      }
  325.       else {
  326.      w2 = w;
  327.      }
  328.  
  329.       /*
  330.        * x1, y1, width, and height follow standard conventions.
  331.        */
  332.       r = rectargs(w, argc, argv, warg, &x, &y, &width, &height);
  333.       if (r >= 0)
  334.          runerr(101, argv[r]);
  335.  
  336.       /*
  337.        * get x2 and y2, ignoring width and height.
  338.        */
  339.       n = argc;
  340.       if (n > warg + 6)
  341.          n = warg + 6;
  342.       r = rectargs(w2, n, argv, warg + 4, &x2, &y2, &width2, &height2);
  343.       if (r >= 0)
  344.          runerr(101, argv[r]);
  345.  
  346.       if (copyArea(w, w2, x, y, width, height, x2, y2) == Failed)
  347.          fail;
  348.       ReturnWindow;
  349.       }
  350. end
  351.  
  352. /*
  353.  * Bind the canvas associated with w to the context
  354.  *  associated with w2.  If w2 is omitted, create a new context.
  355.  *  Produces a new window variable.
  356.  */
  357. "Couple(w,w2) - couple canvas to context"
  358.  
  359. function{0,1} Couple(w,w2)
  360.    abstract {
  361.       return file
  362.       }
  363.    body {
  364.       tended struct descrip sbuf, sbuf2;
  365.       tended struct b_list *hp;
  366.       tended struct b_lelem *bp;
  367.       wbp wb, wb_new;
  368.       wsp ws;
  369.  
  370.       /*
  371.        * make the new binding
  372.        */
  373.       Protect(wb_new = alc_wbinding(), runerr(0));
  374.  
  375.       /*
  376.        * if w is a file, then we bind to an existing window
  377.        */
  378.       if (is:file(w) && (BlkLoc(w)->file.status & Fs_Window)) {
  379.      wb = (wbp)(BlkLoc(w)->file.fd);
  380.      wb_new->window = ws = wb->window;
  381.      if (is:file(w2) && (BlkLoc(w2)->file.status & Fs_Window)) {
  382.         /*
  383.          * Bind an existing window to an existing context,
  384.          * and up the context's reference count.
  385.          */
  386.         if (rebind(wb_new, (wbp)(BlkLoc(w2)->file.fd)) == Failed) fail;
  387.         wb_new->context->refcount++;
  388.         }
  389.      else 
  390.         runerr(140, w2);
  391.  
  392.      /* bump up refcount to ws */
  393.      ws->refcount++;
  394.      }
  395.       else
  396.      runerr(140, w);
  397.  
  398.       Protect(BlkLoc(result) =
  399.      (union block *)alcfile((FILE *)wb_new,    Fs_Window|Fs_Read|Fs_Write,
  400.                 &emptystr),runerr(0));
  401.       result.dword = D_File;
  402.       return result;
  403.       }
  404. end
  405.  
  406. /*
  407.  * DrawArc(w, x1, y1, width1, height1, angle11, angle21,...)
  408.  */
  409. "DrawArc(argv[]){1} - draw arc"
  410.  
  411. function{1} DrawArc(argv[argc])
  412.    abstract {
  413.       return file
  414.       }
  415.    body {
  416.       wbp w;
  417.       int i, j, r, warg = 0;
  418.       XArc arcs[MAXXOBJS];
  419.       C_integer x, y, width, height;
  420.       double a1, a2;
  421.  
  422.       OptWindow(w);
  423.       j = 0;
  424.       for (i = warg; i < argc || i == warg; i += 6) {
  425.          if (j == MAXXOBJS) {
  426.             drawarcs(w, arcs, MAXXOBJS);
  427.             j = 0;
  428.             }
  429.          r = rectargs(w, argc, argv, i, &x, &y, &width, &height);
  430.          if (r >= 0)
  431.             runerr(101, argv[r]);
  432.  
  433.          arcs[j].x = x;
  434.          arcs[j].y = y;
  435.          ARCWIDTH(arcs[j]) = width;
  436.          ARCHEIGHT(arcs[j]) = height;
  437.  
  438.      /*
  439.       * Angle 1 processing.  Computes in radians and 64'ths of a degree,
  440.       *  bounds checks, and handles wraparound.
  441.       */
  442.          if (i + 4 >= argc || is:null(argv[i + 4]))
  443.         a1 = 0.0;
  444.          else {
  445.             if (!cnv:C_double(argv[i + 4], a1))
  446.                runerr(102, argv[i + 4]);
  447.             if (a1 >= 0.0)
  448.                a1 = fmod(a1, 2 * Pi);
  449.             else
  450.                a1 = -fmod(-a1, 2 * Pi);
  451.             }
  452.      /*
  453.       * Angle 2 processing
  454.       */
  455.          if (i + 5 >= argc || is:null(argv[i + 5]))
  456.         a2 = 2 * Pi;
  457.          else {
  458.             if (!cnv:C_double(argv[i + 5], a2))
  459.                runerr(102, argv[i + 5]);
  460.             if (fabs(a2) > 3 * Pi)
  461.                runerr(101, argv[i + 5]);
  462.             }
  463.          if (fabs(a2) >= 2 * Pi) {
  464.         a2 = 2 * Pi;
  465.         }
  466.          else {
  467.             if (a2 < 0.0) {
  468.                a1 += a2;
  469.                a2 = fabs(a2);
  470.                }
  471.             }
  472.          if (a1 < 0.0)
  473.             a1 = 2 * Pi - fmod(fabs(a1), 2 * Pi);
  474.          else
  475.             a1 = fmod(a1, 2 * Pi);
  476.          arcs[j].angle1 = ANGLE(a1);
  477.          arcs[j].angle2 = EXTENT(a2);
  478.  
  479.          j++;
  480.          }
  481.  
  482.       drawarcs(w, arcs, j);
  483.       ReturnWindow;
  484.       }
  485. end
  486.  
  487. /*
  488.  * DrawCircle(w, x1, y1, r1, angle11, angle21, ...)
  489.  */
  490. "DrawCircle(argv[]){1} - draw circle"
  491.  
  492. function{1} DrawCircle(argv[argc])
  493.    abstract {
  494.       return file
  495.       }
  496.    body {
  497.       wbp w;
  498.       int warg = 0, r;
  499.  
  500.       OptWindow(w);
  501.       r = docircles(w, argc - warg, argv + warg, 0);
  502.       if (r < 0)
  503.          ReturnWindow;
  504.       else if (r >= argc - warg)
  505.          runerr(146);
  506.       else 
  507.          runerr(102, argv[warg + r]);
  508.       }
  509. end
  510.  
  511. /*
  512.  * DrawCurve(w,x1,y1,...xN,yN)
  513.  *  Draw a smooth curve through the given points.
  514.  */
  515. "DrawCurve(argv[]){1} - draw curve"
  516.  
  517. function{1} DrawCurve(argv[argc])
  518.    abstract {
  519.       return file
  520.       }
  521.    body {
  522.       wbp w;
  523.       int i, n, closed = 0, warg = 0;
  524.       C_integer dx, dy, x0, y0, xN, yN;
  525.       XPoint *points;
  526.  
  527.       OptWindow(w);
  528.       CheckArgMultiple(2);
  529.  
  530.       dx = w->context->dx;
  531.       dy = w->context->dy;
  532.  
  533.       Protect(points = (XPoint *)malloc(sizeof(XPoint) * (n+2)), runerr(305));
  534.  
  535.       if (n > 1) {
  536.      CnvCInteger(argv[warg], x0)
  537.      CnvCInteger(argv[warg + 1], y0)
  538.      CnvCInteger(argv[argc - 2], xN)
  539.      CnvCInteger(argv[argc - 1], yN)
  540.          if ((x0 == xN) && (y0 == yN)) {
  541.             closed = 1;               /* duplicate the next to last point */
  542.         CnvCShort(argv[argc-4], points[0].x);
  543.         CnvCShort(argv[argc-3], points[0].y);
  544.         points[0].x += w->context->dx;
  545.         points[0].y += w->context->dy;
  546.             }
  547.          else {                       /* duplicate the first point */
  548.         CnvCShort(argv[warg], points[0].x);
  549.         CnvCShort(argv[warg + 1], points[0].y);
  550.         points[0].x += w->context->dx;
  551.         points[0].y += w->context->dy;
  552.             }
  553.          for (i = 1; i <= n; i++) {
  554.         int base = warg + (i-1) * 2;
  555.             CnvCShort(argv[base], points[i].x);
  556.             CnvCShort(argv[base + 1], points[i].y);
  557.         points[i].x += dx;
  558.         points[i].y += dy;
  559.             }
  560.          if (closed) {                /* duplicate the second point */
  561.             points[i] = points[2];
  562.             }
  563.          else {                       /* duplicate the last point */
  564.             points[i] = points[i-1];
  565.             }
  566.      if (n < 3) {
  567.         drawlines(w, points+1, n);
  568.         }
  569.      else {
  570.         drawCurve(w, points, n+2);
  571.         }
  572.          }
  573.       free(points);
  574.       ReturnWindow;
  575.       }
  576. end
  577.  
  578.  
  579. "DrawImage(w,x,y,s) - draw bitmapped figure"
  580.  
  581. function{0,1} DrawImage(argv[argc])
  582.    abstract {
  583.       return null++integer
  584.       }
  585.    body {
  586.       wbp w;
  587.       int warg = 0;
  588.       int c, i, width, height, row, p;
  589.       C_integer x, y;
  590.       word nchars;
  591.       unsigned char *s, *t, *z;
  592.       struct descrip d;
  593.       struct palentry *e;
  594.       OptWindow(w);
  595.  
  596.       /*
  597.        * X or y can be defaulted but s is required.
  598.        * Validate x/y first so that the error message makes more sense.
  599.        */
  600.       if (argc - warg >= 1 && !def:C_integer(argv[warg], -w->context->dx, x))
  601.          runerr(101, argv[warg]);
  602.       if (argc - warg >= 2 && !def:C_integer(argv[warg + 1], -w->context->dy, y))
  603.          runerr(101, argv[warg + 1]);
  604.       if (argc - warg < 3)
  605.          runerr(103);            /* missing s */
  606.       if (!cnv:tmp_string(argv[warg+2], d))
  607.          runerr(103, argv[warg + 2]);
  608.  
  609.       x += w->context->dx;
  610.       y += w->context->dy;
  611.       /*
  612.        * Extract the Width and skip the following comma.
  613.        */
  614.       s = (unsigned char *)StrLoc(d);
  615.       z = s + StrLen(d);        /* end+1 of string */
  616.       width = 0;
  617.       while (s < z && *s == ' ')    /* skip blanks */
  618.      s++;
  619.       while (s < z && isdigit(*s))    /* scan number */
  620.          width = 10 * width + *s++ - '0';
  621.       while (s < z && *s == ' ')    /* skip blanks */
  622.      s++;
  623.       if (width == 0 || *s++ != ',')    /* skip comma */
  624.          fail;
  625.       while (s < z && *s == ' ')    /* skip blanks */
  626.      s++;
  627.       if (s >= z)            /* if end of string */
  628.      fail;
  629.  
  630.       /*
  631.        * Check for a bilevel format.
  632.        */
  633.       if ((c = *s) == '#' || c == '~') {
  634.          s++;
  635.          nchars = 0;
  636.          for (t = s; t < z; t++)
  637.             if (isxdigit(*t))
  638.                nchars++;            /* count hex digits */
  639.             else if (*t != PCH1 && *t != PCH2)
  640.                fail;                /* illegal punctuation */
  641.          if (nchars == 0)
  642.             fail;
  643.          row = (width + 3) / 4;            /* digits per row */
  644.          if (nchars % row != 0)
  645.             fail;
  646.          height = nchars / row;
  647.          if (blimage(w, x, y, width, height, c, s, (word)(z - s)) == Error)
  648.             runerr(305);
  649.          else
  650.             return nulldesc;
  651.          }
  652.  
  653.       /*
  654.        * Extract the palette name and skip its comma.
  655.        */
  656.       c = *s++;                    /* save initial character */
  657.       p = 0;
  658.       while (s < z && isdigit(*s))        /* scan digits */
  659.          p = 10 * p + *s++ - '0';
  660.       while (s < z && *s == ' ')        /* skip blanks */
  661.      s++;
  662.       if (s >= z || p == 0 || *s++ != ',')    /* skip comma */
  663.          fail;
  664.       if (c == 'g' && p >= 2 && p <= 256)    /* validate grayscale number */
  665.          p = -p;
  666.       else if (c != 'c' || p < 1 || p > 6)    /* validate color number */
  667.          fail;
  668.  
  669.       /*
  670.        * Scan the image to see which colors are needed.
  671.        */
  672.       e = palsetup(p); 
  673.       if (e == NULL)
  674.          runerr(305);
  675.       for (i = 0; i < 256; i++)
  676.          e[i].used = 0;
  677.       nchars = 0;
  678.       for (t = s; t < z; t++) {
  679.          c = *t; 
  680.          e[c].used = 1;
  681.          if (e[c].valid || e[c].transpt)
  682.             nchars++;            /* valid color, or transparent */
  683.          else if (c != PCH1 && c != PCH2)
  684.             fail;
  685.          }
  686.       if (nchars == 0)
  687.          fail;                    /* empty image */
  688.       if (nchars % width != 0)
  689.          fail;                    /* not rectangular */
  690.  
  691.       /*
  692.        * Call platform-dependent code to draw the image.
  693.        */
  694.       height = nchars / width;
  695.       i = strimage(w, x, y, width, height, e, s, (word)(z - s), 0);
  696.       if (i == 0)
  697.          return nulldesc;
  698.       else if (i < 0)
  699.          runerr(305);
  700.       else
  701.          return C_integer i;
  702.       }
  703. end
  704.  
  705. /*
  706.  * DrawLine(w,x1,y1,...xN,yN)
  707.  */
  708. "DrawLine(argv[]){1} - draw line"
  709.  
  710. function{1} DrawLine(argv[argc])
  711.    abstract {
  712.       return file
  713.       }
  714.    body {
  715.       wbp w;
  716.       int i, j, n, warg = 0;
  717.       XPoint points[MAXXOBJS];
  718.       int dx, dy;
  719.  
  720.       OptWindow(w);
  721.       CheckArgMultiple(2);
  722.  
  723.       dx = w->context->dx;
  724.       dy = w->context->dy;
  725.       for(i=0, j=0;i<n;i++, j++) {
  726.      int base = warg + i * 2;
  727.          if (j==MAXXOBJS) {
  728.         drawlines(w, points, MAXXOBJS);
  729.         points[0] = points[MAXXOBJS-1];
  730.            j = 1;
  731.             }
  732.          CnvCShort(argv[base], points[j].x);
  733.          CnvCShort(argv[base + 1], points[j].y);
  734.      points[j].x += dx;
  735.      points[j].y += dy;
  736.          }
  737.       drawlines(w, points, j);
  738.       ReturnWindow;
  739.       }
  740. end
  741.  
  742. /*
  743.  * DrawPoint(w, x1, y1, ...xN, yN)
  744.  */
  745. "DrawPoint(argv[]){1} - draw point"
  746.  
  747. function{1} DrawPoint(argv[argc])
  748.    abstract {
  749.       return file
  750.       }
  751.    body {
  752.       wbp w;
  753.       int i, j, n, warg = 0;
  754.       XPoint points[MAXXOBJS];
  755.       int dx, dy;
  756.  
  757.       OptWindow(w);
  758.       CheckArgMultiple(2);
  759.  
  760.       dx = w->context->dx;
  761.       dy = w->context->dy;
  762.       for(i=0, j=0; i < n; i++, j++) {
  763.      int base = warg + i * 2;
  764.          if (j == MAXXOBJS) {
  765.         drawpoints(w, points, MAXXOBJS);
  766.             j = 0;
  767.             }
  768.          CnvCShort(argv[base], points[j].x);
  769.          CnvCShort(argv[base + 1], points[j].y);
  770.      points[j].x += dx;
  771.      points[j].y += dy;
  772.        }
  773.       drawpoints(w, points, j);
  774.       ReturnWindow;
  775.       }
  776. end
  777.  
  778. /*
  779.  * DrawPolygon(w,x1,y1,...xN,yN)
  780.  */
  781. "DrawPolygon(argv[]){1} - draw polygon"
  782.  
  783. function{1} DrawPolygon(argv[argc])
  784.    abstract {
  785.       return file
  786.       }
  787.    body {
  788.       wbp w;
  789.       int i, j, n, base, dx, dy, warg = 0;
  790.       XPoint points[MAXXOBJS];
  791.  
  792.       OptWindow(w);
  793.       CheckArgMultiple(2);
  794.  
  795.       dx = w->context->dx;
  796.       dy = w->context->dy;
  797.  
  798.       /*
  799.        * To make a closed polygon, start with the *last* point.
  800.        */
  801.       CnvCShort(argv[argc - 2], points[0].x);
  802.       CnvCShort(argv[argc - 1], points[0].y);
  803.       points[0].x += dx;
  804.       points[0].y += dy;
  805.  
  806.       /*
  807.        * Now add all points from beginning to end, including last point again.
  808.        */
  809.       for(i = 0, j = 1; i < n; i++, j++) {
  810.          base = warg + i * 2;
  811.          if (j == MAXXOBJS) {
  812.             drawlines(w, points, MAXXOBJS);
  813.             points[0] = points[MAXXOBJS-1];
  814.             j = 1;
  815.             }
  816.          CnvCShort(argv[base], points[j].x);
  817.          CnvCShort(argv[base + 1], points[j].y);
  818.          points[j].x += dx;
  819.          points[j].y += dy;
  820.          }
  821.       drawlines(w, points, j);
  822.       ReturnWindow;
  823.       }
  824. end
  825.  
  826. /*
  827.  * DrawRectangle(w, x1, y1, width1, height1, ..., xN, yN, widthN,heightN)
  828.  */
  829. "DrawRectangle(argv[]){1} - draw rectangle"
  830.  
  831. function{1} DrawRectangle(argv[argc])
  832.    abstract {
  833.       return file
  834.       }
  835.    body {
  836.       wbp w;
  837.       int i, j, r, warg = 0;
  838.       XRectangle recs[MAXXOBJS];
  839.       C_integer x, y, width, height;
  840.  
  841.       OptWindow(w);
  842.       j = 0;
  843.  
  844.       for (i = warg; i < argc || i == warg; i += 4) {
  845.          r = rectargs(w, argc, argv, i, &x, &y, &width, &height);
  846.          if (r >= 0)
  847.             runerr(101, argv[r]);
  848.          if (j == MAXXOBJS) {
  849.             drawrectangles(w,recs,MAXXOBJS);
  850.             j = 0;
  851.             }
  852.          RECX(recs[j]) = x;
  853.          RECY(recs[j]) = y;
  854.          RECWIDTH(recs[j]) = width;
  855.          RECHEIGHT(recs[j]) = height;
  856.          j++;
  857.          }
  858.  
  859.       drawrectangles(w, recs, j);
  860.       ReturnWindow;
  861.       }
  862. end
  863.  
  864. /*
  865.  * DrawSegment(x11,y11,x12,y12,...,xN1,yN1,xN2,yN2)
  866.  */
  867. "DrawSegment(argv[]){1} - draw line segment"
  868.  
  869. function{1} DrawSegment(argv[argc])
  870.    abstract {
  871.       return file
  872.       }
  873.    body {
  874.       wbp w;
  875.       int i, j, n, warg = 0, dx, dy;
  876.       XSegment segs[MAXXOBJS];
  877.  
  878.       OptWindow(w);
  879.       CheckArgMultiple(4);
  880.  
  881.       dx = w->context->dx;
  882.       dy = w->context->dy;
  883.       for(i=0, j=0; i < n; i++, j++) {
  884.      int base = warg + i * 4;
  885.          if (j == MAXXOBJS) {
  886.         drawsegments(w, segs, MAXXOBJS);
  887.             j = 0;
  888.             }
  889.          CnvCShort(argv[base], segs[j].x1);
  890.          CnvCShort(argv[base + 1], segs[j].y1);
  891.          CnvCShort(argv[base + 2], segs[j].x2);
  892.          CnvCShort(argv[base + 3], segs[j].y2);
  893.      segs[j].x1 += dx;
  894.      segs[j].x2 += dx;
  895.      segs[j].y1 += dy;
  896.      segs[j].y2 += dy;
  897.          }
  898.       drawsegments(w, segs, j);
  899.       ReturnWindow;
  900.       }
  901. end
  902.  
  903. /*
  904.  * DrawString(w, x1, y1, s1, ..., xN, yN, sN)
  905.  */
  906. "DrawString(argv[]){1} - draw text"
  907.  
  908. function{1} DrawString(argv[argc])
  909.    abstract {
  910.       return file
  911.       }
  912.    body {
  913.       wbp w;
  914.       int i, n, len, warg = 0;
  915.       char *s;
  916.       int dx, dy;
  917.  
  918.       OptWindow(w);
  919.       CheckArgMultiple(3);
  920.  
  921.       for(i=0; i < n; i++) {
  922.          C_integer x, y;
  923.      int base = warg + i * 3;
  924.          CnvCInteger(argv[base], x);
  925.          CnvCInteger(argv[base + 1], y);
  926.      x += w->context->dx;
  927.      y += w->context->dy;
  928.          CnvTmpString(argv[base + 2], argv[base + 2]);
  929.      s = StrLoc(argv[base + 2]);
  930.      len = StrLen(argv[base + 2]);
  931.      drawstrng(w, x, y, s, len);
  932.          }
  933.       ReturnWindow;
  934.       }
  935. end
  936.  
  937.  
  938. "EraseArea(w,x,y,width,height) - clear an area of the window"
  939.  
  940. function{1} EraseArea(argv[argc])
  941.    abstract {
  942.       return file
  943.       }
  944.    body {
  945.       wbp w;
  946.       int warg = 0, i, r;
  947.       C_integer x, y, width, height;
  948.       OptWindow(w);
  949.  
  950.       for (i = warg; i < argc || i == warg; i += 4) {
  951.          r = rectargs(w, argc, argv, i, &x, &y, &width, &height);
  952.          if (r >= 0)
  953.             runerr(101, argv[r]);
  954.          eraseArea(w, x, y, width, height);
  955.          }
  956.  
  957.       ReturnWindow;
  958.       }
  959. end
  960.  
  961.  
  962. "Event(w) - return an event from a window"
  963.  
  964. function{1} Event(argv[argc])
  965.    abstract {
  966.       return string ++ integer
  967.       }
  968.    body {
  969.       wbp w;
  970.       C_integer i;
  971.       tended struct descrip d;
  972.       int warg = 0;
  973.       OptWindow(w);
  974.  
  975.       d = nulldesc;
  976.       i = wgetevent(w, &d);
  977.       if (i == 0) {
  978.          if (is:file(kywd_xwin[XKey_Window]) &&
  979.                w == (wbp)BlkLoc(kywd_xwin[XKey_Window])->file.fd)
  980.         lastEventWin = kywd_xwin[XKey_Window];
  981.      else
  982.         lastEventWin = argv[warg-1];
  983.          lastEvFWidth = FWIDTH((wbp)BlkLoc(lastEventWin)->file.fd);
  984.          lastEvLeading = LEADING((wbp)BlkLoc(lastEventWin)->file.fd);
  985.          lastEvAscent = ASCENT((wbp)BlkLoc(lastEventWin)->file.fd);
  986.      return d;
  987.      }
  988.       else if (i == -1)
  989.      runerr(141);
  990.       else
  991.      runerr(143);
  992.       }
  993. end
  994.  
  995.  
  996. "Fg(w,s) - foreground color"
  997.  
  998. function{0,1} Fg(argv[argc])
  999.    abstract {
  1000.       return string
  1001.       }
  1002.    body {
  1003.       wbp w;
  1004.       char sbuf1[MaxCvtLen];
  1005.       int len;
  1006.       tended char *tmp;
  1007.       int warg = 0;
  1008.       OptWindow(w);
  1009.  
  1010.       /*
  1011.        * If there is a (non-window) argument we are setting by
  1012.        *  either a mutable color (negative int) or a string name.
  1013.        */
  1014.       if (argc - warg > 0) {
  1015.      if (is:integer(argv[warg])) {    /* mutable color or packed RGB */
  1016.         if (isetfg(w, IntVal(argv[warg])) == Failed) fail;
  1017.         }
  1018.      else {
  1019.         if (!cnv:C_string(argv[warg], tmp))
  1020.            runerr(103,argv[warg]);
  1021.         if(setfg(w, tmp) == Failed) fail;
  1022.         }
  1023.          }
  1024.  
  1025.       /*
  1026.        * In any case, this function returns the current foreground color.
  1027.        */
  1028.       getfg(w, sbuf1);
  1029.       len = strlen(sbuf1);
  1030.       Protect(tmp = alcstr(sbuf1, len), runerr(0));
  1031.       return string(len, tmp);
  1032.       }
  1033. end
  1034.  
  1035. /*
  1036.  * FillArc(w, x1, y1, width1, height1, angle11, angle21,...)
  1037.  */
  1038. "FillArc(argv[]){1} - fill arc"
  1039.  
  1040. function{1} FillArc(argv[argc])
  1041.    abstract {
  1042.       return file
  1043.       }
  1044.    body {
  1045.       wbp w;
  1046.       int i, j, r, warg = 0;
  1047.       XArc arcs[MAXXOBJS];
  1048.       C_integer x, y, width, height;
  1049.       double a1, a2;
  1050.  
  1051.       OptWindow(w);
  1052.       j = 0;
  1053.       for (i = warg; i < argc || i == warg; i += 6) {
  1054.          if (j == MAXXOBJS) {
  1055.             fillarcs(w, arcs, MAXXOBJS);
  1056.             j = 0;
  1057.             }
  1058.          r = rectargs(w, argc, argv, i, &x, &y, &width, &height);
  1059.          if (r >= 0)
  1060.             runerr(101, argv[r]);
  1061.  
  1062.          arcs[j].x = x;
  1063.          arcs[j].y = y;
  1064.          ARCWIDTH(arcs[j]) = width;
  1065.          ARCHEIGHT(arcs[j]) = height;
  1066.  
  1067.          if (i + 4 >= argc || is:null(argv[i + 4])) {
  1068.             a1 = 0.0;
  1069.         }
  1070.          else {
  1071.             if (!cnv:C_double(argv[i + 4], a1))
  1072.                runerr(102, argv[i + 4]);
  1073.             if (a1 >= 0.0)
  1074.                a1 = fmod(a1, 2 * Pi);
  1075.             else
  1076.                a1 = -fmod(-a1, 2 * Pi);
  1077.             }
  1078.          if (i + 5 >= argc || is:null(argv[i + 5]))
  1079.         a2 = 2 * Pi;
  1080.          else {
  1081.             if (!cnv:C_double(argv[i + 5], a2))
  1082.                runerr(102, argv[i + 5]);
  1083.             if (fabs(a2) > 3 * Pi)
  1084.                runerr(101, argv[i + 5]);
  1085.             }
  1086.          if (fabs(a2) >= 2 * Pi) {
  1087.         a2 = 2 * Pi;
  1088.         }
  1089.          else {
  1090.             if (a2 < 0.0) {
  1091.                a1 += a2;
  1092.                a2 = fabs(a2);
  1093.                }
  1094.             }
  1095.          arcs[j].angle2 = EXTENT(a2);
  1096.          if (a1 < 0.0)
  1097.             a1 = 2 * Pi - fmod(fabs(a1), 2 * Pi);
  1098.          else
  1099.            a1 = fmod(a1, 2 * Pi);
  1100.          arcs[j].angle1 = ANGLE(a1);
  1101.  
  1102.          j++;
  1103.          }
  1104.  
  1105.       fillarcs(w, arcs, j);
  1106.       ReturnWindow;
  1107.       }
  1108. end
  1109.  
  1110. /*
  1111.  * FillCircle(w, x1, y1, r1, angle11, angle21, ...)
  1112.  */
  1113. "FillCircle(argv[]){1} - draw filled circle"
  1114.  
  1115. function{1} FillCircle(argv[argc])
  1116.    abstract {
  1117.       return file
  1118.       }
  1119.    body {
  1120.       wbp w;
  1121.       int warg = 0, r;
  1122.  
  1123.       OptWindow(w);
  1124.       r = docircles(w, argc - warg, argv + warg, 1);
  1125.       if (r < 0)
  1126.          ReturnWindow;
  1127.       else if (r >= argc - warg)
  1128.          runerr(146);
  1129.       else 
  1130.          runerr(102, argv[warg + r]);
  1131.       }
  1132. end
  1133.  
  1134. /*
  1135.  * FillPolygon(w, x1, y1, ...xN, yN)
  1136.  */
  1137. "FillPolygon(argv[]){1} - fill polygon"
  1138.  
  1139. function{1} FillPolygon(argv[argc])
  1140.    abstract {
  1141.       return file
  1142.       }
  1143.    body {
  1144.       wbp w;
  1145.       int i, n, warg = 0;
  1146.       XPoint *points;
  1147.       int dx, dy;
  1148.  
  1149.       OptWindow(w);
  1150.  
  1151.       CheckArgMultiple(2)
  1152.  
  1153.       /*
  1154.        * Allocate space for all the points in a contiguous array,
  1155.        * because a FillPolygon must be performed in a single call.
  1156.        */
  1157.       n = argc>>1;
  1158.       Protect(points = (XPoint *)malloc(sizeof(XPoint) * n), runerr(305));
  1159.       dx = w->context->dx;
  1160.       dy = w->context->dy;
  1161.       for(i=0; i < n; i++) {
  1162.      int base = warg + i * 2;
  1163.          CnvCShort(argv[base], points[i].x);
  1164.          CnvCShort(argv[base + 1], points[i].y);
  1165.      points[i].x += dx;
  1166.          points[i].y += dy;
  1167.          }
  1168.       fillpolygon(w, points, n);
  1169.       free(points);
  1170.       ReturnWindow;
  1171.       }
  1172. end
  1173.  
  1174. /*
  1175.  * FillRectangle(w, x1, y1, width1, height1,...,xN, yN, widthN, heightN)
  1176.  */
  1177. "FillRectangle(argv[]){1} - draw filled rectangle"
  1178.  
  1179. function{1} FillRectangle(argv[argc])
  1180.    abstract {
  1181.       return file
  1182.       }
  1183.    body {
  1184.       wbp w;
  1185.       int i, j, r, warg = 0;
  1186.       XRectangle recs[MAXXOBJS];
  1187.       C_integer x, y, width, height;
  1188.  
  1189.       OptWindow(w);
  1190.       j = 0;
  1191.  
  1192.       for (i = warg; i < argc || i == warg; i += 4) {
  1193.          r = rectargs(w, argc, argv, i, &x, &y, &width, &height);
  1194.          if (r >= 0)
  1195.             runerr(101, argv[r]);
  1196.          if (j == MAXXOBJS) {
  1197.             fillrectangles(w,recs,MAXXOBJS);
  1198.             j = 0;
  1199.             }
  1200.          RECX(recs[j]) = x;
  1201.          RECY(recs[j]) = y;
  1202.          RECWIDTH(recs[j]) = width;
  1203.          RECHEIGHT(recs[j]) = height;
  1204.          j++;
  1205.          }
  1206.  
  1207.       fillrectangles(w, recs, j);
  1208.       ReturnWindow;
  1209.       }
  1210. end
  1211.  
  1212.  
  1213.  
  1214. "Font(w,s) - get/set font"
  1215.  
  1216. function{0,1} Font(argv[argc])
  1217.    abstract {
  1218.       return string
  1219.       }
  1220.    body {
  1221.       tended char *tmp;
  1222.       int len;
  1223.       wbp w;
  1224.       int warg = 0;
  1225.       char buf[MaxCvtLen];
  1226.       OptWindow(w);
  1227.  
  1228.       if (warg < argc) {
  1229.          if (!cnv:C_string(argv[warg],tmp))
  1230.             runerr(103,argv[warg]);
  1231.          if (setfont(w,&tmp) == Failed) fail;
  1232.          }
  1233.       getfntnam(w, buf);
  1234.       len = strlen(buf);
  1235.       Protect(tmp = alcstr(buf, len), runerr(0));
  1236.       return string(len,tmp);
  1237.       }
  1238. end
  1239.  
  1240.  
  1241. "FreeColor(argv[]) - free colors"
  1242.  
  1243. function{1} FreeColor(argv[argc])
  1244.    abstract {
  1245.       return file
  1246.       }
  1247.    body {
  1248.       wbp w;
  1249.       int warg = 0;
  1250.       int i;
  1251.       C_integer n;
  1252.       tended char *s;
  1253.  
  1254.       OptWindow(w);
  1255.       if (argc - warg == 0) runerr(103);
  1256.  
  1257.       for (i = warg; i < argc; i++) {
  1258.          if (is:integer(argv[i])) {
  1259.             CnvCInteger(argv[i], n)
  1260.             if (n < 0)
  1261.                free_mutable(w, n);
  1262.             }
  1263.          else {
  1264.             if (!cnv:C_string(argv[i], s))
  1265.                runerr(103,argv[i]);
  1266.             freecolor(w, s);
  1267.             }
  1268.          }
  1269.  
  1270.       ReturnWindow;
  1271.       }
  1272.  
  1273. end
  1274.  
  1275.  
  1276. "GotoRC(w,r,c) - move cursor to a particular text row and column"
  1277.  
  1278. function{1} GotoRC(argv[argc])
  1279.    abstract {
  1280.       return file
  1281.       }
  1282.    body {
  1283.       C_integer r, c;
  1284.       wbp w;
  1285.       int warg = 0;
  1286.       OptWindow(w);
  1287.  
  1288.       if (argc - warg < 1)
  1289.      r = 1;
  1290.       else
  1291.      CnvCInteger(argv[warg], r)
  1292.       if (argc - warg < 2)
  1293.      c = 1;
  1294.       else
  1295.      CnvCInteger(argv[warg + 1], c)
  1296.  
  1297.       /*
  1298.        * turn the cursor off
  1299.        */
  1300.       hidecrsr(w->window);
  1301.  
  1302.       w->window->y = ROWTOY(w, r);
  1303.       w->window->x = COLTOX(w, c);
  1304.       w->window->x += w->context->dx;
  1305.       w->window->y += w->context->dy;
  1306.  
  1307.       /*
  1308.        * turn it back on at new location
  1309.        */
  1310.       UpdateCursorPos(w->window, w->context);
  1311.       showcrsr(w->window);
  1312.  
  1313.       ReturnWindow;
  1314.       }
  1315. end
  1316.  
  1317.  
  1318. "GotoXY(w,x,y) - move cursor to a particular pixel location"
  1319.  
  1320. function{1} GotoXY(argv[argc])
  1321.    abstract {
  1322.       return file
  1323.       }
  1324.    body {
  1325.       wbp w;
  1326.       C_integer x, y;
  1327.       int warg = 0;
  1328.       OptWindow(w);
  1329.  
  1330.       if (argc - warg < 1)
  1331.      x = 0;
  1332.       else
  1333.      CnvCInteger(argv[warg], x)
  1334.       if (argc - warg < 2)
  1335.      y = 0;
  1336.       else
  1337.      CnvCInteger(argv[warg + 1], y)
  1338.  
  1339.       x += w->context->dx;
  1340.       y += w->context->dy;
  1341.  
  1342.       hidecrsr(w->window);
  1343.  
  1344.       w->window->x = x;
  1345.       w->window->y = y;
  1346.  
  1347.       UpdateCursorPos(w->window, w->context);
  1348.       showcrsr(w->window);
  1349.  
  1350.       ReturnWindow;
  1351.       }
  1352. end
  1353.  
  1354.  
  1355. "Lower(w) - lower w to the bottom of the window stack"
  1356.  
  1357. function{1} Lower(argv[argc])
  1358.    abstract {
  1359.       return file
  1360.       }
  1361.    body {
  1362.       wbp w;
  1363.       int warg = 0;
  1364.       OptWindow(w);
  1365.       lowerWindow(w);
  1366.       ReturnWindow;
  1367.       }
  1368. end
  1369.  
  1370.  
  1371. "NewColor(w,s) - allocate an entry in the color map"
  1372.  
  1373. function{0,1} NewColor(argv[argc])
  1374.    abstract {
  1375.       return integer
  1376.       }
  1377.    body {
  1378.       wbp w;
  1379.       int rv;
  1380.       int warg = 0;
  1381.       OptWindow(w);
  1382.  
  1383.       if (mutable_color(w, argv+warg, argc-warg, &rv) == Failed) fail;
  1384.       return C_integer rv;
  1385.       }
  1386. end
  1387.  
  1388.  
  1389.  
  1390. "PaletteChars(w,p) - return the characters forming keys to palette p"
  1391.  
  1392. function{0,1} PaletteChars(argv[argc])
  1393.    abstract {
  1394.       return string
  1395.       }
  1396.    body {
  1397.       int n, warg;
  1398.       extern char c1list[], c2list[], c3list[], c4list[];
  1399.  
  1400.       if (is:file(argv[0]) && (BlkLoc(argv[0])->file.status & Fs_Window))
  1401.          warg = 1;
  1402.       else
  1403.          warg = 0;        /* window not required */
  1404.       if (argc - warg < 1)
  1405.          n = 1;
  1406.       else
  1407.          n = palnum(&argv[warg]);
  1408.       switch (n) {
  1409.          case -1:  runerr(103, argv[warg]);        /* not a string */
  1410.          case  0:  fail;                /* unrecognized */
  1411.          case  1:  return string(90, c1list);            /* c1 */
  1412.          case  2:  return string(9, c2list);            /* c2 */
  1413.          case  3:  return string(31, c3list);            /* c3 */
  1414.          case  4:  return string(73, c4list);            /* c4 */
  1415.          case  5:  return string(141, (char *)allchars);    /* c5 */
  1416.          case  6:  return string(241, (char *)allchars);    /* c6 */
  1417.          default:                    /* gn */
  1418.             if (n >= -64)
  1419.                return string(-n, c4list);
  1420.             else
  1421.                return string(-n, (char *)allchars);
  1422.          }
  1423.       }
  1424. end
  1425.  
  1426.  
  1427. "PaletteColor(w,p,s) - return color of key s in palette p"
  1428.  
  1429. function{0,1} PaletteColor(argv[argc])
  1430.    abstract {
  1431.       return string
  1432.       }
  1433.    body {
  1434.       int p, warg, len;
  1435.       char tmp[24], *s;
  1436.       struct palentry *e;
  1437.       tended struct descrip d;
  1438.  
  1439.       if (is:file(argv[0]) && (BlkLoc(argv[0])->file.status & Fs_Window))
  1440.          warg = 1;
  1441.       else
  1442.          warg = 0;            /* window not required */
  1443.       if (argc - warg < 2)
  1444.          runerr(103);
  1445.       p = palnum(&argv[warg]);
  1446.       if (p == -1)
  1447.          runerr(103, argv[warg]);
  1448.       if (p == 0)
  1449.          fail;
  1450.       if (!cnv:tmp_string(argv[warg + 1], d))
  1451.          runerr(103, argv[warg + 1]);
  1452.       if (StrLen(d) != 1)
  1453.          runerr(205, d);
  1454.       e = palsetup(p); 
  1455.       if (e == NULL)
  1456.          runerr(305);
  1457.       e += *StrLoc(d) & 0xFF;
  1458.       if (!e->valid)
  1459.          fail;
  1460.       sprintf(tmp, "%d,%d,%d", e->clr.red, e->clr.green, e->clr.blue);
  1461.       len = strlen(tmp);
  1462.       Protect(s = alcstr(tmp, len), runerr(306));
  1463.       return string(len, s);
  1464.       }
  1465. end
  1466.  
  1467.  
  1468. "PaletteKey(w,p,s) - return key of closest color to s in palette p"
  1469.  
  1470. function{0,1} PaletteKey(argv[argc])
  1471.    abstract {
  1472.       return string
  1473.       }
  1474.    body {
  1475.       wbp w;
  1476.       int warg = 0, p;
  1477.       C_integer n;
  1478.       tended char *s;
  1479.       long r, g, b;
  1480.  
  1481.       if (is:file(argv[0]) && (BlkLoc(argv[0])->file.status & Fs_Window)) {
  1482.          w = (wbp)BlkLoc(argv[0])->file.fd;        /* explicit window */    
  1483.          warg = 1;
  1484.          }
  1485.       else if (is:file(kywd_xwin[XKey_Window]) &&
  1486.             (BlkLoc(kywd_xwin[XKey_Window])->file.status & Fs_Window))
  1487.          w = (wbp)BlkLoc(kywd_xwin[XKey_Window])->file.fd;    /* &window */
  1488.       else
  1489.          w = NULL;            /* no window (but proceed anyway) */
  1490.  
  1491.       if (argc - warg < 2)
  1492.          runerr(103);
  1493.       p = palnum(&argv[warg]);
  1494.       if (p == -1)
  1495.          runerr(103, argv[warg]);
  1496.       if (p == 0)
  1497.          fail;
  1498.  
  1499.       if (cnv:C_integer(argv[warg + 1], n)) {
  1500.          if (w == NULL || (s = get_mutable_name(w, n)) == NULL)
  1501.             fail;
  1502.          }
  1503.       else if (!cnv:C_string(argv[warg + 1], s))
  1504.          runerr(103, argv[warg + 1]);
  1505.  
  1506.       if (parsecolor(w, s, &r, &g, &b) == Succeeded)
  1507.          return string(1, rgbkey(p, r / 65535.0, g / 65535.0, b / 65535.0));
  1508.       else
  1509.          fail;
  1510.       }
  1511. end
  1512.  
  1513.  
  1514. "Pattern(w,s) - sets the context fill pattern by string name"
  1515.  
  1516. function{1} Pattern(argv[argc])
  1517.    abstract {
  1518.       return file
  1519.       }
  1520.    body {
  1521.       int warg = 0;
  1522.       wbp w;
  1523.       OptWindow(w);
  1524.  
  1525.       if (argc - warg == 0)
  1526.          runerr(103, nulldesc);
  1527.  
  1528.       if (! cnv:string(argv[warg], argv[warg]))
  1529.          runerr(103, nulldesc);
  1530.  
  1531.       switch (SetPattern(w, StrLoc(argv[warg]), StrLen(argv[warg]))) {
  1532.          case Error:
  1533.             runerr(0, argv[warg]);
  1534.          case Failed:
  1535.             fail;
  1536.          }
  1537.  
  1538.       ReturnWindow;
  1539.       }
  1540. end
  1541.  
  1542.  
  1543. "Pending(w,x[]) - produce a list of events pending on window"
  1544.  
  1545. function{0,1} Pending(argv[argc])
  1546.    abstract {
  1547.       return list
  1548.       }
  1549.    body {
  1550.       wbp w;
  1551.       int warg = 0;
  1552.       wsp ws;
  1553.       int i;
  1554.       OptWindow(w);
  1555.  
  1556.       ws = w->window;
  1557.       wsync(w);
  1558.  
  1559.       /*
  1560.        * put additional arguments to Pending on the pending list in
  1561.        * guaranteed consecutive order.
  1562.        */
  1563.       for (i = warg; i < argc; i++) {
  1564.          c_put(&(ws->listp), &argv[i]);
  1565.          }
  1566.  
  1567.       /*
  1568.        * retrieve any events that might be relevant before returning the
  1569.        * pending queue.
  1570.        */
  1571.       switch (pollevent()) {
  1572.          case -1: runerr(141);
  1573.          case 0: fail;
  1574.      }
  1575.       return ws->listp;
  1576.       }
  1577. end
  1578.  
  1579.  
  1580.  
  1581. "Pixel(w,x,y,width,height) - produce the contents of some pixels"
  1582.  
  1583. function{3} Pixel(argv[argc])
  1584.    abstract {
  1585.       return integer ++ string
  1586.       }
  1587.    body {
  1588.       C_integer x, y, width, height;
  1589.       int x2, y2, width2, height2;
  1590.       wbp w;
  1591.       int warg = 0, slen, r;
  1592.       tended struct descrip lastval;
  1593.       char strout[50];
  1594.       OptWindow(w);
  1595.  
  1596.       r = rectargs(w, argc, argv, warg, &x, &y, &width, &height);
  1597.       if (r >= 0)
  1598.          runerr(101, argv[r]);
  1599.  
  1600.       {
  1601.       int i, j;
  1602.       long rv;
  1603.       wsp ws = w->window;
  1604.  
  1605. #ifndef max
  1606. #define max(x,y) (((x)<(y))?(y):(x))
  1607. #define min(x,y) (((x)>(y))?(y):(x))
  1608. #endif
  1609.  
  1610.       x2 = max(x,0);
  1611.       y2 = max(y,0);
  1612.       width2 = min(width, (int)ws->width - x2);
  1613.       height2 = min(height, (int)ws->height - y2);
  1614.  
  1615.       if (getpixel_init(w, x2, y2, width2, height2) == Failed) fail;
  1616.  
  1617.       lastval = emptystr;
  1618.  
  1619.       for (j=y; j < y + height; j++) {
  1620.          for (i=x; i < x + width; i++) {
  1621.             getpixel(w, i, j, &rv, strout);
  1622.             slen = strlen(strout);
  1623.             if (rv >= 0) {
  1624.                if (slen != StrLen(lastval) ||
  1625.                      strncmp(strout, StrLoc(lastval), slen)) {
  1626.                   Protect((StrLoc(lastval) = alcstr(strout, slen)), runerr(0));
  1627.                   StrLen(lastval) = slen;
  1628.                   }
  1629.                suspend lastval;
  1630.                }
  1631.             else {
  1632.                suspend C_integer rv;
  1633.                }
  1634.             }
  1635.          }
  1636.       fail;
  1637.       }
  1638.       }
  1639. end
  1640.  
  1641.  
  1642. "QueryPointer(w) - produce mouse position"
  1643.  
  1644. function{0,2} QueryPointer(w)
  1645.  
  1646.    declare {
  1647.       XPoint xp;
  1648.       }
  1649.    abstract {
  1650.       return integer
  1651.       }
  1652.    body {
  1653.       pollevent();
  1654.       if (is:null(w)) {
  1655.      query_rootpointer(&xp);
  1656.      }
  1657.       else {
  1658.      if (!is:file(w) || !(BlkLoc(w)->file.status & Fs_Window))
  1659.         runerr(140, w);
  1660.      query_pointer((wbp)BlkLoc(w)->file.fd, &xp);
  1661.      }
  1662.       suspend C_integer xp.x;
  1663.       suspend C_integer xp.y;
  1664.       fail;
  1665.       }
  1666. end
  1667.  
  1668.  
  1669. "Raise(w) - raise w to the top of the window stack"
  1670.  
  1671. function{1} Raise(argv[argc])
  1672.    abstract {
  1673.       return file
  1674.       }
  1675.    body {
  1676.       wbp w;
  1677.       int warg = 0;
  1678.       OptWindow(w);
  1679.       raiseWindow(w);
  1680.       ReturnWindow;
  1681.       }
  1682. end
  1683.  
  1684.  
  1685. "ReadImage(w, s, x, y, p) - load image file"
  1686.  
  1687. function{0,1} ReadImage(argv[argc])
  1688.    abstract {
  1689.       return integer
  1690.       }
  1691.    body {
  1692.       wbp w;
  1693.       char filename[MaxFileName + 1];
  1694.       tended char *tmp;
  1695.       int status, warg = 0;
  1696.       C_integer x, y;
  1697.       int p, r;
  1698.       struct imgdata imd;
  1699.       OptWindow(w);
  1700.  
  1701.       if (argc - warg == 0)
  1702.      runerr(103,nulldesc);
  1703.       if (!cnv:C_string(argv[warg], tmp))
  1704.      runerr(103,argv[warg]);
  1705.  
  1706.       /*
  1707.        * x and y must be integers; they default to the upper left pixel.
  1708.        */
  1709.       if (argc - warg < 2) x = -w->context->dx;
  1710.       else if (!def:C_integer(argv[warg+1], -w->context->dx, x))
  1711.          runerr(101, argv[warg+1]);
  1712.       if (argc - warg < 3) y = -w->context->dy;
  1713.       else if (!def:C_integer(argv[warg+2], -w->context->dy, y))
  1714.          runerr(101, argv[warg+2]);
  1715.  
  1716.       /*
  1717.        * p is an optional palette name.
  1718.        */
  1719.       if (argc - warg < 4 || is:null(argv[warg+3])) p = 0;
  1720.       else {
  1721.          p = palnum(&argv[warg+3]);
  1722.          if (p == -1)
  1723.             runerr(103, argv[warg+3]);
  1724.          if (p == 0)
  1725.             fail;
  1726.          }
  1727.  
  1728.       x += w->context->dx;
  1729.       y += w->context->dy;
  1730.       mystrncpy(filename, tmp, MaxFileName);   /* copy to loc that won't move*/
  1731.  
  1732.       /*
  1733.        * First try to read as a GIF file.
  1734.        * If that doesn't work, try platform-dependent image reading code.
  1735.        */
  1736.       r = readGIF(filename, p, &imd);
  1737.       if (r == Succeeded) {
  1738.          status = strimage(w, x, y, imd.width, imd.height, imd.paltbl,
  1739.                imd.data, (word)imd.width * (word)imd.height, 0);
  1740.          if (status < 0)
  1741.             r = Error;
  1742.          free((pointer)imd.paltbl);
  1743.          free((pointer)imd.data);
  1744.          }
  1745.       else if (r == Failed)
  1746.          r = readimage(w, filename, x, y, &status);
  1747.       if (r == Error)
  1748.          runerr(305);
  1749.       if (r == Failed)
  1750.          fail;
  1751.       if (status == 0)
  1752.          return nulldesc;
  1753.       else
  1754.          return C_integer (word)status;
  1755.       }
  1756. end
  1757.  
  1758.  
  1759.  
  1760. "WSync(w) - synchronize with server"
  1761.  
  1762. function{1} WSync(w)
  1763.    abstract {
  1764.       return file++null
  1765.       }
  1766.    body {
  1767.       wbp _w_;
  1768.  
  1769.       if (is:null(w)) {
  1770.      _w_ = NULL;
  1771.      }
  1772.       else if (!is:file(w)) runerr(140,w);
  1773.       else {
  1774.          if (!(BlkLoc(w)->file.status & Fs_Window))
  1775.             runerr(140,w);
  1776.          _w_ = (wbp)BlkLoc(w)->file.fd;
  1777.      }
  1778.  
  1779.       wsync(_w_);
  1780.       pollevent();
  1781.       return w;
  1782.       }
  1783. end
  1784.  
  1785.  
  1786. "TextWidth(w,s) - compute text pixel width"
  1787.  
  1788. function{1} TextWidth(argv[argc])
  1789.    abstract {
  1790.       return integer
  1791.       }
  1792.    body {
  1793.       wbp w;
  1794.       int warg=0;
  1795.       C_integer i;
  1796.       OptWindow(w);
  1797.  
  1798.       if (warg == argc) runerr(103,nulldesc);
  1799.       else if (!cnv:tmp_string(argv[warg],argv[warg]))
  1800.      runerr(103,argv[warg]);
  1801.        
  1802.       i = TEXTWIDTH(w, StrLoc(argv[warg]), StrLen(argv[warg]));
  1803.       return C_integer i;
  1804.       }
  1805. end
  1806.  
  1807.  
  1808. "Uncouple(w) - uncouple window"
  1809.  
  1810. function{1} Uncouple(w)
  1811.    abstract {
  1812.       return file
  1813.       }
  1814.    body {
  1815.       wbp _w_;
  1816.       if (!is:file(w)) runerr(140,w);
  1817.       if ((BlkLoc(w)->file.status & Fs_Window) == 0) runerr(140,w);
  1818.       if ((BlkLoc(w)->file.status & (Fs_Read|Fs_Write)) == 0) runerr(142,w);
  1819.       _w_ = (wbp)BlkLoc(w)->file.fd;
  1820.       BlkLoc(w)->file.status = Fs_Window; /* no longer open for read/write */
  1821.       free_binding(_w_);
  1822.       return w;
  1823.       }
  1824. end
  1825.  
  1826. "WAttrib(argv[]) - read/write window attributes"
  1827.  
  1828. function{*} WAttrib(argv[argc])
  1829.    abstract {
  1830.       return file++string++integer
  1831.       }
  1832.    body {
  1833.       wbp w, wsave;
  1834.       word n;
  1835.       tended struct descrip sbuf, sbuf2;
  1836.       char answer[128];
  1837.       int  pass, config = 0;
  1838.       int warg = 0;
  1839.       OptWindow(w);
  1840.  
  1841.       wsave = w;
  1842.       /*
  1843.        * Loop through the arguments.
  1844.        */
  1845.       for (pass = 1; pass <= 2; pass++) {
  1846.      w = wsave;
  1847.      if (config && pass == 2) {
  1848.         if (do_config(w, config) == Failed) fail;
  1849.         }
  1850.          for (n = warg; n < argc; n++) {
  1851.             if (is:file(argv[n])) {/* Current argument is a file */
  1852.                /*
  1853.                 * Switch the current file to the file named by the
  1854.                 *  current argument providing it is a file.  argv[n]
  1855.                 *  is made to be a empty string to avoid a special case.
  1856.                 */
  1857.                if (!(BlkLoc(argv[n])->file.status & Fs_Window))
  1858.                   runerr(140,argv[n]);
  1859.                w = (wbp)BlkLoc(argv[n])->file.fd;
  1860.            if (config && pass == 2) {
  1861.           if (do_config(w, config) == Failed) fail;
  1862.           }
  1863.                }
  1864.             else {    /* Current argument should be a string */
  1865.            /*
  1866.         * In pass 1, a null argument is an error; failed attribute
  1867.         *  assignments are turned into null descriptors for pass 2
  1868.         *  and are ignored.
  1869.         */
  1870.                if (is:null(argv[n])) {
  1871.           if (pass == 2)
  1872.              continue;
  1873.           else runerr(109, argv[n]);
  1874.           }
  1875.                /*
  1876.                 * If its an integer or real, it can't be a valid attribute.
  1877.                 */
  1878.            if (is:integer(argv[n]) || is:real(argv[n])) {
  1879.           runerr(145, argv[n]);
  1880.           }
  1881.                /*
  1882.                 * Convert the argument to a string
  1883.                 */
  1884.                if (!cnv:tmp_string(argv[n], sbuf)) 
  1885.                   runerr(109, argv[n]);
  1886.                /*
  1887.                 * Read/write the attribute
  1888.                 */
  1889.                if ((pass == 1) && strnchr(StrLoc(sbuf), '=', StrLen(sbuf))) {
  1890.                   /*
  1891.                    * pass 1: perform attribute assignments
  1892.                    */
  1893.                   switch (wattrib(w, StrLoc(sbuf), StrLen(sbuf),
  1894.                   &sbuf2, answer)) {
  1895.              case Failed:
  1896.                 /*
  1897.              * Mark the attribute so we don't produce a result
  1898.              */
  1899.                 argv[n] = nulldesc;
  1900.                 continue;
  1901.              case Error: runerr(0, argv[n]);
  1902.              }
  1903.           if (StrLen(sbuf) > 4) {
  1904.              if (!strncmp(StrLoc(sbuf), "pos=", 4)) config |= 1;
  1905.              if (StrLen(sbuf) > 5) {
  1906.             if (!strncmp(StrLoc(sbuf), "posx=", 5)) config |= 1;
  1907.             if (!strncmp(StrLoc(sbuf), "posy=", 5)) config |= 1;
  1908.             if (!strncmp(StrLoc(sbuf), "rows=", 5)) config |= 2;
  1909.             if (!strncmp(StrLoc(sbuf), "size=", 5)) config |= 2;
  1910.             if (StrLen(sbuf) > 6) {
  1911.                if (!strncmp(StrLoc(sbuf), "width=", 6))
  1912.                   config |= 2;
  1913.                if (!strncmp(StrLoc(sbuf), "lines=", 6))
  1914.                   config |= 2;
  1915.                if (StrLen(sbuf) > 7) {
  1916.                   if (!strncmp(StrLoc(sbuf), "height=", 7))
  1917.                  config |= 2;
  1918.                   if (!strncmp(StrLoc(sbuf), "resize=", 7))
  1919.                  config |= 2;
  1920.                   if (StrLen(sbuf) > 8) {
  1921.                  if (!strncmp(StrLoc(sbuf), "columns=", 8))
  1922.                     config |= 2;
  1923.                  if (StrLen(sbuf) > 9) {
  1924.                     if (!strncmp(StrLoc(sbuf), "geometry=", 9))
  1925.                        config |= 3;
  1926.                     }
  1927.                  }
  1928.                   }
  1929.                }
  1930.             }
  1931.              }
  1932.                   }
  1933.            /*
  1934.         * pass 2: perform attribute queries, suspend result(s)
  1935.         */
  1936.                else if (pass==2) {
  1937.           char *stmp;
  1938.           /*
  1939.            * Turn assignments into queries.
  1940.            */
  1941.           if (stmp = strnchr(StrLoc(sbuf),'=',StrLen(sbuf)))
  1942.              StrLen(sbuf) = stmp - StrLoc(sbuf);
  1943.  
  1944.           switch (wattrib(w, StrLoc(sbuf), StrLen(sbuf),
  1945.                   &sbuf2, answer)) {
  1946.           case Failed: continue;
  1947.           case Error:  runerr(0, argv[n]);
  1948.              }
  1949.           if (is:string(sbuf2))
  1950.              Protect(StrLoc(sbuf2) = alcstr(StrLoc(sbuf2),StrLen(sbuf2)), runerr(0));
  1951.                   suspend sbuf2;
  1952.                   }
  1953.                }
  1954.             }
  1955.      }
  1956.       fail;
  1957.       }
  1958. end
  1959.  
  1960.  
  1961. "WDefault(w,program,option) - get a default value from the environment"
  1962.  
  1963. function{0,1} WDefault(argv[argc])
  1964.    abstract {
  1965.       return string
  1966.       }
  1967.    body {
  1968.       wbp w;
  1969.       int warg = 0;
  1970.       long l;
  1971.       tended char *prog, *opt;
  1972.       char sbuf1[MaxCvtLen];
  1973.       OptWindow(w);
  1974.  
  1975.       if (argc-warg < 2)
  1976.          runerr(103);
  1977.       if (!cnv:C_string(argv[warg],prog))
  1978.          runerr(103,argv[warg]);
  1979.       if (!cnv:C_string(argv[warg+1],opt))
  1980.          runerr(103,argv[warg+1]);
  1981.  
  1982.       if (getdefault(w, prog, opt, sbuf1) == Failed) fail;
  1983.       l = strlen(sbuf1);
  1984.       Protect(prog = alcstr(sbuf1,l),runerr(0));
  1985.       return string(l,prog);
  1986.       }
  1987. end
  1988.  
  1989.  
  1990. "WFlush(w) - flush all output to window w"
  1991.  
  1992. function{1} WFlush(argv[argc])
  1993.    abstract {
  1994.       return file
  1995.       }
  1996.    body {
  1997.       wbp w;
  1998.       int warg = 0;
  1999.       OptWindow(w);
  2000.       wflush(w);
  2001.       ReturnWindow;
  2002.       }
  2003. end
  2004.  
  2005.  
  2006. "WriteImage(w,filename,x,y,width,height) - write an image to a file"
  2007.  
  2008. function{0,1} WriteImage(argv[argc])
  2009.    abstract {
  2010.       return file
  2011.       }
  2012.    body {
  2013.       wbp w;
  2014.       int r;
  2015.       C_integer x, y, width, height, warg = 0;
  2016.       tended char *s;
  2017.       OptWindow(w);
  2018.  
  2019.       if (argc - warg == 0)
  2020.          runerr(103, nulldesc);
  2021.       else if (!cnv:C_string(argv[warg], s))
  2022.          runerr(103, argv[warg]);
  2023.  
  2024.       r = rectargs(w, argc, argv, warg + 1, &x, &y, &width, &height);
  2025.       if (r >= 0)
  2026.          runerr(101, argv[r]);
  2027.  
  2028.       /*
  2029.        * clip image to window, and fail if zero-sized.
  2030.        */
  2031.       if (x < 0)  x = 0;
  2032.       if (y < 0)  y = 0;
  2033.       if (x + width > w->window->width)    width = w->window->width - x;
  2034.       if (y + height > w->window->height)  height = w->window->height - y;
  2035.       if (width <= 0 || height <= 0)
  2036.      fail;
  2037.  
  2038.       /*
  2039.        * try platform-dependent code first; it will reject the call
  2040.        * if the file name s does not specify a platform-dependent format.
  2041.        */
  2042.       r = dumpimage(w, s, x, y, width, height);
  2043.       if (r == NoCvt)
  2044.          r = writeGIF(w, s, x, y, width, height);
  2045.       if (r != Succeeded)
  2046.          fail;
  2047.       ReturnWindow;
  2048.       }
  2049. end
  2050.  
  2051. #else                    /* Graphics */
  2052. static char x;            /* avoid empty module */
  2053. #endif                    /* Graphics */
  2054.