home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / xlisp16.arc / PCSTUFF.C < prev    next >
Encoding:
C/C++ Source or Header  |  1986-01-01  |  7.0 KB  |  367 lines
  1. /* pcstuff.c - ibm-pc specific routines */
  2.  
  3. #include "xlisp.h"
  4.  
  5. #define LBSIZE 200
  6.  
  7. /* external routines */
  8. extern double ran();
  9.  
  10. /* external variables */
  11. extern NODE *s_unbound,*true;
  12. extern int prompt;
  13. extern int errno;
  14.  
  15. /* line buffer variables */
  16. static char lbuf[LBSIZE];
  17. static int  lpos[LBSIZE];
  18. static int lindex;
  19. static int lcount;
  20. static int lposition;
  21.  
  22. /* osinit - initialize */
  23. osinit(banner)
  24.   char *banner;
  25. {
  26.     printf("%s\n",banner);
  27.     lposition = 0;
  28.     lindex = 0;
  29.     lcount = 0;
  30. }
  31.  
  32. /* osrand - return a random number between 0 and n-1 */
  33. int osrand(n)
  34.   int n;
  35. {
  36.     n = (int)(ran() * (double)n);
  37.     return (n < 0 ? -n : n);
  38. }
  39.  
  40. /* osgetc - get a character from the terminal */
  41. int osgetc(fp)
  42.   FILE *fp;
  43. {
  44.     int ch;
  45.  
  46.     /* check for input from a file other than stdin */
  47.     if (fp != stdin)
  48.     return (agetc(fp));
  49.  
  50.     /* check for a buffered character */
  51.     if (lcount--)
  52.     return (lbuf[lindex++]);
  53.  
  54.     /* get an input line */
  55.     for (lcount = 0; ; )
  56.     switch (ch = xgetc()) {
  57.     case '\r':
  58.         lbuf[lcount++] = '\n';
  59.         xputc('\r'); xputc('\n'); lposition = 0;
  60.         lindex = 0; lcount--;
  61.         return (lbuf[lindex++]);
  62.     case '\010':
  63.     case '\177':
  64.         if (lcount) {
  65.             lcount--;
  66.             while (lposition > lpos[lcount]) {
  67.             xputc('\010'); xputc(' '); xputc('\010');
  68.             lposition--;
  69.             }
  70.         }
  71.         break;
  72.     case '\032':
  73.         osflush();
  74.         return (EOF);
  75.     default:
  76.         if (ch == '\t' || (ch >= 0x20 && ch < 0x7F)) {
  77.             lbuf[lcount] = ch;
  78.             lpos[lcount] = lposition;
  79.             if (ch == '\t')
  80.             do {
  81.                 xputc(' ');
  82.             } while (++lposition & 7);
  83.             else {
  84.             xputc(ch); lposition++;
  85.             }
  86.             lcount++;
  87.         }
  88.         else {
  89.             osflush();
  90.             switch (ch) {
  91.             case '\003':    xltoplevel();    /* control-c */
  92.             case '\007':    xlcleanup();    /* control-g */
  93.             case '\020':    xlcontinue();    /* control-p */
  94.             case '\032':    return (EOF);    /* control-z */
  95.             default:        return (ch);
  96.             }
  97.         }
  98.     }
  99. }
  100.  
  101. /* osputc - put a character to the terminal */
  102. osputc(ch,fp)
  103.   int ch; FILE *fp;
  104. {
  105.     /* check for output to something other than stdout */
  106.     if (fp != stdout)
  107.     return (aputc(ch,fp));
  108.  
  109.     /* check for control characters */
  110.     oscheck();
  111.  
  112.     /* output the character */
  113.     if (ch == '\n') {
  114.     xputc('\r'); xputc('\n');
  115.     lposition = 0;
  116.     }
  117.     else {
  118.     xputc(ch);
  119.     lposition++;
  120.    }
  121. }
  122.  
  123. /* oscheck - check for control characters during execution */
  124. oscheck()
  125. {
  126.     int ch;
  127.     if (ch = xcheck())
  128.     switch (ch) {
  129.     case '\002':    osflush(); xlbreak("BREAK",s_unbound); break;
  130.     case '\003':    osflush(); xltoplevel(); break;
  131.     }
  132. }
  133.  
  134. /* osflush - flush the input line buffer */
  135. osflush()
  136. {
  137.     lindex = lcount = 0;
  138.     osputc('\n',stdout);
  139.     prompt = 1;
  140. }
  141.  
  142. /* xgetc - get a character from the terminal without echo */
  143. static int xgetc()
  144. {
  145.     return (scr_getc() & 0xFF);
  146. }
  147.  
  148. /* xputc - put a character to the terminal */
  149. static xputc(ch)
  150.   int ch;
  151. {
  152.     scr_putc(ch);
  153. }
  154.  
  155. /* xcheck - check for a character */
  156. static int xcheck()
  157. {
  158.     if (scr_poll() == -1)
  159.     return (0);
  160.     return (scr_getc() & 0xFF);
  161. }
  162.  
  163. /* xdos - execute a dos command */
  164. NODE *xdos(args)
  165.   NODE *args;
  166. {
  167.     char *cmd;
  168.     cmd = xlmatch(STR,&args)->n_str;
  169.     xllastarg(args);
  170.     return (system(cmd) == -1 ? cvfixnum((FIXNUM)errno) : true);
  171. }
  172.  
  173. /* xgetkey - get a key from the keyboard */
  174. NODE *xgetkey(args)
  175.   NODE *args;
  176. {
  177.     xllastarg(args);
  178.     return (cvfixnum((FIXNUM)scr_getc()));
  179. }
  180.  
  181. /* xcursor - set the cursor position */
  182. NODE *xcursor(args)
  183.   NODE *args;
  184. {
  185.     int row,col;
  186.     row = xlmatch(INT,&args)->n_int;
  187.     col = xlmatch(INT,&args)->n_int;
  188.     xllastarg(args);
  189.     scr_curs(row,col);
  190.     return (NIL);
  191. }
  192.  
  193. /* xclear - clear the screen */
  194. NODE *xclear(args)
  195.   NODE *args;
  196. {
  197.     xllastarg(args);
  198.     scr_clear();
  199.     return (NIL);
  200. }
  201.  
  202. /* xeol - clear to end of line */
  203. NODE *xeol(args)
  204.   NODE *args;
  205. {
  206.     xllastarg(args);
  207.     scr_eol();
  208.     return (NIL);
  209. }
  210.  
  211.  
  212. /* xeos - clear to end of screen */
  213. NODE *xeos(args)
  214.   NODE *args;
  215. {
  216.     xllastarg(args);
  217.     scr_eos();
  218.     return (NIL);
  219. }
  220.  
  221. /* xlinsert - insert line */
  222. NODE *xlinsert(args)
  223.   NODE *args;
  224. {
  225.     xllastarg(args);
  226.     scr_linsert();
  227.     return (NIL);
  228. }
  229.  
  230. /* xldelete - delete line */
  231. NODE *xldelete(args)
  232.   NODE *args;
  233. {
  234.     xllastarg(args);
  235.     scr_ldelete();
  236.     return (NIL);
  237. }
  238.  
  239. /* xcinsert - insert character */
  240. NODE *xcinsert(args)
  241.   NODE *args;
  242. {
  243.     xllastarg(args);
  244.     scr_cinsert();
  245.     return (NIL);
  246. }
  247.  
  248. /* xcdelete - delete character */
  249. NODE *xcdelete(args)
  250.   NODE *args;
  251. {
  252.     xllastarg(args);
  253.     scr_cdelete();
  254.     return (NIL);
  255. }
  256.  
  257. /* xinverse - set/clear inverse video */
  258. NODE *xinverse(args)
  259.   NODE *args;
  260. {
  261.     NODE *val;
  262.     val = xlarg(&args);
  263.     xllastarg(args);
  264.     scr_invers(val ? 1 : 0);
  265.     return (NIL);
  266. }
  267.  
  268. /* xline - draw a line */
  269. NODE *xline(args)
  270.   NODE *args;
  271. {
  272.     int x1,y1,x2,y2;
  273.     x1 = xlmatch(INT,&args)->n_int;
  274.     y1 = xlmatch(INT,&args)->n_int;
  275.     x2 = xlmatch(INT,&args)->n_int;
  276.     y2 = xlmatch(INT,&args)->n_int;
  277.     xllastarg(args);
  278.     line(x1,y1,x2,y2);
  279.     return (NIL);
  280. }
  281.  
  282. /* xpoint - draw a point */
  283. NODE *xpoint(args)
  284.   NODE *args;
  285. {
  286.     int x,y;
  287.     x = xlmatch(INT,&args)->n_int;
  288.     y = xlmatch(INT,&args)->n_int;
  289.     xllastarg(args);
  290.     point(x,y);
  291.     return (NIL);
  292. }
  293.  
  294. /* xcircle - draw a circle */
  295. NODE *xcircle(args)
  296.   NODE *args;
  297. {
  298.     int x,y,r;
  299.     x = xlmatch(INT,&args)->n_int;
  300.     y = xlmatch(INT,&args)->n_int;
  301.     r = xlmatch(INT,&args)->n_int;
  302.     xllastarg(args);
  303.     circle(x,y,r);
  304.     return (NIL);
  305. }
  306.  
  307. /* xaspect - set the aspect ratio */
  308. NODE *xaspect(args)
  309.   NODE *args;
  310. {
  311.     int x,y;
  312.     x = xlmatch(INT,&args)->n_int;
  313.     y = xlmatch(INT,&args)->n_int;
  314.     xllastarg(args);
  315.     set_asp(x,y);
  316.     return (NIL);
  317. }
  318.  
  319. /* xcolors - setup the display colors */
  320. NODE *xcolors(args)
  321.   NODE *args;
  322. {
  323.     int c,p,b;
  324.     c = xlmatch(INT,&args)->n_int;
  325.     p = xlmatch(INT,&args)->n_int;
  326.     b = xlmatch(INT,&args)->n_int;
  327.     xllastarg(args);
  328.     color(c);
  329.     palette(p);
  330.     ground(b);
  331.     return (NIL);
  332. }
  333.  
  334. /* xmode - set the display mode */
  335. NODE *xmode(args)
  336.   NODE *args;
  337. {
  338.     int m;
  339.     m = xlmatch(INT,&args)->n_int;
  340.     xllastarg(args);
  341.     mode(m);
  342.     return (NIL);
  343. }
  344.  
  345. /* osfinit - initialize pc specific functions */
  346. osfinit()
  347. {
  348.     xlsubr("DOS",        SUBR,    xdos);
  349.     xlsubr("GET-KEY",        SUBR,    xgetkey);
  350.     xlsubr("SET-CURSOR",    SUBR,    xcursor);
  351.     xlsubr("CLEAR",        SUBR,    xclear);
  352.     xlsubr("CLEAR-EOL",        SUBR,    xeol);
  353.     xlsubr("CLEAR-EOS",        SUBR,    xeos);
  354.     xlsubr("INSERT-LINE",    SUBR,    xlinsert);
  355.     xlsubr("DELETE-LINE",    SUBR,    xldelete);
  356.     xlsubr("INSERT-CHAR",    SUBR,    xcinsert);
  357.     xlsubr("DELETE-CHAR",    SUBR,    xcdelete);
  358.     xlsubr("SET-INVERSE",    SUBR,    xinverse);
  359.     xlsubr("LINE",         SUBR,    xline);
  360.     xlsubr("POINT",        SUBR,    xpoint);
  361.     xlsubr("CIRCLE",        SUBR,    xcircle);
  362.     xlsubr("ASPECT-RATIO",    SUBR,    xaspect);
  363.     xlsubr("COLORS",        SUBR,    xcolors);
  364.     xlsubr("MODE",         SUBR,    xmode);
  365. }
  366.  
  367.