home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / src / runtime / fwindow.r < prev    next >
Text File  |  2001-12-12  |  66KB  |  2,723 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, tmp);
  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)+1), 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,"%ld,%ld,%ld", 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.       wbp wb, wb_new;
  366.       wsp ws;
  367.  
  368.       /*
  369.        * make the new binding
  370.        */
  371.       Protect(wb_new = alc_wbinding(), runerr(0));
  372.  
  373.       /*
  374.        * if w is a file, then we bind to an existing window
  375.        */
  376.       if (is:file(w) && (BlkLoc(w)->file.status & Fs_Window)) {
  377.      wb = (wbp)(BlkLoc(w)->file.fd);
  378.      wb_new->window = ws = wb->window;
  379.      if (is:file(w2) && (BlkLoc(w2)->file.status & Fs_Window)) {
  380.         /*
  381.          * Bind an existing window to an existing context,
  382.          * and up the context's reference count.
  383.          */
  384.         if (rebind(wb_new, (wbp)(BlkLoc(w2)->file.fd)) == Failed) fail;
  385.         wb_new->context->refcount++;
  386.         }
  387.      else
  388.         runerr(140, w2);
  389.  
  390.      /* bump up refcount to ws */
  391.      ws->refcount++;
  392.      }
  393.       else
  394.      runerr(140, w);
  395.  
  396.       Protect(BlkLoc(result) =
  397.      (union block *)alcfile((FILE *)wb_new,    Fs_Window|Fs_Read|Fs_Write,
  398.                 &emptystr),runerr(0));
  399.       result.dword = D_File;
  400.       return result;
  401.       }
  402. end
  403.  
  404. /*
  405.  * DrawArc(w, x1, y1, width1, height1, angle11, angle21,...)
  406.  */
  407. "DrawArc(argv[]){1} - draw arc"
  408.  
  409. function{1} DrawArc(argv[argc])
  410.    abstract {
  411.       return file
  412.       }
  413.    body {
  414.       wbp w;
  415.       int i, j, r, warg = 0;
  416.       XArc arcs[MAXXOBJS];
  417.       C_integer x, y, width, height;
  418.       double a1, a2;
  419.  
  420.       OptWindow(w);
  421.       j = 0;
  422.       for (i = warg; i < argc || i == warg; i += 6) {
  423.          if (j == MAXXOBJS) {
  424.             drawarcs(w, arcs, MAXXOBJS);
  425.             j = 0;
  426.             }
  427.          r = rectargs(w, argc, argv, i, &x, &y, &width, &height);
  428.          if (r >= 0)
  429.             runerr(101, argv[r]);
  430.  
  431.          arcs[j].x = x;
  432.          arcs[j].y = y;
  433.          ARCWIDTH(arcs[j]) = width;
  434.          ARCHEIGHT(arcs[j]) = height;
  435.  
  436.      /*
  437.       * Angle 1 processing.  Computes in radians and 64'ths of a degree,
  438.       *  bounds checks, and handles wraparound.
  439.       */
  440.          if (i + 4 >= argc || is:null(argv[i + 4]))
  441.         a1 = 0.0;
  442.          else {
  443.             if (!cnv:C_double(argv[i + 4], a1))
  444.                runerr(102, argv[i + 4]);
  445.             if (a1 >= 0.0)
  446.                a1 = fmod(a1, 2 * Pi);
  447.             else
  448.                a1 = -fmod(-a1, 2 * Pi);
  449.             }
  450.      /*
  451.       * Angle 2 processing
  452.       */
  453.          if (i + 5 >= argc || is:null(argv[i + 5]))
  454.         a2 = 2 * Pi;
  455.          else {
  456.             if (!cnv:C_double(argv[i + 5], a2))
  457.                runerr(102, argv[i + 5]);
  458.             if (fabs(a2) > 3 * Pi)
  459.                runerr(101, argv[i + 5]);
  460.             }
  461.          if (fabs(a2) >= 2 * Pi) {
  462.         a2 = 2 * Pi;
  463.         }
  464.          else {
  465.             if (a2 < 0.0) {
  466.                a1 += a2;
  467.                a2 = fabs(a2);
  468.                }
  469.             }
  470.          if (a1 < 0.0)
  471.             a1 = 2 * Pi - fmod(fabs(a1), 2 * Pi);
  472.          else
  473.             a1 = fmod(a1, 2 * Pi);
  474.          arcs[j].angle1 = ANGLE(a1);
  475.          arcs[j].angle2 = EXTENT(a2);
  476.  
  477.          j++;
  478.          }
  479.  
  480.       drawarcs(w, arcs, j);
  481.       ReturnWindow;
  482.       }
  483. end
  484.  
  485. /*
  486.  * DrawCircle(w, x1, y1, r1, angle11, angle21, ...)
  487.  */
  488. "DrawCircle(argv[]){1} - draw circle"
  489.  
  490. function{1} DrawCircle(argv[argc])
  491.    abstract {
  492.       return file
  493.       }
  494.    body {
  495.       wbp w;
  496.       int warg = 0, r;
  497.  
  498.       OptWindow(w);
  499.       r = docircles(w, argc - warg, argv + warg, 0);
  500.       if (r < 0)
  501.          ReturnWindow;
  502.       else if (r >= argc - warg)
  503.          runerr(146);
  504.       else
  505.          runerr(102, argv[warg + r]);
  506.       }
  507. end
  508.  
  509. /*
  510.  * DrawCurve(w,x1,y1,...xN,yN)
  511.  *  Draw a smooth curve through the given points.
  512.  */
  513. "DrawCurve(argv[]){1} - draw curve"
  514.  
  515. function{1} DrawCurve(argv[argc])
  516.    abstract {
  517.       return file
  518.       }
  519.    body {
  520.       wbp w;
  521.       int i, n, closed = 0, warg = 0;
  522.       C_integer dx, dy, x0, y0, xN, yN;
  523.       XPoint *points;
  524.  
  525.       OptWindow(w);
  526.       CheckArgMultiple(2);
  527.  
  528.       dx = w->context->dx;
  529.       dy = w->context->dy;
  530.  
  531.       Protect(points = (XPoint *)malloc(sizeof(XPoint) * (n+2)), runerr(305));
  532.  
  533.       if (n > 1) {
  534.      CnvCInteger(argv[warg], x0)
  535.      CnvCInteger(argv[warg + 1], y0)
  536.      CnvCInteger(argv[argc - 2], xN)
  537.      CnvCInteger(argv[argc - 1], yN)
  538.          if ((x0 == xN) && (y0 == yN)) {
  539.             closed = 1;               /* duplicate the next to last point */
  540.         CnvCShort(argv[argc-4], points[0].x);
  541.         CnvCShort(argv[argc-3], points[0].y);
  542.         points[0].x += w->context->dx;
  543.         points[0].y += w->context->dy;
  544.             }
  545.          else {                       /* duplicate the first point */
  546.         CnvCShort(argv[warg], points[0].x);
  547.         CnvCShort(argv[warg + 1], points[0].y);
  548.         points[0].x += w->context->dx;
  549.         points[0].y += w->context->dy;
  550.             }
  551.          for (i = 1; i <= n; i++) {
  552.         int base = warg + (i-1) * 2;
  553.             CnvCShort(argv[base], points[i].x);
  554.             CnvCShort(argv[base + 1], points[i].y);
  555.         points[i].x += dx;
  556.         points[i].y += dy;
  557.             }
  558.          if (closed) {                /* duplicate the second point */
  559.             points[i] = points[2];
  560.             }
  561.          else {                       /* duplicate the last point */
  562.             points[i] = points[i-1];
  563.             }
  564.      if (n < 3) {
  565.         drawlines(w, points+1, n);
  566.         }
  567.      else {
  568.         drawCurve(w, points, n+2);
  569.         }
  570.          }
  571.       free(points);
  572.       ReturnWindow;
  573.       }
  574. end
  575.  
  576.  
  577. "DrawImage(w,x,y,s) - draw bitmapped figure"
  578.  
  579. function{0,1} DrawImage(argv[argc])
  580.    abstract {
  581.       return null++integer
  582.       }
  583.    body {
  584.       wbp w;
  585.       int warg = 0;
  586.       int c, i, width, height, row, p;
  587.       C_integer x, y;
  588.       word nchars;
  589.       unsigned char *s, *t, *z;
  590.       struct descrip d;
  591.       struct palentry *e;
  592.       OptWindow(w);
  593.  
  594.       /*
  595.        * X or y can be defaulted but s is required.
  596.        * Validate x/y first so that the error message makes more sense.
  597.        */
  598.       if (argc - warg >= 1 && !def:C_integer(argv[warg], -w->context->dx, x))
  599.          runerr(101, argv[warg]);
  600.       if (argc - warg >= 2 && !def:C_integer(argv[warg + 1], -w->context->dy, y))
  601.          runerr(101, argv[warg + 1]);
  602.       if (argc - warg < 3)
  603.          runerr(103);            /* missing s */
  604.       if (!cnv:tmp_string(argv[warg+2], d))
  605.          runerr(103, argv[warg + 2]);
  606.  
  607.       x += w->context->dx;
  608.       y += w->context->dy;
  609.       /*
  610.        * Extract the Width and skip the following comma.
  611.        */
  612.       s = (unsigned char *)StrLoc(d);
  613.       z = s + StrLen(d);        /* end+1 of string */
  614.       width = 0;
  615.       while (s < z && *s == ' ')    /* skip blanks */
  616.      s++;
  617.       while (s < z && isdigit(*s))    /* scan number */
  618.          width = 10 * width + *s++ - '0';
  619.       while (s < z && *s == ' ')    /* skip blanks */
  620.      s++;
  621.       if (width == 0 || *s++ != ',')    /* skip comma */
  622.          fail;
  623.       while (s < z && *s == ' ')    /* skip blanks */
  624.      s++;
  625.       if (s >= z)            /* if end of string */
  626.      fail;
  627.  
  628.       /*
  629.        * Check for a bilevel format.
  630.        */
  631.       if ((c = *s) == '#' || c == '~') {
  632.          s++;
  633.          nchars = 0;
  634.          for (t = s; t < z; t++)
  635.             if (isxdigit(*t))
  636.                nchars++;            /* count hex digits */
  637.             else if (*t != PCH1 && *t != PCH2)
  638.                fail;                /* illegal punctuation */
  639.          if (nchars == 0)
  640.             fail;
  641.          row = (width + 3) / 4;            /* digits per row */
  642.          if (nchars % row != 0)
  643.             fail;
  644.          height = nchars / row;
  645.          if (blimage(w, x, y, width, height, c, s, (word)(z - s)) == Error)
  646.             runerr(305);
  647.          else
  648.             return nulldesc;
  649.          }
  650.  
  651.       /*
  652.        * Extract the palette name and skip its comma.
  653.        */
  654.       c = *s++;                    /* save initial character */
  655.       p = 0;
  656.       while (s < z && isdigit(*s))        /* scan digits */
  657.          p = 10 * p + *s++ - '0';
  658.       while (s < z && *s == ' ')        /* skip blanks */
  659.      s++;
  660.       if (s >= z || p == 0 || *s++ != ',')    /* skip comma */
  661.          fail;
  662.       if (c == 'g' && p >= 2 && p <= 256)    /* validate grayscale number */
  663.          p = -p;
  664.       else if (c != 'c' || p < 1 || p > 6)    /* validate color number */
  665.          fail;
  666.  
  667.       /*
  668.        * Scan the image to see which colors are needed.
  669.        */
  670.       e = palsetup(p);
  671.       if (e == NULL)
  672.          runerr(305);
  673.       for (i = 0; i < 256; i++)
  674.          e[i].used = 0;
  675.       nchars = 0;
  676.       for (t = s; t < z; t++) {
  677.          c = *t;
  678.          e[c].used = 1;
  679.          if (e[c].valid || e[c].transpt)
  680.             nchars++;            /* valid color, or transparent */
  681.          else if (c != PCH1 && c != PCH2)
  682.             fail;
  683.          }
  684.       if (nchars == 0)
  685.          fail;                    /* empty image */
  686.       if (nchars % width != 0)
  687.          fail;                    /* not rectangular */
  688.  
  689.       /*
  690.        * Call platform-dependent code to draw the image.
  691.        */
  692.       height = nchars / width;
  693.       i = strimage(w, x, y, width, height, e, s, (word)(z - s), 0);
  694.       if (i == 0)
  695.          return nulldesc;
  696.       else if (i < 0)
  697.          runerr(305);
  698.       else
  699.          return C_integer i;
  700.       }
  701. end
  702.  
  703. /*
  704.  * DrawLine(w,x1,y1,...xN,yN)
  705.  */
  706. "DrawLine(argv[]){1} - draw line"
  707.  
  708. function{1} DrawLine(argv[argc])
  709.    abstract {
  710.       return file
  711.       }
  712.    body {
  713.       wbp w;
  714.       int i, j, n, warg = 0;
  715.       XPoint points[MAXXOBJS];
  716.       int dx, dy;
  717.  
  718.       OptWindow(w);
  719.       CheckArgMultiple(2);
  720.  
  721.       dx = w->context->dx;
  722.       dy = w->context->dy;
  723.       for(i=0, j=0;i<n;i++, j++) {
  724.      int base = warg + i * 2;
  725.          if (j==MAXXOBJS) {
  726.         drawlines(w, points, MAXXOBJS);
  727.         points[0] = points[MAXXOBJS-1];
  728.         j = 1;
  729.             }
  730.          CnvCShort(argv[base], points[j].x);
  731.          CnvCShort(argv[base + 1], points[j].y);
  732.      points[j].x += dx;
  733.      points[j].y += dy;
  734.          }
  735.       drawlines(w, points, j);
  736.       ReturnWindow;
  737.       }
  738. end
  739.  
  740. /*
  741.  * DrawPoint(w, x1, y1, ...xN, yN)
  742.  */
  743. "DrawPoint(argv[]){1} - draw point"
  744.  
  745. function{1} DrawPoint(argv[argc])
  746.    abstract {
  747.       return file
  748.       }
  749.    body {
  750.       wbp w;
  751.       int i, j, n, warg = 0;
  752.       XPoint points[MAXXOBJS];
  753.       int dx, dy;
  754.  
  755.       OptWindow(w);
  756.       CheckArgMultiple(2);
  757.  
  758.       dx = w->context->dx;
  759.       dy = w->context->dy;
  760.       for(i=0, j=0; i < n; i++, j++) {
  761.      int base = warg + i * 2;
  762.          if (j == MAXXOBJS) {
  763.         drawpoints(w, points, MAXXOBJS);
  764.             j = 0;
  765.             }
  766.          CnvCShort(argv[base], points[j].x);
  767.          CnvCShort(argv[base + 1], points[j].y);
  768.      points[j].x += dx;
  769.      points[j].y += dy;
  770.        }
  771.       drawpoints(w, points, j);
  772.       ReturnWindow;
  773.       }
  774. end
  775.  
  776. /*
  777.  * DrawPolygon(w,x1,y1,...xN,yN)
  778.  */
  779. "DrawPolygon(argv[]){1} - draw polygon"
  780.  
  781. function{1} DrawPolygon(argv[argc])
  782.    abstract {
  783.       return file
  784.       }
  785.    body {
  786.       wbp w;
  787.       int i, j, n, base, dx, dy, warg = 0;
  788.       XPoint points[MAXXOBJS];
  789.  
  790.       OptWindow(w);
  791.       CheckArgMultiple(2);
  792.  
  793.       dx = w->context->dx;
  794.       dy = w->context->dy;
  795.  
  796.       /*
  797.        * To make a closed polygon, start with the *last* point.
  798.        */
  799.       CnvCShort(argv[argc - 2], points[0].x);
  800.       CnvCShort(argv[argc - 1], points[0].y);
  801.       points[0].x += dx;
  802.       points[0].y += dy;
  803.  
  804.       /*
  805.        * Now add all points from beginning to end, including last point again.
  806.        */
  807.       for(i = 0, j = 1; i < n; i++, j++) {
  808.          base = warg + i * 2;
  809.          if (j == MAXXOBJS) {
  810.             drawlines(w, points, MAXXOBJS);
  811.             points[0] = points[MAXXOBJS-1];
  812.             j = 1;
  813.             }
  814.          CnvCShort(argv[base], points[j].x);
  815.          CnvCShort(argv[base + 1], points[j].y);
  816.          points[j].x += dx;
  817.          points[j].y += dy;
  818.          }
  819.       drawlines(w, points, j);
  820.       ReturnWindow;
  821.       }
  822. end
  823.  
  824. /*
  825.  * DrawRectangle(w, x1, y1, width1, height1, ..., xN, yN, widthN,heightN)
  826.  */
  827. "DrawRectangle(argv[]){1} - draw rectangle"
  828.  
  829. function{1} DrawRectangle(argv[argc])
  830.    abstract {
  831.       return file
  832.       }
  833.    body {
  834.       wbp w;
  835.       int i, j, r, warg = 0;
  836.       XRectangle recs[MAXXOBJS];
  837.       C_integer x, y, width, height;
  838.  
  839.       OptWindow(w);
  840.       j = 0;
  841.  
  842.       for (i = warg; i < argc || i == warg; i += 4) {
  843.          r = rectargs(w, argc, argv, i, &x, &y, &width, &height);
  844.          if (r >= 0)
  845.             runerr(101, argv[r]);
  846.          if (j == MAXXOBJS) {
  847.             drawrectangles(w,recs,MAXXOBJS);
  848.             j = 0;
  849.             }
  850.          RECX(recs[j]) = x;
  851.          RECY(recs[j]) = y;
  852.          RECWIDTH(recs[j]) = width;
  853.          RECHEIGHT(recs[j]) = height;
  854.          j++;
  855.          }
  856.  
  857.       drawrectangles(w, recs, j);
  858.       ReturnWindow;
  859.       }
  860. end
  861.  
  862. /*
  863.  * DrawSegment(x11,y11,x12,y12,...,xN1,yN1,xN2,yN2)
  864.  */
  865. "DrawSegment(argv[]){1} - draw line segment"
  866.  
  867. function{1} DrawSegment(argv[argc])
  868.    abstract {
  869.       return file
  870.       }
  871.    body {
  872.       wbp w;
  873.       int i, j, n, warg = 0, dx, dy;
  874.       XSegment segs[MAXXOBJS];
  875.  
  876.       OptWindow(w);
  877.       CheckArgMultiple(4);
  878.  
  879.       dx = w->context->dx;
  880.       dy = w->context->dy;
  881.       for(i=0, j=0; i < n; i++, j++) {
  882.      int base = warg + i * 4;
  883.          if (j == MAXXOBJS) {
  884.         drawsegments(w, segs, MAXXOBJS);
  885.             j = 0;
  886.             }
  887.          CnvCShort(argv[base], segs[j].x1);
  888.          CnvCShort(argv[base + 1], segs[j].y1);
  889.          CnvCShort(argv[base + 2], segs[j].x2);
  890.          CnvCShort(argv[base + 3], segs[j].y2);
  891.      segs[j].x1 += dx;
  892.      segs[j].x2 += dx;
  893.      segs[j].y1 += dy;
  894.      segs[j].y2 += dy;
  895.          }
  896.       drawsegments(w, segs, j);
  897.       ReturnWindow;
  898.       }
  899. end
  900.  
  901. /*
  902.  * DrawString(w, x1, y1, s1, ..., xN, yN, sN)
  903.  */
  904. "DrawString(argv[]){1} - draw text"
  905.  
  906. function{1} DrawString(argv[argc])
  907.    abstract {
  908.       return file
  909.       }
  910.    body {
  911.       wbp w;
  912.       int i, n, len, warg = 0;
  913.       char *s;
  914.  
  915.       OptWindow(w);
  916.       CheckArgMultiple(3);
  917.  
  918.       for(i=0; i < n; i++) {
  919.          C_integer x, y;
  920.      int base = warg + i * 3;
  921.          CnvCInteger(argv[base], x);
  922.          CnvCInteger(argv[base + 1], y);
  923.      x += w->context->dx;
  924.      y += w->context->dy;
  925.          CnvTmpString(argv[base + 2], argv[base + 2]);
  926.      s = StrLoc(argv[base + 2]);
  927.      len = StrLen(argv[base + 2]);
  928.      drawstrng(w, x, y, s, len);
  929.          }
  930.       ReturnWindow;
  931.       }
  932. end
  933.  
  934.  
  935. "EraseArea(w,x,y,width,height) - clear an area of the window"
  936.  
  937. function{1} EraseArea(argv[argc])
  938.    abstract {
  939.       return file
  940.       }
  941.    body {
  942.       wbp w;
  943.       int warg = 0, i, r;
  944.       C_integer x, y, width, height;
  945.       OptWindow(w);
  946.  
  947.       for (i = warg; i < argc || i == warg; i += 4) {
  948.          r = rectargs(w, argc, argv, i, &x, &y, &width, &height);
  949.          if (r >= 0)
  950.             runerr(101, argv[r]);
  951.          eraseArea(w, x, y, width, height);
  952.          }
  953.  
  954.       ReturnWindow;
  955.       }
  956. end
  957.  
  958.  
  959. "Event(w) - return an event from a window"
  960.  
  961. function{1} Event(argv[argc])
  962.    abstract {
  963.       return string ++ integer
  964.       }
  965.    body {
  966.       wbp w;
  967.       C_integer i;
  968.       tended struct descrip d;
  969.       int warg = 0;
  970.       OptWindow(w);
  971.  
  972.       d = nulldesc;
  973.       i = wgetevent(w, &d);
  974.       if (i == 0) {
  975.          if (is:file(kywd_xwin[XKey_Window]) &&
  976.                w == (wbp)BlkLoc(kywd_xwin[XKey_Window])->file.fd)
  977.         lastEventWin = kywd_xwin[XKey_Window];
  978.      else
  979.         lastEventWin = argv[warg-1];
  980.          lastEvFWidth = FWIDTH((wbp)BlkLoc(lastEventWin)->file.fd);
  981.          lastEvLeading = LEADING((wbp)BlkLoc(lastEventWin)->file.fd);
  982.          lastEvAscent = ASCENT((wbp)BlkLoc(lastEventWin)->file.fd);
  983.      return d;
  984.      }
  985.       else if (i == -1)
  986.      runerr(141);
  987.       else
  988.      runerr(143);
  989.       }
  990. end
  991.  
  992.  
  993. "Fg(w,s) - foreground color"
  994.  
  995. function{0,1} Fg(argv[argc])
  996.    abstract {
  997.       return string
  998.       }
  999.    body {
  1000.       wbp w;
  1001.       char sbuf1[MaxCvtLen];
  1002.       int len;
  1003.       tended char *tmp;
  1004.       int warg = 0;
  1005.       OptWindow(w);
  1006.  
  1007.       /*
  1008.        * If there is a (non-window) argument we are setting by
  1009.        *  either a mutable color (negative int) or a string name.
  1010.        */
  1011.       if (argc - warg > 0) {
  1012.      if (is:integer(argv[warg])) {    /* mutable color or packed RGB */
  1013.         if (isetfg(w, IntVal(argv[warg])) == Failed) fail;
  1014.         }
  1015.      else {
  1016.         if (!cnv:C_string(argv[warg], tmp))
  1017.            runerr(103,argv[warg]);
  1018.         if(setfg(w, tmp) == Failed) fail;
  1019.         }
  1020.          }
  1021.  
  1022.       /*
  1023.        * In any case, this function returns the current foreground color.
  1024.        */
  1025.       getfg(w, sbuf1);
  1026.       len = strlen(sbuf1);
  1027.       Protect(tmp = alcstr(sbuf1, len), runerr(0));
  1028.       return string(len, tmp);
  1029.       }
  1030. end
  1031.  
  1032. /*
  1033.  * FillArc(w, x1, y1, width1, height1, angle11, angle21,...)
  1034.  */
  1035. "FillArc(argv[]){1} - fill arc"
  1036.  
  1037. function{1} FillArc(argv[argc])
  1038.    abstract {
  1039.       return file
  1040.       }
  1041.    body {
  1042.       wbp w;
  1043.       int i, j, r, warg = 0;
  1044.       XArc arcs[MAXXOBJS];
  1045.       C_integer x, y, width, height;
  1046.       double a1, a2;
  1047.  
  1048.       OptWindow(w);
  1049.       j = 0;
  1050.       for (i = warg; i < argc || i == warg; i += 6) {
  1051.          if (j == MAXXOBJS) {
  1052.             fillarcs(w, arcs, MAXXOBJS);
  1053.             j = 0;
  1054.             }
  1055.          r = rectargs(w, argc, argv, i, &x, &y, &width, &height);
  1056.          if (r >= 0)
  1057.             runerr(101, argv[r]);
  1058.  
  1059.          arcs[j].x = x;
  1060.          arcs[j].y = y;
  1061.          ARCWIDTH(arcs[j]) = width;
  1062.          ARCHEIGHT(arcs[j]) = height;
  1063.  
  1064.          if (i + 4 >= argc || is:null(argv[i + 4])) {
  1065.             a1 = 0.0;
  1066.         }
  1067.          else {
  1068.             if (!cnv:C_double(argv[i + 4], a1))
  1069.                runerr(102, argv[i + 4]);
  1070.             if (a1 >= 0.0)
  1071.                a1 = fmod(a1, 2 * Pi);
  1072.             else
  1073.                a1 = -fmod(-a1, 2 * Pi);
  1074.             }
  1075.          if (i + 5 >= argc || is:null(argv[i + 5]))
  1076.         a2 = 2 * Pi;
  1077.          else {
  1078.             if (!cnv:C_double(argv[i + 5], a2))
  1079.                runerr(102, argv[i + 5]);
  1080.             if (fabs(a2) > 3 * Pi)
  1081.                runerr(101, argv[i + 5]);
  1082.             }
  1083.          if (fabs(a2) >= 2 * Pi) {
  1084.         a2 = 2 * Pi;
  1085.         }
  1086.          else {
  1087.             if (a2 < 0.0) {
  1088.                a1 += a2;
  1089.                a2 = fabs(a2);
  1090.                }
  1091.             }
  1092.          arcs[j].angle2 = EXTENT(a2);
  1093.          if (a1 < 0.0)
  1094.             a1 = 2 * Pi - fmod(fabs(a1), 2 * Pi);
  1095.          else
  1096.            a1 = fmod(a1, 2 * Pi);
  1097.          arcs[j].angle1 = ANGLE(a1);
  1098.  
  1099.          j++;
  1100.          }
  1101.  
  1102.       fillarcs(w, arcs, j);
  1103.       ReturnWindow;
  1104.       }
  1105. end
  1106.  
  1107. /*
  1108.  * FillCircle(w, x1, y1, r1, angle11, angle21, ...)
  1109.  */
  1110. "FillCircle(argv[]){1} - draw filled circle"
  1111.  
  1112. function{1} FillCircle(argv[argc])
  1113.    abstract {
  1114.       return file
  1115.       }
  1116.    body {
  1117.       wbp w;
  1118.       int warg = 0, r;
  1119.  
  1120.       OptWindow(w);
  1121.       r = docircles(w, argc - warg, argv + warg, 1);
  1122.       if (r < 0)
  1123.          ReturnWindow;
  1124.       else if (r >= argc - warg)
  1125.          runerr(146);
  1126.       else
  1127.          runerr(102, argv[warg + r]);
  1128.       }
  1129. end
  1130.  
  1131. /*
  1132.  * FillPolygon(w, x1, y1, ...xN, yN)
  1133.  */
  1134. "FillPolygon(argv[]){1} - fill polygon"
  1135.  
  1136. function{1} FillPolygon(argv[argc])
  1137.    abstract {
  1138.       return file
  1139.       }
  1140.    body {
  1141.       wbp w;
  1142.       int i, n, warg = 0;
  1143.       XPoint *points;
  1144.       int dx, dy;
  1145.  
  1146.       OptWindow(w);
  1147.  
  1148.       CheckArgMultiple(2)
  1149.  
  1150.       /*
  1151.        * Allocate space for all the points in a contiguous array,
  1152.        * because a FillPolygon must be performed in a single call.
  1153.        */
  1154.       n = argc>>1;
  1155.       Protect(points = (XPoint *)malloc(sizeof(XPoint) * n), runerr(305));
  1156.       dx = w->context->dx;
  1157.       dy = w->context->dy;
  1158.       for(i=0; i < n; i++) {
  1159.      int base = warg + i * 2;
  1160.          CnvCShort(argv[base], points[i].x);
  1161.          CnvCShort(argv[base + 1], points[i].y);
  1162.      points[i].x += dx;
  1163.          points[i].y += dy;
  1164.          }
  1165.       fillpolygon(w, points, n);
  1166.       free(points);
  1167.       ReturnWindow;
  1168.       }
  1169. end
  1170.  
  1171. /*
  1172.  * FillRectangle(w, x1, y1, width1, height1,...,xN, yN, widthN, heightN)
  1173.  */
  1174. "FillRectangle(argv[]){1} - draw filled rectangle"
  1175.  
  1176. function{1} FillRectangle(argv[argc])
  1177.    abstract {
  1178.       return file
  1179.       }
  1180.    body {
  1181.       wbp w;
  1182.       int i, j, r, warg = 0;
  1183.       XRectangle recs[MAXXOBJS];
  1184.       C_integer x, y, width, height;
  1185.  
  1186.       OptWindow(w);
  1187.       j = 0;
  1188.  
  1189.       for (i = warg; i < argc || i == warg; i += 4) {
  1190.          r = rectargs(w, argc, argv, i, &x, &y, &width, &height);
  1191.          if (r >= 0)
  1192.             runerr(101, argv[r]);
  1193.          if (j == MAXXOBJS) {
  1194.             fillrectangles(w,recs,MAXXOBJS);
  1195.             j = 0;
  1196.             }
  1197.          RECX(recs[j]) = x;
  1198.          RECY(recs[j]) = y;
  1199.          RECWIDTH(recs[j]) = width;
  1200.          RECHEIGHT(recs[j]) = height;
  1201.          j++;
  1202.          }
  1203.  
  1204.       fillrectangles(w, recs, j);
  1205.       ReturnWindow;
  1206.       }
  1207. end
  1208.  
  1209.  
  1210.  
  1211. "Font(w,s) - get/set font"
  1212.  
  1213. function{0,1} Font(argv[argc])
  1214.    abstract {
  1215.       return string
  1216.       }
  1217.    body {
  1218.       tended char *tmp;
  1219.       int len;
  1220.       wbp w;
  1221.       int warg = 0;
  1222.       char buf[MaxCvtLen];
  1223.       OptWindow(w);
  1224.  
  1225.       if (warg < argc) {
  1226.          if (!cnv:C_string(argv[warg],tmp))
  1227.             runerr(103,argv[warg]);
  1228.          if (setfont(w,&tmp) == Failed) fail;
  1229.          }
  1230.       getfntnam(w, buf);
  1231.       len = strlen(buf);
  1232.       Protect(tmp = alcstr(buf, len), runerr(0));
  1233.       return string(len,tmp);
  1234.       }
  1235. end
  1236.  
  1237.  
  1238. "FreeColor(argv[]) - free colors"
  1239.  
  1240. function{1} FreeColor(argv[argc])
  1241.    abstract {
  1242.       return file
  1243.       }
  1244.    body {
  1245.       wbp w;
  1246.       int warg = 0;
  1247.       int i;
  1248.       C_integer n;
  1249.       tended char *s;
  1250.  
  1251.       OptWindow(w);
  1252.       if (argc - warg == 0) runerr(103);
  1253.  
  1254.       for (i = warg; i < argc; i++) {
  1255.          if (is:integer(argv[i])) {
  1256.             CnvCInteger(argv[i], n)
  1257.             if (n < 0)
  1258.                free_mutable(w, n);
  1259.             }
  1260.          else {
  1261.             if (!cnv:C_string(argv[i], s))
  1262.                runerr(103,argv[i]);
  1263.             freecolor(w, s);
  1264.             }
  1265.          }
  1266.  
  1267.       ReturnWindow;
  1268.       }
  1269.  
  1270. end
  1271.  
  1272.  
  1273. "GotoRC(w,r,c) - move cursor to a particular text row and column"
  1274.  
  1275. function{1} GotoRC(argv[argc])
  1276.    abstract {
  1277.       return file
  1278.       }
  1279.    body {
  1280.       C_integer r, c;
  1281.       wbp w;
  1282.       int warg = 0;
  1283.       OptWindow(w);
  1284.  
  1285.       if (argc - warg < 1)
  1286.      r = 1;
  1287.       else
  1288.      CnvCInteger(argv[warg], r)
  1289.       if (argc - warg < 2)
  1290.      c = 1;
  1291.       else
  1292.      CnvCInteger(argv[warg + 1], c)
  1293.  
  1294.       /*
  1295.        * turn the cursor off
  1296.        */
  1297.       hidecrsr(w->window);
  1298.  
  1299.       w->window->y = ROWTOY(w, r);
  1300.       w->window->x = COLTOX(w, c);
  1301.       w->window->x += w->context->dx;
  1302.       w->window->y += w->context->dy;
  1303.  
  1304.       /*
  1305.        * turn it back on at new location
  1306.        */
  1307.       UpdateCursorPos(w->window, w->context);
  1308.       showcrsr(w->window);
  1309.  
  1310.       ReturnWindow;
  1311.       }
  1312. end
  1313.  
  1314.  
  1315. "GotoXY(w,x,y) - move cursor to a particular pixel location"
  1316.  
  1317. function{1} GotoXY(argv[argc])
  1318.    abstract {
  1319.       return file
  1320.       }
  1321.    body {
  1322.       wbp w;
  1323.       C_integer x, y;
  1324.       int warg = 0;
  1325.       OptWindow(w);
  1326.  
  1327.       if (argc - warg < 1)
  1328.      x = 0;
  1329.       else
  1330.      CnvCInteger(argv[warg], x)
  1331.       if (argc - warg < 2)
  1332.      y = 0;
  1333.       else
  1334.      CnvCInteger(argv[warg + 1], y)
  1335.  
  1336.       x += w->context->dx;
  1337.       y += w->context->dy;
  1338.  
  1339.       hidecrsr(w->window);
  1340.  
  1341.       w->window->x = x;
  1342.       w->window->y = y;
  1343.  
  1344.       UpdateCursorPos(w->window, w->context);
  1345.       showcrsr(w->window);
  1346.  
  1347.       ReturnWindow;
  1348.       }
  1349. end
  1350.  
  1351.  
  1352. "Lower(w) - lower w to the bottom of the window stack"
  1353.  
  1354. function{1} Lower(argv[argc])
  1355.    abstract {
  1356.       return file
  1357.       }
  1358.    body {
  1359.       wbp w;
  1360.       int warg = 0;
  1361.       OptWindow(w);
  1362.       lowerWindow(w);
  1363.       ReturnWindow;
  1364.       }
  1365. end
  1366.  
  1367.  
  1368. "NewColor(w,s) - allocate an entry in the color map"
  1369.  
  1370. function{0,1} NewColor(argv[argc])
  1371.    abstract {
  1372.       return integer
  1373.       }
  1374.    body {
  1375.       wbp w;
  1376.       int rv;
  1377.       int warg = 0;
  1378.       OptWindow(w);
  1379.  
  1380.       if (mutable_color(w, argv+warg, argc-warg, &rv) == Failed) fail;
  1381.       return C_integer rv;
  1382.       }
  1383. end
  1384.  
  1385.  
  1386.  
  1387. "PaletteChars(w,p) - return the characters forming keys to palette p"
  1388.  
  1389. function{0,1} PaletteChars(argv[argc])
  1390.    abstract {
  1391.       return string
  1392.       }
  1393.    body {
  1394.       int n, warg;
  1395.       extern char c1list[], c2list[], c3list[], c4list[];
  1396.  
  1397.       if (is:file(argv[0]) && (BlkLoc(argv[0])->file.status & Fs_Window))
  1398.          warg = 1;
  1399.       else
  1400.          warg = 0;        /* window not required */
  1401.       if (argc - warg < 1)
  1402.          n = 1;
  1403.       else
  1404.          n = palnum(&argv[warg]);
  1405.       switch (n) {
  1406.          case -1:  runerr(103, argv[warg]);        /* not a string */
  1407.          case  0:  fail;                /* unrecognized */
  1408.          case  1:  return string(90, c1list);            /* c1 */
  1409.          case  2:  return string(9, c2list);            /* c2 */
  1410.          case  3:  return string(31, c3list);            /* c3 */
  1411.          case  4:  return string(73, c4list);            /* c4 */
  1412.          case  5:  return string(141, (char *)allchars);    /* c5 */
  1413.          case  6:  return string(241, (char *)allchars);    /* c6 */
  1414.          default:                    /* gn */
  1415.             if (n >= -64)
  1416.                return string(-n, c4list);
  1417.             else
  1418.                return string(-n, (char *)allchars);
  1419.          }
  1420.       }
  1421. end
  1422.  
  1423.  
  1424. "PaletteColor(w,p,s) - return color of key s in palette p"
  1425.  
  1426. function{0,1} PaletteColor(argv[argc])
  1427.    abstract {
  1428.       return string
  1429.       }
  1430.    body {
  1431.       int p, warg, len;
  1432.       char tmp[24], *s;
  1433.       struct palentry *e;
  1434.       tended struct descrip d;
  1435.  
  1436.       if (is:file(argv[0]) && (BlkLoc(argv[0])->file.status & Fs_Window))
  1437.          warg = 1;
  1438.       else
  1439.          warg = 0;            /* window not required */
  1440.       if (argc - warg < 2)
  1441.          runerr(103);
  1442.       p = palnum(&argv[warg]);
  1443.       if (p == -1)
  1444.          runerr(103, argv[warg]);
  1445.       if (p == 0)
  1446.          fail;
  1447.       if (!cnv:tmp_string(argv[warg + 1], d))
  1448.          runerr(103, argv[warg + 1]);
  1449.       if (StrLen(d) != 1)
  1450.          runerr(205, d);
  1451.       e = palsetup(p);
  1452.       if (e == NULL)
  1453.          runerr(305);
  1454.       e += *StrLoc(d) & 0xFF;
  1455.       if (!e->valid)
  1456.          fail;
  1457.       sprintf(tmp, "%ld,%ld,%ld", e->clr.red, e->clr.green, e->clr.blue);
  1458.       len = strlen(tmp);
  1459.       Protect(s = alcstr(tmp, len), runerr(306));
  1460.       return string(len, s);
  1461.       }
  1462. end
  1463.  
  1464.  
  1465. "PaletteKey(w,p,s) - return key of closest color to s in palette p"
  1466.  
  1467. function{0,1} PaletteKey(argv[argc])
  1468.    abstract {
  1469.       return string
  1470.       }
  1471.    body {
  1472.       wbp w;
  1473.       int warg = 0, p;
  1474.       C_integer n;
  1475.       tended char *s;
  1476.       long r, g, b;
  1477.  
  1478.       if (is:file(argv[0]) && (BlkLoc(argv[0])->file.status & Fs_Window)) {
  1479.          w = (wbp)BlkLoc(argv[0])->file.fd;        /* explicit window */
  1480.          warg = 1;
  1481.          }
  1482.       else if (is:file(kywd_xwin[XKey_Window]) &&
  1483.             (BlkLoc(kywd_xwin[XKey_Window])->file.status & Fs_Window))
  1484.          w = (wbp)BlkLoc(kywd_xwin[XKey_Window])->file.fd;    /* &window */
  1485.       else
  1486.          w = NULL;            /* no window (but proceed anyway) */
  1487.  
  1488.       if (argc - warg < 2)
  1489.          runerr(103);
  1490.       p = palnum(&argv[warg]);
  1491.       if (p == -1)
  1492.          runerr(103, argv[warg]);
  1493.       if (p == 0)
  1494.          fail;
  1495.  
  1496.       if (cnv:C_integer(argv[warg + 1], n)) {
  1497.          if (w == NULL || (s = get_mutable_name(w, n)) == NULL)
  1498.             fail;
  1499.          }
  1500.       else if (!cnv:C_string(argv[warg + 1], s))
  1501.          runerr(103, argv[warg + 1]);
  1502.  
  1503.       if (parsecolor(w, s, &r, &g, &b) == Succeeded)
  1504.          return string(1, rgbkey(p, r / 65535.0, g / 65535.0, b / 65535.0));
  1505.       else
  1506.          fail;
  1507.       }
  1508. end
  1509.  
  1510.  
  1511. "Pattern(w,s) - sets the context fill pattern by string name"
  1512.  
  1513. function{1} Pattern(argv[argc])
  1514.    abstract {
  1515.       return file
  1516.       }
  1517.    body {
  1518.       int warg = 0;
  1519.       wbp w;
  1520.       OptWindow(w);
  1521.  
  1522.       if (argc - warg == 0)
  1523.          runerr(103, nulldesc);
  1524.  
  1525.       if (! cnv:string(argv[warg], argv[warg]))
  1526.          runerr(103, nulldesc);
  1527.  
  1528.       switch (SetPattern(w, StrLoc(argv[warg]), StrLen(argv[warg]))) {
  1529.          case Error:
  1530.             runerr(0, argv[warg]);
  1531.          case Failed:
  1532.             fail;
  1533.          }
  1534.  
  1535.       ReturnWindow;
  1536.       }
  1537. end
  1538.  
  1539.  
  1540. "Pending(w,x[]) - produce a list of events pending on window"
  1541.  
  1542. function{0,1} Pending(argv[argc])
  1543.    abstract {
  1544.       return list
  1545.       }
  1546.    body {
  1547.       wbp w;
  1548.       int warg = 0;
  1549.       wsp ws;
  1550.       int i;
  1551.       OptWindow(w);
  1552.  
  1553.       ws = w->window;
  1554.       wsync(w);
  1555.  
  1556.       /*
  1557.        * put additional arguments to Pending on the pending list in
  1558.        * guaranteed consecutive order.
  1559.        */
  1560.       for (i = warg; i < argc; i++) {
  1561.          c_put(&(ws->listp), &argv[i]);
  1562.          }
  1563.  
  1564.       /*
  1565.        * retrieve any events that might be relevant before returning the
  1566.        * pending queue.
  1567.        */
  1568.       switch (pollevent()) {
  1569.          case -1: runerr(141);
  1570.          case 0: fail;
  1571.      }
  1572.       return ws->listp;
  1573.       }
  1574. end
  1575.  
  1576.  
  1577.  
  1578. "Pixel(w,x,y,width,height) - produce the contents of some pixels"
  1579.  
  1580. function{3} Pixel(argv[argc])
  1581.    abstract {
  1582.       return integer ++ string
  1583.       }
  1584.    body {
  1585.       struct imgmem imem;
  1586.       C_integer x, y, width, height;
  1587.       wbp w;
  1588.       int warg = 0, slen, r;
  1589.       tended struct descrip lastval;
  1590.       char strout[50];
  1591.       OptWindow(w);
  1592.  
  1593.       r = rectargs(w, argc, argv, warg, &x, &y, &width, &height);
  1594.       if (r >= 0)
  1595.          runerr(101, argv[r]);
  1596.  
  1597.       {
  1598.       int i, j;
  1599.       long rv;
  1600.       wsp ws = w->window;
  1601.  
  1602. #ifndef max
  1603. #define max(x,y) (((x)<(y))?(y):(x))
  1604. #define min(x,y) (((x)>(y))?(y):(x))
  1605. #endif
  1606.  
  1607.       imem.x = max(x,0);
  1608.       imem.y = max(y,0);
  1609.       imem.width = min(width, (int)ws->width - imem.x);
  1610.       imem.height = min(height, (int)ws->height - imem.y);
  1611.  
  1612.       if (getpixel_init(w, &imem) == Failed) fail;
  1613.  
  1614.       lastval = emptystr;
  1615.  
  1616.       for (j=y; j < y + height; j++) {
  1617.          for (i=x; i < x + width; i++) {
  1618.             getpixel(w, i, j, &rv, strout, &imem);
  1619.             slen = strlen(strout);
  1620.             if (rv >= 0) {
  1621.            int signal;
  1622.                if (slen != StrLen(lastval) ||
  1623.                      strncmp(strout, StrLoc(lastval), slen)) {
  1624.                   Protect((StrLoc(lastval) = alcstr(strout, slen)), runerr(0));
  1625.                   StrLen(lastval) = slen;
  1626.                   }
  1627. #if COMPILER
  1628.                suspend lastval;        /* memory leak on vanquish */
  1629. #else                    /* COMPILER */
  1630.            /*
  1631.         * suspend, but free up imem if vanquished; RTL workaround
  1632.         * Needs implementing under the compiler.
  1633.         */
  1634.            r_args[0] = lastval;
  1635. #ifdef EventMon
  1636.            if ((signal = interp(G_Fsusp, r_args)) != A_Resume) {
  1637. #else                    /* EventMon */
  1638.            if ((signal = interp(G_Csusp, r_args)) != A_Resume) {
  1639. #endif                    /* EventMon */
  1640.           tend = r_tend.previous;
  1641.           getpixel_term(w, &imem);
  1642.           VanquishReturn(signal);
  1643.           }
  1644. #endif                    /* COMPILER */
  1645.                }
  1646.             else {
  1647. #if COMPILER
  1648.                suspend C_integer rv;    /* memory leak on vanquish */
  1649. #else                    /* COMPILER */
  1650.            int signal;
  1651.            /*
  1652.         * suspend, but free up imem if vanquished; RTL workaround
  1653.         * Needs implementing under the compiler.
  1654.         */
  1655.            r_args[0].dword = D_Integer;
  1656.            r_args[0].vword.integr = rv;
  1657. #ifdef EventMon
  1658.            if ((signal = interp(G_Fsusp, r_args)) != A_Resume) {
  1659. #else                    /* EventMon */
  1660.            if ((signal = interp(G_Csusp, r_args)) != A_Resume) {
  1661. #endif                    /* EventMon */
  1662.           tend = r_tend.previous;
  1663.           getpixel_term(w, &imem);
  1664.           VanquishReturn(signal);
  1665.           }
  1666. #endif                    /* COMPILER */
  1667.                }
  1668.             }
  1669.          }
  1670.       getpixel_term(w, &imem);
  1671.       fail;
  1672.       }
  1673.       }
  1674. end
  1675.  
  1676.  
  1677. "QueryPointer(w) - produce mouse position"
  1678.  
  1679. function{0,2} QueryPointer(w)
  1680.  
  1681.    declare {
  1682.       XPoint xp;
  1683.       }
  1684.    abstract {
  1685.       return integer
  1686.       }
  1687.    body {
  1688.       pollevent();
  1689.       if (is:null(w)) {
  1690.      query_rootpointer(&xp);
  1691.      }
  1692.       else {
  1693.      if (!is:file(w) || !(BlkLoc(w)->file.status & Fs_Window))
  1694.         runerr(140, w);
  1695.      query_pointer((wbp)BlkLoc(w)->file.fd, &xp);
  1696.      }
  1697.       suspend C_integer xp.x;
  1698.       suspend C_integer xp.y;
  1699.       fail;
  1700.       }
  1701. end
  1702.  
  1703.  
  1704. "Raise(w) - raise w to the top of the window stack"
  1705.  
  1706. function{1} Raise(argv[argc])
  1707.    abstract {
  1708.       return file
  1709.       }
  1710.    body {
  1711.       wbp w;
  1712.       int warg = 0;
  1713.       OptWindow(w);
  1714.       raiseWindow(w);
  1715.       ReturnWindow;
  1716.       }
  1717. end
  1718.  
  1719.  
  1720. "ReadImage(w, s, x, y, p) - load image file"
  1721.  
  1722. function{0,1} ReadImage(argv[argc])
  1723.    abstract {
  1724.       return integer
  1725.       }
  1726.    body {
  1727.       wbp w;
  1728.       char filename[MaxFileName + 1];
  1729.       tended char *tmp;
  1730.       int status, warg = 0;
  1731.       C_integer x, y;
  1732.       int p, r;
  1733.       struct imgdata imd;
  1734.       OptWindow(w);
  1735.  
  1736.       if (argc - warg == 0)
  1737.      runerr(103,nulldesc);
  1738.       if (!cnv:C_string(argv[warg], tmp))
  1739.      runerr(103,argv[warg]);
  1740.  
  1741.       /*
  1742.        * x and y must be integers; they default to the upper left pixel.
  1743.        */
  1744.       if (argc - warg < 2) x = -w->context->dx;
  1745.       else if (!def:C_integer(argv[warg+1], -w->context->dx, x))
  1746.          runerr(101, argv[warg+1]);
  1747.       if (argc - warg < 3) y = -w->context->dy;
  1748.       else if (!def:C_integer(argv[warg+2], -w->context->dy, y))
  1749.          runerr(101, argv[warg+2]);
  1750.  
  1751.       /*
  1752.        * p is an optional palette name.
  1753.        */
  1754.       if (argc - warg < 4 || is:null(argv[warg+3])) p = 0;
  1755.       else {
  1756.          p = palnum(&argv[warg+3]);
  1757.          if (p == -1)
  1758.             runerr(103, argv[warg+3]);
  1759.          if (p == 0)
  1760.             fail;
  1761.          }
  1762.  
  1763.       x += w->context->dx;
  1764.       y += w->context->dy;
  1765.       strncpy(filename, tmp, MaxFileName);   /* copy to loc that won't move*/
  1766.       filename[MaxFileName] = '\0';
  1767.  
  1768.       /*
  1769.        * First try to read as a GIF file.
  1770.        * If that doesn't work, try platform-dependent image reading code.
  1771.        */
  1772.       r = readGIF(filename, p, &imd);
  1773.       if (r == Succeeded) {
  1774.          status = strimage(w, x, y, imd.width, imd.height, imd.paltbl,
  1775.                imd.data, (word)imd.width * (word)imd.height, 0);
  1776.          if (status < 0)
  1777.             r = Error;
  1778.          free((pointer)imd.paltbl);
  1779.          free((pointer)imd.data);
  1780.          }
  1781.       else if (r == Failed)
  1782.          r = readimage(w, filename, x, y, &status);
  1783.       if (r == Error)
  1784.          runerr(305);
  1785.       if (r == Failed)
  1786.          fail;
  1787.       if (status == 0)
  1788.          return nulldesc;
  1789.       else
  1790.          return C_integer (word)status;
  1791.       }
  1792. end
  1793.  
  1794.  
  1795.  
  1796. "WSync(w) - synchronize with server"
  1797.  
  1798. function{1} WSync(w)
  1799.    abstract {
  1800.       return file++null
  1801.       }
  1802.    body {
  1803.       wbp _w_;
  1804.  
  1805.       if (is:null(w)) {
  1806.      _w_ = NULL;
  1807.      }
  1808.       else if (!is:file(w)) runerr(140,w);
  1809.       else {
  1810.          if (!(BlkLoc(w)->file.status & Fs_Window))
  1811.             runerr(140,w);
  1812.          _w_ = (wbp)BlkLoc(w)->file.fd;
  1813.      }
  1814.  
  1815.       wsync(_w_);
  1816.       pollevent();
  1817.       return w;
  1818.       }
  1819. end
  1820.  
  1821.  
  1822. "TextWidth(w,s) - compute text pixel width"
  1823.  
  1824. function{1} TextWidth(argv[argc])
  1825.    abstract {
  1826.       return integer
  1827.       }
  1828.    body {
  1829.       wbp w;
  1830.       int warg=0;
  1831.       C_integer i;
  1832.       OptWindow(w);
  1833.  
  1834.       if (warg == argc) runerr(103,nulldesc);
  1835.       else if (!cnv:tmp_string(argv[warg],argv[warg]))
  1836.      runerr(103,argv[warg]);
  1837.  
  1838.       i = TEXTWIDTH(w, StrLoc(argv[warg]), StrLen(argv[warg]));
  1839.       return C_integer i;
  1840.       }
  1841. end
  1842.  
  1843.  
  1844. "Uncouple(w) - uncouple window"
  1845.  
  1846. function{1} Uncouple(w)
  1847.    abstract {
  1848.       return file
  1849.       }
  1850.    body {
  1851.       wbp _w_;
  1852.       if (!is:file(w)) runerr(140,w);
  1853.       if ((BlkLoc(w)->file.status & Fs_Window) == 0) runerr(140,w);
  1854.       if ((BlkLoc(w)->file.status & (Fs_Read|Fs_Write)) == 0) runerr(142,w);
  1855.       _w_ = (wbp)BlkLoc(w)->file.fd;
  1856.       BlkLoc(w)->file.status = Fs_Window; /* no longer open for read/write */
  1857.       free_binding(_w_);
  1858.       return w;
  1859.       }
  1860. end
  1861.  
  1862. "WAttrib(argv[]) - read/write window attributes"
  1863.  
  1864. function{*} WAttrib(argv[argc])
  1865.    abstract {
  1866.       return file++string++integer
  1867.       }
  1868.    body {
  1869.       wbp w, wsave;
  1870.       word n;
  1871.       tended struct descrip sbuf, sbuf2;
  1872.       char answer[128];
  1873.       int  pass, config = 0;
  1874.       int warg = 0;
  1875.       OptWindow(w);
  1876.  
  1877.       wsave = w;
  1878.       /*
  1879.        * Loop through the arguments.
  1880.        */
  1881.       for (pass = 1; pass <= 2; pass++) {
  1882.      w = wsave;
  1883.      if (config && pass == 2) {
  1884.         if (do_config(w, config) == Failed) fail;
  1885.         }
  1886.          for (n = warg; n < argc; n++) {
  1887.             if (is:file(argv[n])) {/* Current argument is a file */
  1888.                /*
  1889.                 * Switch the current file to the file named by the
  1890.                 *  current argument providing it is a file.  argv[n]
  1891.                 *  is made to be a empty string to avoid a special case.
  1892.                 */
  1893.                if (!(BlkLoc(argv[n])->file.status & Fs_Window))
  1894.                   runerr(140,argv[n]);
  1895.                w = (wbp)BlkLoc(argv[n])->file.fd;
  1896.            if (config && pass == 2) {
  1897.           if (do_config(w, config) == Failed) fail;
  1898.           }
  1899.                }
  1900.             else {    /* Current argument should be a string */
  1901.            /*
  1902.         * In pass 1, a null argument is an error; failed attribute
  1903.         *  assignments are turned into null descriptors for pass 2
  1904.         *  and are ignored.
  1905.         */
  1906.                if (is:null(argv[n])) {
  1907.           if (pass == 2)
  1908.              continue;
  1909.           else runerr(109, argv[n]);
  1910.           }
  1911.                /*
  1912.                 * If its an integer or real, it can't be a valid attribute.
  1913.                 */
  1914.            if (is:integer(argv[n]) || is:real(argv[n])) {
  1915.           runerr(145, argv[n]);
  1916.           }
  1917.                /*
  1918.                 * Convert the argument to a string
  1919.                 */
  1920.                if (!cnv:tmp_string(argv[n], sbuf))
  1921.                   runerr(109, argv[n]);
  1922.                /*
  1923.                 * Various parts of the code can't handle long attributes.
  1924.         * (ugh.)
  1925.                 */
  1926.            if (StrLen(sbuf) > 127)
  1927.               runerr(145, argv[n]);
  1928.                /*
  1929.                 * Read/write the attribute
  1930.                 */
  1931.                if (pass == 1) {
  1932.           char *tmp_s = StrLoc(sbuf);
  1933.           char *tmp_s2 = StrLoc(sbuf) + StrLen(sbuf);
  1934.           for ( ; tmp_s < tmp_s2; tmp_s++)
  1935.              if (*tmp_s == '=') break;
  1936.           if (tmp_s < tmp_s2) {
  1937.              /*
  1938.               * pass 1: perform attribute assignments
  1939.               */
  1940.              switch (wattrib(w, StrLoc(sbuf), StrLen(sbuf),
  1941.                      &sbuf2, answer)) {
  1942.              case Failed:
  1943.                 /*
  1944.              * Mark the attribute so we don't produce a result
  1945.              */
  1946.                 argv[n] = nulldesc;
  1947.                 continue;
  1948.              case Error: runerr(0, argv[n]);
  1949.              }
  1950.              if (StrLen(sbuf) > 4) {
  1951.             if (!strncmp(StrLoc(sbuf), "pos=", 4)) config |= 1;
  1952.             if (StrLen(sbuf) > 5) {
  1953.                if (!strncmp(StrLoc(sbuf), "posx=", 5)) config |= 1;
  1954.                if (!strncmp(StrLoc(sbuf), "posy=", 5)) config |= 1;
  1955.                if (!strncmp(StrLoc(sbuf), "rows=", 5)) config |= 2;
  1956.                if (!strncmp(StrLoc(sbuf), "size=", 5)) config |= 2;
  1957.                if (StrLen(sbuf) > 6) {
  1958.                   if (!strncmp(StrLoc(sbuf), "width=", 6))
  1959.                  config |= 2;
  1960.                   if (!strncmp(StrLoc(sbuf), "lines=", 6))
  1961.                  config |= 2;
  1962.                   if (StrLen(sbuf) > 7) {
  1963.                  if (!strncmp(StrLoc(sbuf), "height=", 7))
  1964.                     config |= 2;
  1965.                  if (!strncmp(StrLoc(sbuf), "resize=", 7))
  1966.                     config |= 2;
  1967.                  if (StrLen(sbuf) > 8) {
  1968.                     if (!strncmp(StrLoc(sbuf), "columns=", 8))
  1969.                        config |= 2;
  1970.                     if (StrLen(sbuf) > 9) {
  1971.                        if (!strncmp(StrLoc(sbuf),
  1972.                             "geometry=", 9))
  1973.                       config |= 3;
  1974.                        }
  1975.                     }
  1976.                  }
  1977.                   }
  1978.                }
  1979.             }
  1980.              }
  1981.           }
  1982.            /*
  1983.         * pass 2: perform attribute queries, suspend result(s)
  1984.         */
  1985.                else if (pass==2) {
  1986.           char *stmp, *stmp2;
  1987.           /*
  1988.            * Turn assignments into queries.
  1989.            */
  1990.           for( stmp = StrLoc(sbuf),
  1991.               stmp2 = stmp + StrLen(sbuf); stmp < stmp2; stmp++)
  1992.              if (*stmp == '=') break;
  1993.           if (stmp < stmp2)
  1994.              StrLen(sbuf) = stmp - StrLoc(sbuf);
  1995.  
  1996.           switch (wattrib(w, StrLoc(sbuf), StrLen(sbuf),
  1997.                   &sbuf2, answer)) {
  1998.           case Failed: continue;
  1999.           case Error:  runerr(0, argv[n]);
  2000.              }
  2001.           if (is:string(sbuf2))
  2002.              Protect(StrLoc(sbuf2) = alcstr(StrLoc(sbuf2),StrLen(sbuf2)), runerr(0));
  2003.                   suspend sbuf2;
  2004.                   }
  2005.                }
  2006.             }
  2007.      }
  2008.       fail;
  2009.       }
  2010. end
  2011.  
  2012.  
  2013. "WDefault(w,program,option) - get a default value from the environment"
  2014.  
  2015. function{0,1} WDefault(argv[argc])
  2016.    abstract {
  2017.       return string
  2018.       }
  2019.    body {
  2020.       wbp w;
  2021.       int warg = 0;
  2022.       long l;
  2023.       tended char *prog, *opt;
  2024.       char sbuf1[MaxCvtLen];
  2025.       OptWindow(w);
  2026.  
  2027.       if (argc-warg < 2)
  2028.          runerr(103);
  2029.       if (!cnv:C_string(argv[warg],prog))
  2030.          runerr(103,argv[warg]);
  2031.       if (!cnv:C_string(argv[warg+1],opt))
  2032.          runerr(103,argv[warg+1]);
  2033.  
  2034.       if (getdefault(w, prog, opt, sbuf1) == Failed) fail;
  2035.       l = strlen(sbuf1);
  2036.       Protect(prog = alcstr(sbuf1,l),runerr(0));
  2037.       return string(l,prog);
  2038.       }
  2039. end
  2040.  
  2041.  
  2042. "WFlush(w) - flush all output to window w"
  2043.  
  2044. function{1} WFlush(argv[argc])
  2045.    abstract {
  2046.       return file
  2047.       }
  2048.    body {
  2049.       wbp w;
  2050.       int warg = 0;
  2051.       OptWindow(w);
  2052.       wflush(w);
  2053.       ReturnWindow;
  2054.       }
  2055. end
  2056.  
  2057.  
  2058. "WriteImage(w,filename,x,y,width,height) - write an image to a file"
  2059.  
  2060. function{0,1} WriteImage(argv[argc])
  2061.    abstract {
  2062.       return file
  2063.       }
  2064.    body {
  2065.       wbp w;
  2066.       int r;
  2067.       C_integer x, y, width, height, warg = 0;
  2068.       tended char *s;
  2069.       OptWindow(w);
  2070.  
  2071.       if (argc - warg == 0)
  2072.          runerr(103, nulldesc);
  2073.       else if (!cnv:C_string(argv[warg], s))
  2074.          runerr(103, argv[warg]);
  2075.  
  2076.       r = rectargs(w, argc, argv, warg + 1, &x, &y, &width, &height);
  2077.       if (r >= 0)
  2078.          runerr(101, argv[r]);
  2079.  
  2080.       /*
  2081.        * clip image to window, and fail if zero-sized.
  2082.        * (the casts to long are necessary to avoid unsigned comparison.)
  2083.        */
  2084.       if (x < 0)  {
  2085.          width += x;
  2086.          x = 0;
  2087.          }
  2088.       if (y < 0)  {
  2089.          height += y;
  2090.          y = 0;
  2091.          }
  2092.       if (x + width > (long) w->window->width)
  2093.          width = w->window->width - x;
  2094.       if (y + height > (long) w->window->height)
  2095.          height = w->window->height - y;
  2096.       if (width <= 0 || height <= 0)
  2097.      fail;
  2098.  
  2099.       /*
  2100.        * try platform-dependent code first; it will reject the call
  2101.        * if the file name s does not specify a platform-dependent format.
  2102.        */
  2103.       r = dumpimage(w, s, x, y, width, height);
  2104.       if (r == NoCvt)
  2105.          r = writeGIF(w, s, x, y, width, height);
  2106.       if (r != Succeeded)
  2107.          fail;
  2108.       ReturnWindow;
  2109.       }
  2110. end
  2111.  
  2112. #ifdef MSWindows
  2113.  
  2114. "WinPlayMedia(w,x[]) - play a multimedia resource"
  2115.  
  2116. function{0,1} WinPlayMedia(argv[argc])
  2117.    abstract {
  2118.       return null
  2119.       }
  2120.    body {
  2121.       wbp w;
  2122.       tended char *tmp;
  2123.       int warg = 0;
  2124.       int i;
  2125.       wsp ws;
  2126.       word n;
  2127.       OptWindow(w);
  2128.  
  2129.       ws = w->window;
  2130.       for (n = warg; n < argc; n++) {
  2131.          if (!cnv:C_string(argv[n], tmp))
  2132.         runerr(103,argv[warg]);
  2133.          if (playmedia(w, tmp) == Failed) fail;
  2134.          }
  2135.       return nulldesc;
  2136.       }
  2137. end
  2138.  
  2139.  
  2140.  
  2141. /*
  2142.  * Simple Windows-native pushbutton
  2143.  */
  2144. "WinButton(w, s, x, y, wd, ht) - install a pushbutton with label s on window w"
  2145.  
  2146. function{0,1} WinButton(argv[argc])
  2147.    abstract {
  2148.       return file
  2149.       }
  2150.    body {
  2151.       wbp w;
  2152.       wsp ws;
  2153.       int i, ii, i2, r, total = 0;
  2154.       C_integer x, y, width, height, warg = 0;
  2155.       tended char *s, *s2;
  2156.       tended struct descrip d;
  2157.       tended struct b_list *hp;
  2158.       OptWindow(w);
  2159.       ws = w->window;
  2160.       if (warg == argc) fail;
  2161.       if (!cnv:C_string(argv[warg], s)) runerr(103, argv[warg]);
  2162.       warg++;
  2163.       /*
  2164.        * look for an existing button with this id.
  2165.        */
  2166.       for(i = 0; i < ws->nChildren; i++) {
  2167.          if (!strcmp(s, ws->child[i].id) && ws->child[i].type==CHILD_BUTTON)
  2168.             break;
  2169.          }
  2170.       /*
  2171.        * create a new button if none is found
  2172.        */
  2173.       if (i == ws->nChildren) {
  2174.          ws->nChildren++;
  2175.          ws->child = realloc(ws->child,
  2176.                  ws->nChildren * sizeof(childcontrol));
  2177.      makebutton(ws, ws->child + i, s);
  2178.          }
  2179.  
  2180.       if (warg >= argc) x = 0;
  2181.       else if (!def:C_integer(argv[warg], 0, x))
  2182.      runerr(101, argv[warg]);
  2183.       warg++;
  2184.       if (warg >= argc) y = 0;
  2185.       else if (!def:C_integer(argv[warg], 0, y))
  2186.      runerr(101, argv[warg]);
  2187.       warg++;
  2188.       /*
  2189.        * default width is width of text in system font + 2 chars
  2190.        */
  2191.       ii = sysTextWidth(w, s, strlen(s)) + 10;
  2192.       if (warg >= argc) width = i2;
  2193.       else if (!def:C_integer(argv[warg], i2, width))
  2194.      runerr(101, argv[warg]);
  2195.       warg++;
  2196.       /*
  2197.        * default height is height of text in system font * 7/4
  2198.        */
  2199.       i2 = sysFontHeight(w) * 7 / 4;
  2200.       if (warg >= argc) height = i2;
  2201.       else if (!def:C_integer(argv[warg], i2, height))
  2202.      runerr(101, argv[warg]);
  2203.  
  2204.       movechild(ws->child + i, x, y, width, height);
  2205.       ReturnWindow;
  2206.       }
  2207. end
  2208.  
  2209. "WinScrollBar(w, s, i1, i2, i3, x, y, wd, ht) - install a scrollbar"
  2210.  
  2211. function{0,1} WinScrollBar(argv[argc])
  2212.    abstract {
  2213.       return file
  2214.       }
  2215.    body {
  2216.       wbp w;
  2217.       wsp ws;
  2218.       C_integer x, y, width, height, warg = 0, i1, i2, i3, i, ii;
  2219.       tended char *s, *s2;
  2220.       tended struct descrip d;
  2221.       tended struct b_list *hp;
  2222.  
  2223.       OptWindow(w);
  2224.       ws = w->window;
  2225.       if (warg == argc) fail;
  2226.       if (!cnv:C_string(argv[warg], s)) runerr(103, argv[warg]);
  2227.       warg++;
  2228.       /*
  2229.        * look for an existing scrollbar with this id.
  2230.        */
  2231.       for(i = 0; i < ws->nChildren; i++) {
  2232.          if (!strcmp(s, ws->child[i].id) && ws->child[i].type==CHILD_EDIT)
  2233.             break;
  2234.          }
  2235.       /*
  2236.        * i1, the min of the scrollbar range, defaults to 0
  2237.        */
  2238.       if (warg >= argc) i1 = 0;
  2239.       else if (!def:C_integer(argv[warg], 0, i1)) runerr(101, argv[warg]);
  2240.       warg++;
  2241.       /*
  2242.        * i2, the max of the scrollbar range, defaults to 100
  2243.        */
  2244.       if (warg >= argc) i2 = 100;
  2245.       else if (!def:C_integer(argv[warg], 100, i2)) runerr(101, argv[warg]);
  2246.       warg++;
  2247.       /*
  2248.        * create a new scrollbar at end of array if none was found
  2249.        */
  2250.       if (i == ws->nChildren) {
  2251.          ws->nChildren++;
  2252.          ws->child = realloc(ws->child, ws->nChildren * sizeof(childcontrol));
  2253.      makescrollbar(ws, ws->child + i, s, i1, i2);
  2254.          }
  2255.       /*
  2256.        * i3, the interval, defaults to 10
  2257.        */
  2258.       if (warg >= argc) i3 = 10;
  2259.       else if (!def:C_integer(argv[warg], 10, i3))
  2260.      runerr(101, argv[warg]);
  2261.       warg++;
  2262.       /*
  2263.        * x defaults to the right edge of the window - system scrollbar width
  2264.        */
  2265.       ii = ws->width - sysScrollWidth();
  2266.       if (warg >= argc) x = ii;
  2267.       else if (!def:C_integer(argv[warg], ii, x))
  2268.      runerr(101, argv[warg]);
  2269.       warg++;
  2270.       /*
  2271.        * y defaults to 0
  2272.        */
  2273.       if (warg >= argc) y = 0;
  2274.       else if (!def:C_integer(argv[warg], 0, y))
  2275.      runerr(101, argv[warg]);
  2276.       warg++;
  2277.       /*
  2278.        * width defaults to system scrollbar width
  2279.        */
  2280.       ii = sysScrollWidth();
  2281.       if (warg >= argc) width = ii;
  2282.       else if (!def:C_integer(argv[warg], ii, width))
  2283.      runerr(101, argv[warg]);
  2284.       warg++;
  2285.       /*
  2286.        * height defaults to height of the client window
  2287.        */
  2288.       if (warg >= argc) height = ws->height;
  2289.       else if (!def:C_integer(argv[warg], ws->height, height))
  2290.      runerr(101, argv[warg]);
  2291.  
  2292.       movechild(ws->child + i, x, y, width, height);
  2293.       ReturnWindow;
  2294.       }
  2295. end
  2296.  
  2297. /*
  2298.  * Simple Windows-native menu bar
  2299.  */
  2300. "WinMenuBar(w,L1,L2,...) - install a set of top-level menus"
  2301.  
  2302. function{0,1} WinMenuBar(argv[argc])
  2303.    abstract {
  2304.       return file
  2305.       }
  2306.    body {
  2307.       wbp w;
  2308.       wsp ws;
  2309.       int i, total = 0;
  2310.       C_integer x, y, warg = 0;
  2311.       tended char *s;
  2312.       tended struct descrip d;
  2313.       OptWindow(w);
  2314.       ws = w->window;
  2315.  
  2316.       if (warg == argc) fail;
  2317.       for (i = warg; i < argc; i++) {
  2318.          if (!is:list(argv[i])) runerr(108, argv[i]);
  2319.          total += BlkLoc(argv[i])->list.size;
  2320.      }
  2321.       /*
  2322.        * free up memory for the old menu map
  2323.        */
  2324.       if (ws->nmMapElems) {
  2325.          for (i=0; i<ws->nmMapElems; i++) free(ws->menuMap[i]);
  2326.          free(ws->menuMap);
  2327.          }
  2328.       ws->menuMap = (char **)calloc(total, sizeof(char *));
  2329.  
  2330.       if (nativemenubar(w, total, argc, argv, warg, &d) == Error)
  2331.         runerr(103, d);
  2332.       ReturnWindow;
  2333.       }
  2334. end
  2335.  
  2336. /*
  2337.  * Windows-native editor
  2338.  */
  2339. "WinEditRegion(w, s, s2, x, y, wd, ht) = install an edit box with label s"
  2340.  
  2341. function{0, 1} WinEditRegion(argv[argc])
  2342.    abstract {
  2343.       return file ++ string
  2344.       }
  2345.    body {
  2346.       wbp w;
  2347.       wsp ws;
  2348.       tended char *s, *s2;
  2349.       C_integer i, x, y, width, height, warg = 0;
  2350.       OptWindow(w);
  2351.       ws = w->window;
  2352.       if (warg == argc) fail;
  2353.       if (!cnv:C_string(argv[warg], s))
  2354.      runerr(103, argv[warg]);
  2355.       warg++;
  2356.       /*
  2357.        * look for an existing edit region with this id.
  2358.        */
  2359.       for(i = 0; i < ws->nChildren; i++) {
  2360.          if (!strcmp(s, ws->child[i].id) && ws->child[i].type==CHILD_EDIT)
  2361.             break;
  2362.          }
  2363.       /*
  2364.        * create a new edit region if none is found
  2365.        */
  2366.       if (i == ws->nChildren) {
  2367.          ws->nChildren++;
  2368.          ws->child = realloc(ws->child, ws->nChildren * sizeof(childcontrol));
  2369.      makeeditregion(w, ws->child + i, s);
  2370.          }
  2371.       /*
  2372.        * Invoked with no value, return the current value of an existing
  2373.        * edit region (entire buffer is one gigantic string).
  2374.        */
  2375.       else if (warg == argc) {
  2376.          geteditregion(ws->child + i, &result);
  2377.      return result;
  2378.          }
  2379.       /*
  2380.        * Assign a value (s2 string contents) or perform editing command
  2381.        */
  2382.       if (is:null(argv[warg])) s2 = NULL;
  2383.       else if (!cnv:C_string(argv[warg], s2)) runerr(103, argv[warg]);
  2384.       warg++;
  2385.  
  2386.       if (warg >= argc) x = 0;
  2387.       else if (!def:C_integer(argv[warg], 0, x)) runerr(101, argv[warg]);
  2388.       warg++;
  2389.       if (warg >= argc) y = 0;
  2390.       else if (!def:C_integer(argv[warg], 0, y)) runerr(101, argv[warg]);
  2391.       warg++;
  2392.       if (warg >= argc) width = ws->width - x;
  2393.       else if (!def:C_integer(argv[warg], ws->width -x, width))
  2394.          runerr(101, argv[warg]);
  2395.       warg++;
  2396.       if (warg >= argc) height = ws->height - y;
  2397.       else if (!def:C_integer(argv[warg], ws->height - y, height))
  2398.          runerr(101, argv[warg]);
  2399.  
  2400.       if (s2 && !strcmp("!clear", s2)) {
  2401.          cleareditregion(ws->child + i);
  2402.          s2 = NULL;
  2403.          }
  2404.       else if (s2 && !strcmp("!copy", s2)) {
  2405.          copyeditregion(ws->child + i);
  2406.          s2 = NULL;
  2407.          }
  2408.       else if (s2 && !strcmp("!cut", s2)) {
  2409.          cuteditregion(ws->child + i);
  2410.          s2 = NULL;
  2411.          }
  2412.       else if (s2 && !strcmp("!paste", s2)) {
  2413.          pasteeditregion(ws->child + i);
  2414.          s2 = NULL;
  2415.          }
  2416.       else if (s2 && !strcmp("!undo", s2)) {
  2417.          if (undoeditregion(ws->child + i) == Failed) fail;
  2418.          s2 = NULL;
  2419.          }
  2420.       else if (s2 && !strncmp("!modified=", s2, 10)) {
  2421.          setmodifiededitregion(ws->child + i, atoi(s2+10));
  2422.          s2 = NULL;
  2423.          }
  2424.       else if (s2 && !strcmp("!modified", s2)) {
  2425.          if (modifiededitregion(ws->child + i) == Failed) fail;
  2426.          s2 = NULL;
  2427.          }
  2428.       else if (s2 && !strncmp("!font=", s2, 6)) {
  2429.      if (setchildfont(ws->child + i, s2 + 6) == Succeeded) {
  2430.             ReturnWindow;
  2431.         }
  2432.      else fail;
  2433.          }
  2434.       else if (s2 && !strcmp("!setsel", s2)) {
  2435.      setchildselection(ws, ws->child + i, x, y);
  2436.          ReturnWindow;
  2437.          }
  2438.  
  2439.       if (s2) {
  2440.          seteditregion(ws->child + i, s2);
  2441.      }
  2442.       movechild(ws->child + i, x, y, width, height);
  2443.       setfocusonchild(ws, ws->child + i, width, height);
  2444.       ReturnWindow;
  2445.       }
  2446. end
  2447.  
  2448.  
  2449. /*
  2450.  * common dialog functions
  2451.  */
  2452.  
  2453. "WinColorDialog(w,s) - choose a color for a window's context"
  2454.  
  2455. function{0,1} WinColorDialog(argv[argc])
  2456.    abstract {
  2457.       return string
  2458.       }
  2459.    body {
  2460.       wbp w;
  2461.       C_integer x, y, width, height, warg = 0;
  2462.       long r, g, b;
  2463.       tended char *s;
  2464.       char buf[64], *tmp = buf;
  2465.       OptWindow(w);
  2466.  
  2467.       if (warg < argc) {
  2468.          if (is:null(argv[warg])) s = "white";
  2469.      else if (!cnv:C_string(argv[warg], s)) runerr(103, argv[warg]);
  2470.          }
  2471.       else s = "white";
  2472.       if (parsecolor(w, s, &r, &g, &b) == Failed) fail;
  2473.  
  2474.       if (nativecolordialog(w, r, g, b, buf) == NULL) fail;
  2475.       StrLoc(result) = alcstr(buf, strlen(buf));
  2476.       StrLen(result) = strlen(buf);
  2477.       return result;
  2478.       }
  2479. end
  2480.  
  2481. "WinFontDialog(w,s) - choose a font for a window's context"
  2482.  
  2483. function{0,1} WinFontDialog(argv[argc])
  2484.    abstract {
  2485.       return string
  2486.       }
  2487.    body {
  2488.       wbp w;
  2489.       int r;
  2490.       C_integer x, y, width, height, warg = 0, fheight;
  2491.       int flags;
  2492.       tended char *s;
  2493.       char buf[64], *tmp = buf;
  2494.       OptWindow(w);
  2495.  
  2496.       if (warg < argc) {
  2497.          if (is:null(argv[warg])) s = "fixed";
  2498.      else if (!cnv:C_string(argv[warg], s)) runerr(103, argv[warg]);
  2499.          }
  2500.       else s = "fixed";
  2501.  
  2502.       parsefont(s, buf, &flags, &fheight);
  2503.  
  2504.       if (nativefontdialog(w, buf, flags, fheight) == Failed) fail;
  2505.       StrLoc(result) = alcstr(buf, strlen(buf));
  2506.       StrLen(result) = strlen(buf);
  2507.       return result;
  2508.       }
  2509. end
  2510.  
  2511.  
  2512. "WinOpenDialog(w,s1,s2,i,s3,j) - choose a file to open"
  2513.  
  2514. function{0,1} WinOpenDialog(argv[argc])
  2515.    abstract {
  2516.       return string
  2517.       }
  2518.    body {
  2519.       wbp w;
  2520.       int len, slen;
  2521.       C_integer i, j, x, y, width, height, warg = 0;
  2522.       char buf2[64], buf3[256], chReplace;
  2523.       char *tmpstr;
  2524.       tended char *s1, *s2, *s3;
  2525.       OptWindow(w);
  2526.  
  2527.       if (warg >= argc || is:null(argv[warg])) {
  2528.          s1 = "Open:";
  2529.          }
  2530.       else if (!cnv:C_string(argv[warg], s1)) {
  2531.          runerr(103, argv[warg]);
  2532.          }
  2533.       warg++;
  2534.  
  2535.       if (warg >= argc || is:null(argv[warg])) {
  2536.          s2 = "";
  2537.          }
  2538.       else if (!cnv:C_string(argv[warg], s2)) {
  2539.          runerr(103, argv[warg]);
  2540.          }
  2541.       warg++;
  2542.  
  2543.       if (warg >= argc) {
  2544.          i = 50;
  2545.          }
  2546.       else if (!def:C_integer(argv[warg], 50, i)) {
  2547.          runerr(101, argv[warg]);
  2548.          }
  2549.       warg++;
  2550.  
  2551.       if (warg >= argc || is:null(argv[warg])) {
  2552.          strcpy(buf3,"All Files(*.*)|*.*|");
  2553.          s3 = buf3;
  2554.          }
  2555.       else if (!cnv:C_string(argv[warg], s3)) {
  2556.          runerr(103, argv[warg]);
  2557.          }
  2558.       else {
  2559.          strncpy(buf3, s3, 255);
  2560.      buf3[255] = '\0';
  2561.      s3 = buf3;
  2562.          }
  2563.       chReplace = s3[strlen(s3)-1];
  2564.       slen = strlen(s3);
  2565.       for(j=0; j < slen; j++)
  2566.          if(s3[j] == chReplace) s3[j] = '\0';
  2567.       warg++;
  2568.  
  2569.       if (warg >= argc) {
  2570.          j = 1;
  2571.          }
  2572.       else if (!def:C_integer(argv[warg], 1, j)) {
  2573.          runerr(101, argv[warg]);
  2574.          }
  2575.       warg++;
  2576.  
  2577.       if ((tmpstr = nativeopendialog(w,s1,s2,s3,i,j)) == NULL) fail;
  2578.       len = strlen(tmpstr);
  2579.       StrLoc(result) = alcstr(tmpstr, len);
  2580.       StrLen(result) = len;
  2581.       return result;
  2582.       }
  2583. end
  2584.  
  2585.  
  2586. "WinSelectDialog(w, s1, buttons) - select from a set of choices"
  2587.  
  2588. function{0,1} WinSelectDialog(argv[argc])
  2589.    abstract {
  2590.       return string
  2591.       }
  2592.    body {
  2593.       wbp w;
  2594.       C_integer i, j, warg = 0, len;
  2595.       tended char *s1;
  2596.       char *s2 = NULL, *tmpstr;
  2597.       tended struct descrip d;
  2598.       tended struct b_list *hp;
  2599.       int lsize;
  2600.       OptWindow(w);
  2601.  
  2602.       /*
  2603.        * look for list of text for the message.  concatenate text strings.
  2604.        */
  2605.       if (warg == argc)
  2606.          fail;
  2607.       if (!is:list(argv[warg])) runerr(108, argv[warg]);
  2608.       hp  = (struct b_list *)BlkLoc(argv[warg]);
  2609.       lsize = hp->size;
  2610.       for(i=0; i < lsize; i++) {
  2611.          c_get(hp, &d);
  2612.          if (!cnv:C_string(d, s1)) runerr(103, d);
  2613.          len += strlen(s1)+2;
  2614.      if (s2) {
  2615.         s2 = realloc(s2, len);
  2616.         if (!s2) fail;
  2617.             strcat(s2, "\r\n");
  2618.         strcat(s2, s1);
  2619.         }
  2620.      else s2 = salloc(s1);
  2621.          c_put(&(argv[warg]), &d);
  2622.      }
  2623.       warg++;
  2624.  
  2625.       if (warg >= argc) {
  2626.          hp = NULL;
  2627.          }
  2628.       else {
  2629.          if (!is:list(argv[warg])) runerr(108, argv[warg]);
  2630.          hp  = (struct b_list *)BlkLoc(argv[warg]);
  2631.          lsize = hp->size;
  2632.          for(i=0; i < lsize; i++) {
  2633.             c_get(hp, &d);
  2634.             if (!cnv:C_string(d, s1)) runerr(103, d);
  2635.             c_put(&(argv[warg]), &d);
  2636.             }
  2637.          }
  2638.       tmpstr = nativeselectdialog(w, hp, s2);
  2639.       if (tmpstr == NULL) fail;
  2640.       free(s2);
  2641.       len = strlen(tmpstr);
  2642.       StrLoc(result) = alcstr(tmpstr, len);
  2643.       StrLen(result) = len;
  2644.       return result;
  2645.       }
  2646. end
  2647.  
  2648. "WinSaveDialog(w,s1,s2,i,s3,j) - choose a file to save"
  2649.  
  2650. function{0,1} WinSaveDialog(argv[argc])
  2651.    abstract {
  2652.       return string
  2653.       }
  2654.    body {
  2655.       wbp w;
  2656.       int len;
  2657.       C_integer i, j, warg = 0, slen;
  2658.       char buf3[128], chReplace;
  2659.       tended char *tmpstr;
  2660.       tended char *s1, *s2, *s3;
  2661.       OptWindow(w);
  2662.  
  2663.       if (warg >= argc || is:null(argv[warg])) {
  2664.          s1 = "Save:";
  2665.          }
  2666.       else if (!cnv:C_string(argv[warg], s1)) {
  2667.          runerr(103, argv[warg]);
  2668.          }
  2669.       warg++;
  2670.  
  2671.       if (warg >= argc || is:null(argv[warg])) {
  2672.          s2 = "";
  2673.          }
  2674.       else if (!cnv:C_string(argv[warg], s2)) {
  2675.          runerr(103, argv[warg]);
  2676.          }
  2677.       warg++;
  2678.  
  2679.       if (warg >= argc) {
  2680.          i = 50;
  2681.          }
  2682.       else if (!def:C_integer(argv[warg], 50, i)) {
  2683.          runerr(101, argv[warg]);
  2684.          }
  2685.       warg++;
  2686.  
  2687.       if (warg >= argc || is:null(argv[warg])) {
  2688.          strcpy(buf3,"All Files(*.*)|*.*|");
  2689.          s3 = buf3;
  2690.          }
  2691.       else if (!cnv:C_string(argv[warg], s3)) {
  2692.          runerr(103, argv[warg]);
  2693.          }
  2694.       else {
  2695.          strcpy(buf3, s3);
  2696.      s3 = buf3;
  2697.          }
  2698.       chReplace = s3[strlen(s3)-1];
  2699.       slen = strlen(s3);
  2700.       for(j=0; j < slen; j++)
  2701.          if(s3[j] == chReplace) s3[j] = '\0';
  2702.       warg++;
  2703.  
  2704.       if (warg >= argc) {
  2705.          j = 1;
  2706.          }
  2707.       else if (!def:C_integer(argv[warg], 1, j)) {
  2708.          runerr(101, argv[warg]);
  2709.          }
  2710.       warg++;
  2711.       if ((tmpstr = nativesavedialog(w, s1, s2, s3, i, j)) == NULL) fail;
  2712.       len = strlen(tmpstr);
  2713.       StrLoc(result) = alcstr(tmpstr, len);
  2714.       StrLen(result) = len;
  2715.       return result;
  2716.       }
  2717. end
  2718. #endif                    /* MSWindows */
  2719.  
  2720. #else                    /* Graphics */
  2721. static char x;            /* avoid empty module */
  2722. #endif                    /* Graphics */
  2723.