home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / languages / lisp / xlisp / xlsp21_src / sources / c / arcstuf < prev    next >
Encoding:
Text File  |  1992-07-09  |  34.4 KB  |  1,377 lines
  1. /* Arcstuff.c
  2.  * Archimedes RISC OS specific frontend routines for XLisp.
  3.  * written by Gunnar Zoetl (gunnar@fasel.robin.de)
  4.  */
  5.  
  6. #include <stdio.h>
  7. #include <stdlib.h>
  8. #include <math.h>
  9. #include <string.h>
  10. #include <ctype.h>
  11. #include <signal.h>
  12. #include <time.h>
  13. #include "kernel.h"
  14. #include "os.h"
  15. #include "bbc.h"
  16.  
  17. #include "xlisp.h"
  18.  
  19. /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  20. +*++++++++++++++++++++++ WIMP interfacing code ++++++++++++++++++++++++++++
  21. +*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
  22.  
  23. #include "wimp.h"
  24. #include "wimpt.h"
  25. #include "win.h"
  26. #include "event.h"
  27. #include "res.h"
  28. #include "werr.h"
  29. #include "template.h"
  30. #include "dbox.h"
  31.  
  32.  
  33. /* structure to hold screen size and log.-to-phys.-coord. translation info */
  34. typedef struct _svar {
  35.         int xeigh;      /* translation factors */
  36.         int yeigh;
  37.         int xphys;      /* physical resolution */
  38.         int yphys;
  39.         int xppc;       /* pixels per char */
  40.         int yppc;
  41.         } screenvar;
  42.  
  43. /* structure for times emulation */
  44. struct tms {
  45.         time_t tms_utime;
  46.         time_t tms_stime;
  47.         time_t tms_cutime;
  48.         time_t tms_cstime;
  49.         };
  50.  
  51. /* menu entries */
  52. #define XF_INFO 1
  53. #define XF_QUIT 2
  54.  
  55. /* icons in dialog box for the info fields */
  56. #define XF_XL_INFO      5
  57. #define XF_XF_INFO      6
  58.  
  59. /* misc defines */
  60. #define ReadModeVar     53
  61. #define ReadVDUvar      49
  62. #define XEIGH           4
  63. #define YEIGH           5
  64. #define XSIZE           11
  65. #define YSIZE           12
  66. #define CARET           40              /* 40 OS_units heigth */
  67. #define HZ              100
  68. #define PATHBUF         256
  69. #define FILENAMELEN     32
  70. #define WSTDMASK        wimp_EMPTRENTER | wimp_EMPTRLEAVE
  71. #define WKEYMASK        WSTDMASK | wimp_EMNULL
  72.  
  73. #define max(a,b) (a>b?a:b)
  74. #define min(a,b) (a<b?a:b)
  75.  
  76. /*** global variables: ***/
  77.  
  78. static int      winfo_buffer[1024];   /* for wimp_get_wind_info() calls */
  79. static wimp_t   task_handle;
  80. static wimp_w   xf_main_wind;
  81. static menu     xf_menu;
  82. static int      colors;
  83. static BOOL     initing;
  84. static struct tms systime;
  85. static time_t   sys_timeslp;
  86.  
  87. /* filepaths */
  88. char *loadpath = NULL;
  89. char *curdir = NULL;
  90.  
  91. /* redraw info */
  92. static int      xf_needs_redraw = FALSE;
  93. static int      r_xmin = 32768;
  94. static int      r_xmax = 0;
  95. static int      r_ymin = 32768;
  96. static int      r_ymax = 0;
  97.  
  98. /* phys. mode info */
  99. static int      max_x_size;
  100. static int      max_y_size;
  101. static char*    screen;
  102. static int      xf_cursor_x;
  103. static int      xf_cursor_y;
  104. static int      char_x_size;
  105. static int      char_y_size;
  106.  
  107. /* ringbuffer for keyboard input */
  108. static struct keybuf {
  109.         int first;
  110.         int last;
  111.         int count;
  112.         int chars[BUFSIZ];
  113.         } keybuffer;
  114.  
  115. /* Wimp version number we know about *100 */
  116. static int wimp_version = 200;
  117.  
  118. /* pump up the initial stack */
  119. int __root_stack_size = 128 * 1024;
  120.  
  121. /* the info fields */
  122. static char *xl_version = "XLisp    2.1d (02 Jan 1992)";
  123. static char *xf_version = "Frontend 0.13 (09 Jul 1992)";
  124.  
  125. /* and some forward declarations */
  126. int xf_w_open_window (wimp_openstr *);
  127. void xf_clear_screen(void);
  128.  
  129. /*** general routines ***/
  130.  
  131. /* convert a string to lower case */
  132. char *stolower(char *bla)
  133. {
  134.         char *bli, *blu;
  135.         int i;
  136.  
  137.         if (bla == NULL || strlen(bla) == 0)
  138.                 return bla;
  139.  
  140.         bli = malloc(strlen(bla) + 1);
  141.         blu = bli;
  142.  
  143.         for(i = 0; i <= strlen(bla); i++)
  144.                 bli[i] = (char) tolower(bla[i]);
  145.  
  146.         return blu;
  147. }
  148.  
  149. /* duplicate a string */
  150. char *strdup(char *from)
  151. {
  152.         char *to;
  153.  
  154.         to = malloc(strlen(from) + 1);
  155.         return(strcpy(to, from));
  156. }
  157.  
  158. /* get time from 100Hz clock */
  159. long get_time(void)
  160. {
  161.         char timbuf[5];
  162.  
  163.         _kernel_osword(1, (int *)timbuf);
  164.  
  165.         /* return only low 4 bytes of time. */
  166.         return (long) (timbuf[0] + (timbuf[1]<<8) + (timbuf[2]<<16) + (timbuf[3]<<24));
  167. }
  168.  
  169. /* init keybuffer */
  170. void init_keybuffer(void)
  171. {
  172.         keybuffer.first = 0;
  173.         keybuffer.last = 0;
  174.         keybuffer.count = 0;
  175. }
  176.  
  177. /* push one keypress onto buffer, do nothing if buffer overflow */
  178. void pushkey(int key)
  179. {
  180.         if (keybuffer.count < BUFSIZ)
  181.         {
  182.                 keybuffer.chars[keybuffer.last] = key;
  183.                 keybuffer.last = (keybuffer.last + 1) % BUFSIZ;
  184.                 keybuffer.count++;
  185.         }
  186. }
  187.  
  188. /* pop a keypress from buffer, return -1 if empty */
  189. int popkey(void)
  190. {
  191.         int tmpkey;
  192.  
  193.         if (keybuffer.count > 0)
  194.         {
  195.                 tmpkey = keybuffer.chars[keybuffer.first];
  196.                 keybuffer.first = (keybuffer.first + 1) % BUFSIZ;
  197.                 keybuffer.count--;
  198.         }
  199.         else
  200.                 tmpkey = -1;
  201.         return tmpkey;
  202. }
  203.  
  204. /* handle a keypress, translate keycodes, handle escape key */
  205. void xf_handle_key(int chcode)
  206. {
  207.         switch (chcode)
  208.         {
  209.         case 27:
  210.                 raise(SIGINT);
  211.                 break;
  212.         default:
  213.                 pushkey(chcode);
  214.         }
  215. }
  216.  
  217. /* get physical screen size */
  218. screenvar *xf_get_screen_size(void)
  219. {
  220.         int *ssize;
  221.         int xp[3];
  222.  
  223.         ssize = (int *)malloc(sizeof(struct _svar));
  224.  
  225.         /* get translation info */
  226.         ssize[0] = bbc_modevar(-1, XEIGH);
  227.         ssize[1] = bbc_modevar(-1, YEIGH);
  228.         /* get max. x- and y-coordinates from OS */
  229.         ssize[2] = bbc_modevar(-1, XSIZE);
  230.         ssize[3] = bbc_modevar(-1, YSIZE);
  231.  
  232.         /* get x/y pix. per char */
  233.         xp[0] = 162;    /* x size of char */
  234.         xp[1] = 163;    /* y */
  235.         xp[2] = -1;     /* end of table */
  236.         bbc_vduvars (xp, xp);
  237.         ssize[4] = xp[0];
  238.         ssize[5] = xp[1];
  239.  
  240.         /* while we're at it: set char sizes */
  241.         char_x_size = ssize[4] << ssize[0];
  242.         char_y_size = ssize[5] << ssize[1];
  243.         return (screenvar *)ssize;
  244. }
  245.  
  246. /* adjust scrollbar positions if caret outside of vis. window area */
  247. void xf_adjust_posn(wimp_caretstr *pos)
  248. {
  249.         wimp_wstate wstate;
  250.         int vis_x_min, vis_x_max;
  251.         int vis_y_min, vis_y_max;
  252.         int xsize, ysize;
  253.         int dx, dy;
  254.         wimp_box wbox;
  255.  
  256.         dx = dy = -32768;
  257.  
  258.         wimp_get_wind_state(pos->w, &wstate);
  259.  
  260.         /* get visible Part of work area */
  261.         xsize = wstate.o.box.x1 - wstate.o.box.x0;
  262.         ysize = wstate.o.box.y1 - wstate.o.box.y0;
  263.         vis_x_min = wstate.o.x;
  264.         vis_y_max = wstate.o.y;
  265.         vis_x_max = wstate.o.x + xsize;
  266.         vis_y_min = wstate.o.y - ysize;
  267.  
  268.         /* get direction to scroll */
  269.         if (pos->x < vis_x_min)
  270.                 dx = max(0, pos->x - xsize / 2);
  271.         if (pos->x > vis_x_max - char_x_size)
  272.                 dx = min(max_x_size * char_x_size - xsize, pos->x - xsize / 2);
  273.         if (pos->y >= vis_y_max - CARET - 4)
  274.                 dy = min(0, pos->y + CARET);
  275.         if (pos->y < vis_y_min)
  276.                 dy = pos->y + ysize;
  277.  
  278.         /* scroll window thru vis. part in necessary */
  279.         if (dx > -32768 || dy > -32768)
  280.         {
  281.                 wbox.x0 = 0;
  282.                 wbox.y1 = 0;
  283.                 wbox.x1 = max_x_size * char_x_size;
  284.                 wbox.y0 = -max_y_size * char_y_size;
  285.  
  286.                 /* default values for unset d*'s */
  287.                 if (dx == -32768)
  288.                         dx = wstate.o.x;
  289.                 if (dy == -32768)
  290.                         dy = wstate.o.y;
  291.  
  292.                 wimp_blockcopy(wstate.o.w, &wbox, dx - wstate.o.x, - dy - wstate.o.y);
  293.  
  294.                 wstate.o.x = dx;
  295.                 wstate.o.y = dy;
  296.  
  297.                 wimp_open_wind(&wstate.o);
  298.         }
  299. }
  300.  
  301. /* set caret, low level */
  302. void xf_w_set_caret(BOOL force_vis)
  303. {
  304.         wimp_caretstr posn;
  305.  
  306.         if (wimp_get_caret_pos(&posn) == NULL)
  307.                 if (posn.w == xf_main_wind || initing)
  308.                 {
  309.                         posn.x = xf_cursor_x * char_x_size;
  310.                         posn.y = - xf_cursor_y * char_y_size - (CARET & 0xffff);
  311.                         posn.w = xf_main_wind;
  312.                         posn.i = -1;
  313.                         posn.height = CARET;
  314.  
  315.                         /* watch out for caret inside visible part of window */
  316.                         if (force_vis)
  317.                                 xf_adjust_posn(&posn);
  318.  
  319.                         wimp_set_caret_pos(&posn);
  320.                 }
  321. }
  322.  
  323. /* set caret, don't force visibility */
  324. void xf_set_caret(void)
  325. {
  326.         xf_w_set_caret(FALSE);
  327. }
  328.  
  329. /* set caret, make visible */
  330. void xf_find_caret(void)
  331. {
  332.         xf_w_set_caret(TRUE);
  333. }
  334.  
  335. /* task closedown */
  336. void xf_closedown(void)
  337. {
  338.         wimp_close_wind(xf_main_wind);
  339.         win_activedec();
  340.         wimp_taskclose(task_handle);
  341. }
  342.  
  343. /* program info */
  344. void xf_prog_info(void)
  345. {
  346.         dbox window;
  347.  
  348.         if ((window = dbox_new("ProgInfo")) != 0)
  349.         {
  350.                 /* insert version strings */
  351.                 dbox_setfield (window, XF_XL_INFO, xl_version);
  352.                 dbox_setfield (window, XF_XF_INFO, xf_version);
  353.  
  354.                 dbox_show(window);
  355.                 /* keep on screen as long as needed */
  356.                 dbox_fillin(window);
  357.                 /* then get rid of it */
  358.                 dbox_dispose(&window);
  359.         }
  360. }
  361.  
  362. /* event_process()-routine with caring for the actual runtime */
  363. void xf_event_process(void)
  364. {
  365.         systime.tms_utime += get_time() - sys_timeslp;
  366.         event_process();
  367.         sys_timeslp = get_time();
  368. }
  369. /*** virtual screen routines ***/
  370.  
  371. /* invalidate protions of the logical screen */
  372. void xf_invalidate_screen(int x0, int y0, int x1, int y1)
  373. {
  374.         /* adjust rectangle to be redrawn */
  375.         if (x0 < r_xmin)
  376.                 r_xmin = x0;
  377.         if (y0 < r_ymin)
  378.                 r_ymin = y0;
  379.         if (x1 > r_xmax)
  380.                 r_xmax = x1;
  381.         if (y1 > r_ymax)
  382.                 r_ymax = y1;
  383.  
  384.         xf_needs_redraw = TRUE;
  385. }
  386.  
  387. /* force redraw of altered portions (= window update) */
  388. void xf_force_redraw(void)
  389. {
  390.         wimp_redrawstr winr;
  391.  
  392.         if (xf_needs_redraw)
  393.         {
  394.                 /* build rectangle to redraw */
  395.                 winr.w = xf_main_wind;
  396.                 winr.box.x0 = r_xmin * char_x_size;
  397.                 winr.box.x1 = (r_xmax + 1) * char_x_size;
  398.                 winr.box.y0 = - (r_ymax + 1) * char_y_size;
  399.                 winr.box.y1 = - r_ymin * char_y_size;
  400.  
  401.                 wimp_force_redraw(&winr);
  402.  
  403.                 /* reset redraw info */
  404.                 r_xmin = 32768;
  405.                 r_xmax = 0;
  406.                 r_ymax = 0;
  407.                 r_ymin = 32768;
  408.                 xf_needs_redraw = FALSE;
  409.         }
  410. }
  411.  
  412. /* posn. cursor, ignore invalid positions */
  413. void xf_gotoxy(int x, int y)
  414. {
  415.         if (x >= 0 && x < max_x_size && y >= 0 && y < max_y_size)
  416.         {
  417.                 xf_cursor_x = x;
  418.                 xf_cursor_y = y;
  419.         }
  420. }
  421.  
  422. /* scroll window */
  423. void xf_scroll(void)
  424. {
  425.         char *i, *j;
  426.         wimp_box wbox;
  427.  
  428.         /* scroll array up */
  429.         for (i = screen, j = screen + max_x_size; j < (screen + \
  430.                   max_x_size * max_y_size); *i = *j, i++, j++);
  431.  
  432.         /* clear last line */
  433.         for (; i < j; i++)
  434.                 *i = 0;
  435.  
  436.         /* scroll window contents */
  437.         wbox.x0 = 0;
  438.         wbox.x1 = max_x_size * char_x_size;
  439.         wbox.y1 = - char_y_size;
  440.         wbox.y0 = - max_y_size * char_y_size;
  441.  
  442.         wimp_blockcopy(xf_main_wind, &wbox, 0,-(max_y_size - 1) * char_y_size);
  443.         xf_invalidate_screen(0, max_y_size - 2, max_x_size, max_y_size - 1);
  444.         xf_force_redraw();
  445. }
  446.  
  447. /* cursor to next line */
  448. void xf_next_line(void)
  449. {
  450.         xf_cursor_y++;
  451.         if (xf_cursor_y == max_y_size)
  452.         {
  453.                 xf_cursor_y--;
  454.                 xf_scroll();
  455.         }
  456.  
  457.         /* this is necessary for I/O intensive tasks */
  458. }
  459.  
  460. /* cursor to previous line */
  461. void xf_previous_line(void)
  462. {
  463.         if (xf_cursor_y > 0)
  464.                 xf_cursor_y--;
  465. }
  466.  
  467. /* create a new line */
  468. void xf_new_line(void)
  469. {
  470.         xf_next_line();
  471.         xf_gotoxy(0, xf_cursor_y);
  472.         xf_find_caret();
  473.  
  474.         /* for I/O intensive tasks... */
  475.         xf_event_process();
  476. }
  477.  
  478.  
  479. /* advance cursor by 1 pos. */
  480. void xf_next_char(void)
  481. {
  482.         xf_cursor_x++;
  483.         if (xf_cursor_x == max_x_size)
  484.         {
  485.                 xf_cursor_x = 0;
  486.                 xf_next_line();
  487.         }
  488. }
  489.  
  490. /* back cursor 1 char */
  491. void xf_previous_char(void)
  492. {
  493.         xf_cursor_x--;
  494.         if (xf_cursor_x < 0)
  495.         {
  496.                 xf_cursor_x = max_x_size - 1;
  497.                 xf_previous_line();
  498.         }
  499. }
  500.  
  501. /* delete character before cursor */
  502. void xf_back_del()
  503. {
  504.         int i;
  505.         int adr;
  506.  
  507.         if (xf_cursor_x > 0)
  508.         {
  509.                 xf_cursor_x--;
  510.                 adr = xf_cursor_y * max_x_size;
  511.  
  512.                 /* shift line to the right */
  513.                 for (i = xf_cursor_x; i < max_x_size - 1; i++)
  514.                         screen[adr + i] = screen[adr + i + 1];
  515.  
  516.                 screen[adr + max_x_size - 1] = 0;
  517.  
  518.                 xf_invalidate_screen(xf_cursor_x, xf_cursor_y, max_x_size, xf_cursor_y);
  519.         }
  520.         xf_set_caret();
  521. }
  522.  
  523. /* print a character to cursor pos., no redrawing forced. */
  524. /* check for control chars */
  525. void xf__putc(int c)
  526. {
  527.         static BOOL in_gotoxy = FALSE;
  528.         static int numpars = 0;
  529.         static int params[2];
  530.  
  531.         /* collect coords if in a gotoxy-sequence */
  532.         if (in_gotoxy)
  533.         {
  534.                 params[numpars++] = c;
  535.                 if (numpars == 2)
  536.                 {
  537.                         xf_gotoxy(params[0], params[1]);
  538.                         in_gotoxy = 0;
  539.                 }
  540.         }
  541.         else
  542.         {
  543.                 /* otherwise process character: */
  544.                 switch (c)
  545.                 {
  546.                 /* cursor down (newline) */
  547.                 case 10:
  548.                         xf_new_line();
  549.                         break;
  550.                 /* carriage return */
  551.                 case 13:
  552.                         xf_gotoxy(0, xf_cursor_y);
  553.                         break;
  554.                 /* cursor up */
  555.                 case 11:
  556.                         xf_previous_line();
  557.                         break;
  558.                 /* cursor back 1 char */
  559.                 case 8:
  560.                         xf_previous_char();
  561.                         break;
  562.                 /* cursor advance 1 char */
  563.                 case 9:
  564.                         xf_next_char();
  565.                         break;
  566.                 /* clear screen */
  567.                 case 12:
  568.                         xf_clear_screen();
  569.                         break;
  570.                 /* home cursor */
  571.                 case 30:
  572.                         xf_gotoxy(0,0);
  573.                         break;
  574.                 /* position cursor */
  575.                 case 31:
  576.                         in_gotoxy = TRUE;
  577.                         numpars = 0;
  578.                         break;
  579.                 /* delete char to left of cursor */
  580.                 case 127:
  581.                         xf_back_del();
  582.                         break;
  583.                 /* or just print the char */
  584.                 default:
  585.                         if (c > 31)
  586.                         {
  587.                                 screen[xf_cursor_x + xf_cursor_y * max_x_size] = (char) c;
  588.                                 xf_invalidate_screen(xf_cursor_x, xf_cursor_y, xf_cursor_x, \
  589.                                                                                 xf_cursor_y);
  590.                                 xf_next_char();
  591.                         }
  592.                 }
  593.         }
  594. }
  595.  
  596. /* print a char to cursor os. redrawing forced */
  597. void xf_putchar(int c)
  598. {
  599.         xf__putc(c);
  600.         xf_force_redraw();
  601. }
  602.  
  603. /* print a string to cursor pos. */
  604. void xf_puts(char *string)
  605. {
  606.         int i;
  607.  
  608.         for (i = 0; i < strlen(string); i++)
  609.                 xf__putc(string[i]);
  610.  
  611.         xf_force_redraw();
  612. }
  613.  
  614. /* return a character from the board */
  615. int xf_getchar(void)
  616. {
  617.         int tmpchar;
  618.         BOOL valid = FALSE;
  619.  
  620.         xf_find_caret();
  621.  
  622.         /* don't process null-events while in here */
  623.         event_setmask(WKEYMASK);
  624.  
  625.         /* continue until we can process the key */
  626.         while (!valid)
  627.         {
  628.                 /* wait for a keypress from user */
  629.                 while ((tmpchar = popkey()) == -1)
  630.                 {
  631.                         xf_event_process();
  632.                 }
  633.  
  634.                 if (tmpchar > 0x100)
  635.                         wimp_processkey(tmpchar);
  636.                 else
  637.                         valid = TRUE;
  638.         }
  639.  
  640.         event_setmask(WSTDMASK);
  641.  
  642.         return tmpchar;
  643. }
  644.  
  645. /* clear virtual screen */
  646. void xf_clear_screen(void)
  647. {
  648.         int i;
  649.         /* clear screen */
  650.         for (i=0; i < max_x_size * max_y_size; i++)
  651.                 screen[i] = 0;
  652.  
  653.         /* invalidate total screen */
  654.         xf_invalidate_screen(0, 0, max_x_size, max_y_size);
  655.         xf_force_redraw();
  656.  
  657.         /* reset cursor positions */
  658.         xf_gotoxy(0, 0);
  659. }
  660.  
  661. /* initialize virtual screen */
  662. int xf_init_screen(wimp_w window, screenvar *svar)
  663. {
  664.         wimp_winfo *winfo = (wimp_winfo *) winfo_buffer;
  665.         int win_x_size;
  666.         int win_y_size;
  667.  
  668.         winfo->w = window;
  669.         wimp_get_wind_info(winfo);
  670.  
  671.         /* get maximum wrk area extent */
  672.         win_x_size = winfo->info.ex.x1 - winfo->info.ex.x0;
  673.         win_y_size = winfo->info.ex.y1 - winfo->info.ex.y0;
  674.  
  675.         /* set global variables */
  676.         max_x_size = win_x_size / (svar->xppc << svar->xeigh);
  677.         max_y_size = win_y_size / (svar->yppc << svar->yeigh);
  678.  
  679.         /* allocate screen memory */
  680.         screen = malloc(max_x_size*max_y_size + 1);
  681.         if (screen == NULL)
  682.                 return FALSE;
  683.  
  684.         xf_clear_screen();
  685.  
  686.         return TRUE;
  687. }
  688.  
  689. /*** window routines ***/
  690.  
  691. /* create window, don't open */
  692. int xf_create_window(char *name, wimp_w *handle)
  693. {
  694.         wimp_wind *window;
  695.  
  696.         window = template_syshandle(name);
  697.  
  698.         colors = (3 << 4) | window->colours[wimp_WCWKAREAFORE] ^
  699.                             window->colours[wimp_WCWKAREABACK] ;
  700.  
  701.         if (window == 0)
  702.                 return FALSE;
  703.  
  704.         return (wimpt_complain(wimp_create_wind(window, handle)) == 0);
  705. }
  706.  
  707. /* open window, low level */
  708. int xf_w_open_window(wimp_openstr *ostr)
  709. {
  710.         return (wimpt_complain(wimp_open_wind(ostr)) == 0);
  711. }
  712.  
  713. /* open window, high level */
  714. int xf_open_window(wimp_w wind)
  715. {
  716.         wimp_wstate  win;
  717.         wimp_openstr ostr;
  718.         screenvar *ssize;
  719.         int wxsize, wysize;
  720.         int xpos, ypos;
  721.         int result;
  722.  
  723.         /* tell event system about it */
  724.         win_activeinc();
  725.  
  726.         /* get screensize */
  727.         ssize = xf_get_screen_size();
  728.  
  729.         /* build wimp_openstr */
  730.         wimp_get_wind_state(wind, &win);
  731.         ostr = win.o;
  732.         ostr.behind = -1;
  733.         ostr.x = 0;
  734.         ostr.y = 0;
  735.  
  736.         /* get size of visible work area */
  737.         wxsize = ostr.box.x1 - ostr.box.x0;
  738.         wysize = ostr.box.y1 - ostr.box.y0;
  739.  
  740.         /* pos. of window on screen */
  741.         xpos = ((ssize->xphys << ssize->xeigh) - wxsize)/2;
  742.         ypos = ((ssize->yphys << ssize->yeigh) - wysize)/2;
  743.  
  744.         /* center window on screen */
  745.         ostr.box.x0 = xpos;
  746.         ostr.box.x1 = xpos + wxsize;
  747.         ostr.box.y0 = ypos;
  748.         ostr.box.y1 = ypos + wysize;
  749.  
  750.         /* open window on screen */
  751.         result = xf_w_open_window(&ostr);
  752.  
  753.         /* init underlying screen */
  754.         xf_init_screen(wind, ssize);
  755.  
  756.         return (result != 0);
  757. }
  758.  
  759.  
  760. /*** special window routines ***/
  761.  
  762. static void xf_redraw_main_window(wimp_w window)
  763. {
  764.         BOOL            more;
  765.         wimp_redrawstr  rwind;
  766.         int             ox,oy;
  767.         int             top, left, right, bottom;
  768.         int             i,j;
  769.         int             curchar;
  770.  
  771.         /* get screen coordinates of visible area */
  772.         rwind.w = window;
  773.         wimpt_noerr(wimp_redraw_wind(&rwind, &more));
  774.  
  775.         ox = rwind.box.x0 - rwind.scx;
  776.         oy = rwind.box.y1 - rwind.scy;
  777.  
  778.         /* while there's still something to redraw */
  779.         while (more)
  780.         {
  781.                 /* compute rectangle to redraw */
  782.                 top =           rwind.g.y1 + 1 - oy;
  783.                 left =          rwind.g.x0 - ox;
  784.                 right =         rwind.g.x1 - ox;
  785.                 bottom =        rwind.g.y0 + 1 - oy;
  786.  
  787.                 /* compute textgrid coordinates */
  788.                 top = (-top) / char_y_size;
  789.                 left = left /char_x_size;
  790.                 right = right / char_x_size;
  791.                 bottom = (-bottom) / char_y_size;
  792.  
  793.                 wimp_setcolour(colors);
  794.  
  795.                 /* redraw rectangle */
  796.                 for(j = top; j <= bottom; j++)
  797.                 {
  798.                         for(i = left; i <= right; i++)
  799.                         { 
  800.                                 if ((curchar = screen[j * max_x_size + i]) > 0)
  801.                                 {
  802.                                         bbc_move(ox + (i * char_x_size), oy-1-(j * char_y_size));
  803.                                         bbc_vdu(curchar);
  804.                                 }
  805.                         }
  806.                 }
  807.                 /* get next next rectangle */
  808.                 wimp_get_rectangle(&rwind, &more);
  809.         }
  810.         xf_set_caret();
  811. }
  812.  
  813. /*** event routines ***/
  814.  
  815. /* event handler for main window */
  816. void xf_main_event_handler(wimp_eventstr *event, void *handle)
  817. {
  818.         handle = handle;        /* we get it, but there's no need for it */
  819.  
  820.         /* handle the event */
  821.         switch (event->e)
  822.         {
  823.                 case wimp_EREDRAW:
  824.                         xf_redraw_main_window(event->data.o.w);
  825.                         break;
  826.                 case wimp_EOPEN:
  827.                         xf_w_open_window(&event->data.o);
  828.                         break;
  829.                 case wimp_ECLOSE:
  830.                         xf_closedown();
  831.                         break;
  832.                 case wimp_EKEY:
  833.                         xf_handle_key(event->data.key.chcode);
  834.                         break;
  835.                 case wimp_EBUT:
  836.                         if (event->data.but.m.bbits & (wimp_BLEFT | wimp_BRIGHT))
  837.                                 xf_set_caret();
  838.                         break;
  839.                 default:;
  840.                         /* ignore */
  841.         }
  842. }
  843.  
  844. /* event handler for the menu */
  845. void xf_menu_handler(void *handle, char *sel)
  846. {
  847.         handle = handle;
  848.  
  849.         switch (sel[0])
  850.         {
  851.                 case XF_INFO:
  852.                         xf_prog_info();
  853.                         break;
  854.                 case XF_QUIT:
  855.                         xf_closedown();
  856.                         break;
  857.         }
  858. }
  859.  
  860. /*** Wimp frontend initialisation routine ***/
  861. int xf_init(void)
  862. {
  863.         initing = TRUE;
  864.  
  865.         /* init event system */
  866.         event_setmask(WSTDMASK);
  867.         win_init();
  868.         /* start task */
  869.         wimp_taskinit("XLisp interpreter", &wimp_version, &task_handle);
  870.  
  871.         /* setup system runtime */
  872.         systime.tms_utime = 0;
  873.         systime.tms_stime = 0;
  874.         systime.tms_cutime = 0;
  875.         systime.tms_cstime = 0;
  876.  
  877.         sys_timeslp = get_time();
  878.  
  879.         /* secure floating point op's */
  880.         wimp_save_fp_state_on_poll();
  881.  
  882.         /* initialize resources */
  883.         res_init("XLisp");
  884.         template_init();
  885.         dbox_init();
  886.  
  887.         loadpath = strdup(getenv("Xlisp$lspPath"));
  888.  
  889.         /* the main window */
  890.         if (!xf_create_window("MainWindow", &xf_main_wind))
  891.                 return FALSE;
  892.         /* setup event handler for window, set 'handle' to 0... */
  893.         win_register_event_handler(xf_main_wind, xf_main_event_handler, 0);
  894.  
  895.         /* the menu tree */
  896.         if ((xf_menu = menu_new("XLisp",">Info,Quit")) == NULL)
  897.                 return FALSE;
  898.  
  899.         /* attach menu to window */
  900.         if (!event_attachmenu(xf_main_wind, xf_menu, xf_menu_handler, 0))
  901.                 return FALSE;
  902.  
  903.         xf_open_window(xf_main_wind);
  904.  
  905.         xf_set_caret();
  906.  
  907.         /* init the keyboard buffer */
  908.         init_keybuffer();
  909.  
  910.         initing = FALSE;
  911.  
  912.         return TRUE;
  913. }
  914.  
  915. /*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  916. +*+++++++++++++++++++ WIMP interfacing code end +++++++++++++++++++++++++++
  917. +*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++*/
  918.  
  919.  
  920. /* -- external variables */
  921. extern  FILEP tfp;
  922. extern LVAL xlenv, xlfenv, xldenv;
  923.  
  924. /* -- local variables */
  925. static  char    lbuf[BUFSIZ];
  926. static  int     lpos[BUFSIZ];
  927. int     lposition;  /* export this */
  928. static  int     lindex;
  929. static  int     lcount;
  930.  
  931. char *xfgets(char*, int, FILEP);
  932. char read_keybd(void);
  933. void osx_check(int);
  934. void init_tty(void);
  935. void xinfo(void);
  936.  
  937. /* xsystem - run a process, sending output (if any) to stdout/stderr */
  938. LVAL
  939. xsystem()
  940. {
  941.         extern LVAL     true;
  942.         char            *comstr;
  943.         LVAL            command;
  944.         int             result;
  945.         time_t          stime;
  946.  
  947.         /* get shell command */
  948.         command = xlgastring();
  949.         xllastarg();
  950.  
  951.         comstr = (char *) getstring(command);
  952.  
  953.         /* start external process, measure runtime internally */
  954.         stime = get_time();
  955.         result = system(comstr);
  956.         systime.tms_stime += get_time() - stime;
  957.  
  958.         return (result ? cvfixnum(result) : true);
  959. }
  960.  
  961.  
  962.  
  963. /* osinit - initialize OS for XLISP */
  964. VOID osinit (char *banner)
  965. {
  966.         if (xf_init() != TRUE)
  967.                 exit (-1);
  968.         xf_puts(banner);
  969.         xf_putchar('\n');
  970.  
  971.         init_tty();
  972.         lindex  = 0;
  973.         lcount  = 0;
  974. }
  975.  
  976.  
  977. /* -- osfinish - clean up before returning to the operating system */
  978. VOID osfinish()
  979. {
  980.         xf_closedown();
  981. }
  982.  
  983.  
  984. /* -- xoserror - print an error message */
  985. VOID xoserror(msg)
  986. char         *msg;
  987. {
  988.         werr(0, "error: %s\n", msg );
  989. }
  990.  
  991.  
  992. /* osrand - return next random number in sequence */
  993. long osrand(rseed)
  994.   long rseed;
  995. {
  996.     long k1;
  997.  
  998.     /* make sure we don't get stuck at zero */
  999.     if (rseed == 0L) rseed = 1L;
  1000.  
  1001.     /* algorithm taken from Dr. Dobbs Journal, November 1985, page 91 */
  1002.     k1 = rseed / 127773L;
  1003.     if ((rseed = 16807L * (rseed - k1 * 127773L) - k1 * 2836L) < 0L)
  1004.         rseed += 2147483647L;
  1005.  
  1006.     /* return a random number between 0 and MAXFIX */
  1007.     return rseed;
  1008. }
  1009.  
  1010. /* fix names in the form "[path.]bla.lsp" to become "[path.]lsp.bla" */
  1011. char *fixname(const char *name)
  1012. {
  1013.         char *hname, *hhn;
  1014.         char *retval;
  1015.         int i;
  1016.         char c[FILENAMELEN];
  1017.         char fix[5];
  1018.  
  1019.         retval = strdup((char *)name);
  1020.  
  1021.         hname = retval + (strlen(retval)-3);
  1022.  
  1023.         i = strlen(retval);
  1024.  
  1025.         if (i < 3)
  1026.                 return retval;
  1027.  
  1028.         strcpy(fix, stolower(hname));
  1029.  
  1030.         /* lsp postfix? */
  1031.         if (strcmp(fix, "wks") == 0 || strcmp(fix, "lsp") == 0)
  1032.         {
  1033.                 hhn = hname - 1;
  1034.                 hname -= 2;
  1035.                 while(*hname != '.' && hname > retval)
  1036.                         --hname;
  1037.                 if (*hname == '.')
  1038.                         hname++;
  1039.  
  1040.                 /* then turn it into a prefix for the filename */
  1041.                 strncpy(c, hname, (int) (hhn - hname));
  1042.                 strcpy (hname, strcat(fix,"."));
  1043.                 hname+=4;
  1044.                 strcpy (hname, c);
  1045.                 retval[i] = '\0';
  1046.         }
  1047.  
  1048.         return retval;
  1049. }
  1050.  
  1051. /* open a file trying given and fixed name */
  1052. FILE *osopen (const char *name, const char *mode)
  1053. {
  1054.         int j;
  1055.         FILE *retval = NULL;
  1056.         char tmppath[PATHBUF];
  1057.         char *nname = NULL;
  1058.  
  1059.         /* eval curdir every single time, it may change! */
  1060.         curdir = getenv("XLisp$WorkDir");
  1061.  
  1062.         nname = (char *)name;
  1063.         j = 0;
  1064.         while (retval == NULL && j<2)
  1065.         {
  1066.                 /* first pass: try normal filename */
  1067.                 /* on the second pass fix the postfix-problem */
  1068.                 if (j==1)
  1069.                         nname = fixname(name);
  1070.                 ++j;
  1071.  
  1072.                 tmppath[0] = 0;
  1073.  
  1074.                 if (curdir != NULL)
  1075.                 {
  1076.                         strcpy(tmppath, curdir);
  1077.                         tmppath[strlen(curdir)] = 0;
  1078.                 }
  1079.  
  1080.                 retval = fopen(strcat(tmppath, nname), mode);
  1081.         }
  1082.  
  1083.  
  1084.         if (nname != name)
  1085.                 free(nname);
  1086.  
  1087.         return retval;
  1088. }
  1089.  
  1090. /* open a file, searching along XLisp$lspPath */
  1091. FILE *ospopen(char *name, int ascii)
  1092. {
  1093.         char tmppath[PATHBUF];
  1094.         char *ptr;
  1095.         char *hname;
  1096.         int i,j;
  1097.         FILE *retval = NULL;
  1098.  
  1099.         /* no postfix->prefix translation if absolute path was given. */
  1100.         /* check for ansolute pathname: */
  1101.         /* root, user or current dir */
  1102.         if (name[0] == '$' || name[0] == '@' || name[0] == '&')
  1103.                 retval = fopen(name, "r");
  1104.  
  1105.         /* absolute pathname, starting with a FS specifier */
  1106.         if (retval == NULL)
  1107.         {
  1108.                 i = 0;
  1109.                 while (i < strlen(name) && retval == NULL)
  1110.                 {
  1111.                         if (name[i] == ':')
  1112.                                 retval = fopen(name, "r");
  1113.                         i++;
  1114.                 }
  1115.         }
  1116.  
  1117.         /* try loadpaths */
  1118.         hname = name;
  1119.         j=0;
  1120.         while (retval == NULL && j<2)
  1121.         {
  1122.                 /* first pass: try normal filename */
  1123.                 /* on the second pass fix the postfix-problem */
  1124.                 if (j==1)
  1125.                         hname = fixname(name);
  1126.                 ++j;
  1127.  
  1128.                 ptr = loadpath;
  1129.                 while ((ptr <= loadpath + strlen(loadpath)) && retval == NULL)
  1130.                 {
  1131.                         i = 0;
  1132.                         while (*ptr != ',' && ptr < loadpath + strlen(loadpath))
  1133.                         {
  1134.                                 tmppath[i] = *ptr;
  1135.                                 ++i;
  1136.                                 ++ptr;
  1137.                         }
  1138.                         tmppath[i] = 0;
  1139.  
  1140.                         if (tmppath[0] == 0)
  1141.                                 retval = osopen(name, "r");
  1142.                         else
  1143.                                 retval = fopen(strcat(tmppath, hname), "r");
  1144.                         ++ptr;
  1145.                 }
  1146.         }
  1147.  
  1148.         if (hname != name)
  1149.                 free(hname);
  1150.  
  1151.         return retval;
  1152. }
  1153.  
  1154. /* rename argument file as backup, return success name */
  1155. /* For new systems -- if cannot do it, just return TRUE! */
  1156.  
  1157. int renamebackup(filename)
  1158.   char *filename;
  1159. {
  1160.     return TRUE;
  1161. }
  1162.  
  1163. /* -- ostgetc - get a character from the terminal */
  1164. int ostgetc(void)
  1165. {
  1166.         while(--lcount < 0 )
  1167.         {
  1168.                 if ( xfgets(lbuf,BUFSIZ,stdin) == NULL )
  1169.                         return( EOF );
  1170.  
  1171.                 lcount = strlen( lbuf );
  1172.                 if (tfp!=CLOSED) OSWRITE(lbuf,1,lcount,tfp);
  1173.  
  1174.                 lindex = 0;
  1175.                 lposition = 0;
  1176.         }
  1177.  
  1178.         return( lbuf[lindex++] );
  1179. }
  1180.  
  1181.  
  1182. /* -- ostputc - put a character to the terminal */
  1183. VOID ostputc(ch)
  1184. int     ch;
  1185. {
  1186.         /* -- output the character */
  1187.         xf_putchar(ch);
  1188.  
  1189.         /* -- output the char to the transcript file */
  1190.         if ( tfp != CLOSED )
  1191.                 OSPUTC( ch, tfp );
  1192. }
  1193.  
  1194.  
  1195.  
  1196.  
  1197. /* -- osflush - flush the terminal input buffer */
  1198. VOID osflush()
  1199. {
  1200.         init_keybuffer();
  1201.         lindex = lcount = lposition = 0;
  1202. }
  1203.  
  1204. void oscheck()
  1205. {
  1206.         xf_event_process();
  1207. }
  1208.  
  1209. void osx_check(int ch)
  1210. {
  1211.      switch (ch) {
  1212.         case '\003':
  1213.           xltoplevel(); /* control-c */
  1214.         case '\007':
  1215.           xlcleanup();  /* control-g */
  1216.         case '\020':
  1217.           xlcontinue(); /* control-p */
  1218.         case '\024':    /* control-t */
  1219.           xinfo();
  1220.           xf_puts("\n> ");
  1221.      }
  1222. }
  1223.  
  1224.  
  1225. /* -- ossymbols - enter os-specific symbols */
  1226. VOID ossymbols()
  1227. {
  1228. }
  1229.  
  1230.  
  1231. /* xinfo - show information on control-t */
  1232. VOID xinfo()
  1233. {
  1234.   extern int nfree, gccalls;
  1235.   extern long total;
  1236.   char tymebuf[100];
  1237.   time_t tyme;
  1238.   char buf[500];
  1239.  
  1240.   time(&tyme);
  1241.   strcpy(tymebuf, ctime(&tyme));
  1242.   tymebuf[19] = '\0';
  1243.   sprintf(buf,"\n[ %s Free: %d, GC calls: %d, Total: %ld ]",
  1244.     tymebuf, nfree,gccalls,total);
  1245.   errputstr(buf);
  1246. }
  1247.  
  1248. /* xflush - flush the input line buffer and start a new line */
  1249. VOID xflush()
  1250. {
  1251.   osflush();
  1252.   ostputc('\n');
  1253. }
  1254.  
  1255.  
  1256. char read_keybd()
  1257. {  
  1258.         return(xf_getchar());
  1259. }
  1260.  
  1261. /* xgetkey - get a key from the keyboard */
  1262. LVAL xgetkey()
  1263. {
  1264.     xllastarg();
  1265.     return (cvfixnum((FIXTYPE)read_keybd()));
  1266. }
  1267.  
  1268. VOID xlresetint(dummy)
  1269. int dummy;
  1270. {
  1271.     signal(SIGINT, xlresetint);
  1272.     xltoplevel();
  1273. }
  1274.  
  1275. void init_tty(void)
  1276. {
  1277.         signal(SIGINT, xlresetint);
  1278. }
  1279.  
  1280. char *xfgets(s, n, iop)
  1281. char *s;
  1282. int n;
  1283. register FILE *iop;
  1284. {
  1285.         register c;
  1286.         register char *cs;
  1287.  
  1288.         cs = s;
  1289.         while (--n>0 && (c = read_keybd()) != EOF) {
  1290.              switch(c) {
  1291.                   case '\003' :                 /* CTRL-c */
  1292.                   case '\007' :                 /* CTRL-g */
  1293.                   case '\020' :                 /* CTRL-p */
  1294.                   case '\024' : osx_check(c);   /* CTRL-t */
  1295.                                 n++;
  1296.                                 break;
  1297.  
  1298.                   case 8      :
  1299.                   case 127    : if (cs==s) break;   /* not before beginning */
  1300.                                 stdputstr("\x08 \x08");
  1301.                                 
  1302.                                 n+=2;           
  1303.                                 cs--;
  1304.                                 break;
  1305.  
  1306.                   case '\r'   : c = '\n';
  1307.                                 *cs++ = c;
  1308.                   default     : if (c >= ' ')
  1309.                                         *cs++ = c;      /* character */
  1310.                                 ostputc(c);
  1311.                 }
  1312.                 if (c=='\n') break;
  1313.         }
  1314.         if (c == EOF && cs==s) return(NULL);
  1315.         *cs = '\0';
  1316.         return(s);
  1317. }
  1318.  
  1319. #ifdef TIMES
  1320. /***********************************************************************/
  1321. /**                                                                   **/
  1322. /**                  Time and Environment Functions                   **/
  1323. /**                                                                   **/
  1324. /***********************************************************************/
  1325.  
  1326. unsigned long ticks_per_second() { return((unsigned long) HZ); }
  1327.  
  1328. unsigned long run_tick_count()
  1329. {
  1330.   return((unsigned long) systime.tms_utime + systime.tms_stime );
  1331.   return 0;
  1332. }
  1333.  
  1334. unsigned long real_tick_count()
  1335. {                                  /* Real time */
  1336.   return((unsigned long) get_time());
  1337. }
  1338.  
  1339.  
  1340. LVAL xtime()
  1341. {
  1342.         LVAL expr, result;
  1343.         unsigned long tm, rtm;
  1344.         double dtm, rdtm;
  1345.  
  1346.         /* get the expression to evaluate */
  1347.         expr = xlgetarg();
  1348.         xllastarg();
  1349.  
  1350.         tm = run_tick_count();
  1351.         rtm = real_tick_count();
  1352.         result = xleval(expr);
  1353.         tm = run_tick_count() - tm;
  1354.         rtm = real_tick_count() - rtm;
  1355.         dtm = (tm > 0) ? tm : -tm;
  1356.         rdtm = (rtm > 0) ? rtm : -rtm;
  1357.         sprintf(buf, "CPU %.2f sec., Real %.2f sec.\n", dtm / ticks_per_second(),
  1358.                                                   rdtm / ticks_per_second());
  1359.         trcputstr(buf);
  1360.         return(result);
  1361. }
  1362.  
  1363. LVAL xruntime() 
  1364. {
  1365.         xllastarg();
  1366.         return(cvfixnum((FIXTYPE) run_tick_count()));
  1367. }
  1368.  
  1369. LVAL xrealtime() 
  1370. {
  1371.         xllastarg();
  1372.         return(cvfixnum((FIXTYPE) real_tick_count()));
  1373. }
  1374. #endif
  1375.  
  1376.  
  1377.