home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 254b.lha / AMXLISP_v2.0 / interface-src / asstuff.c < prev    next >
Encoding:
C/C++ Source or Header  |  1989-05-10  |  4.9 KB  |  264 lines
  1. /* asstuff.c - Amiga specific routines */
  2.  
  3. #include "xlisp.h"
  4.  
  5. #ifndef MANX
  6. #define agetc getc   /* Not sure if this will work in all cases (fnf) */
  7. #define aputc putc   /* Not sure if this will work in all cases (fnf) */
  8. #endif
  9.  
  10. #define LBSIZE 200
  11.  
  12. /* external routines */
  13. extern double ran();
  14.  
  15. /* external variables */
  16. extern LVAL s_unbound,true;
  17. extern int prompt;
  18. extern int errno;
  19.  
  20. /* line buffer variables */
  21. static char lbuf[LBSIZE];
  22. static int  lpos[LBSIZE];
  23. static int lindex;
  24. static int lcount;
  25. static int lposition;
  26.  
  27. #define NEW 1006
  28. static long xlispwindow;
  29. extern FILE *tfp;
  30.  
  31. /* osinit - initialize */
  32. osinit(banner)
  33.   char *banner;
  34. {
  35. /* rouaix    extern int Enable_Abort;  */
  36.  
  37. /*    Enable_Abort = 0;     Turn off ^C interrupt in case it's on */
  38.     xlispwindow = Open("RAW:1/1/639/199/Xlisp by David Betz", NEW);
  39.     while (*banner != '\000') {
  40.    xputc (*banner++);
  41.     }
  42.     xputc ('\n');
  43.     lposition = 0;
  44.     lindex = 0;
  45.     lcount = 0;
  46. }
  47.  
  48. osfinish ()
  49. {
  50.     Close (xlispwindow);
  51. }
  52.  
  53. /* osrand - return a random number between 0 and n-1 */
  54. int osrand(n)
  55.   int n;
  56. {
  57.     n = (int)(ran() * (double)n);
  58.     return (n < 0 ? -n : n);
  59. }
  60.  
  61.  
  62.  
  63. /* oscheck - check for control characters during execution */
  64. oscheck()
  65. {
  66.     int ch;
  67.     if (ch = xcheck())
  68.    switch (ch) {
  69.    case '\002':   osflush(); xlbreak("BREAK",s_unbound); break;
  70.    case '\004':   osflush(); xltoplevel(); break;
  71.    }
  72. }
  73.  
  74. /* osflush - flush the input line buffer */
  75. osflush()
  76. {
  77.     lindex = lcount = 0;
  78. }
  79.  
  80. /* xgetc - get a character from the terminal without echo */
  81. static int xgetc()
  82. {
  83.     char ch;
  84.  
  85.     Read (xlispwindow, &ch, 1);
  86.     return (ch & 0xFF);
  87. }
  88.  
  89. /* xputc - put a character to the terminal */
  90. static xputc(ch)
  91.   int ch;
  92. {
  93.     char chout;
  94.  
  95.     chout = ch;
  96.     Write (xlispwindow, &chout, 1L);
  97. }
  98.  
  99. /* xcheck - check for a character */
  100. static int xcheck()
  101. {
  102.     if (WaitForChar (xlispwindow, 0L) == 0L)
  103.    return (0);
  104.     return (xgetc() & 0xFF);
  105. }
  106.  
  107.  
  108.  
  109. double ran ()   /* Just punt for now, not in Manx C; FIXME!!*/
  110. {
  111.    static long seed = 654321;
  112.    long lval;
  113.    double dval;
  114.  
  115.    seed *= ((8 * (123456) - 3));
  116.    lval = seed & 0xFFFF;
  117.    dval = ((double) lval) / ((double) (0x10000));
  118.    return (dval);
  119. }
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  
  127. /* ADDED FOR V2.0 */
  128. /* osclose - close a file */
  129. int osclose(fp)
  130.   FILE *fp;
  131. {
  132.     return (fclose(fp));
  133. }
  134.  
  135. /* ostputc - put a character to the terminal */
  136. ostputc(ch)
  137.   int ch;
  138. {
  139.     /* check for control characters */
  140.     oscheck();
  141.  
  142.     /* output the character */
  143.     if (ch == '\n') {
  144.    xputc('\r'); xputc('\n');
  145.    lposition = 0;
  146.     }
  147.     else {
  148.    xputc(ch);
  149.    lposition++;
  150.    }
  151.  
  152.    /* output the character to the transcript file */
  153.    if (tfp)
  154.    osaputc(ch,tfp);
  155. }
  156. /* ostgetc - get a character from the terminal */
  157. int ostgetc()
  158. {
  159.     int ch;
  160.  
  161.     /* check for a buffered character */
  162.     if (lcount--)
  163.    return (lbuf[lindex++]);
  164.  
  165.     /* get an input line */
  166.     for (lcount = 0; ; )
  167.    switch (ch = xgetc()) {
  168.    case '\r':
  169.       lbuf[lcount++] = '\n';
  170.       xputc('\r'); xputc('\n'); lposition = 0;
  171.       if (tfp)
  172.           for (lindex = 0; lindex < lcount; ++lindex)
  173.          osaputc(lbuf[lindex],tfp);
  174.       lindex = 0; lcount--;
  175.       return (lbuf[lindex++]);
  176.    case '\010':
  177.    case '\177':
  178.       if (lcount) {
  179.           lcount--;
  180.           while (lposition > lpos[lcount]) {
  181.          xputc('\010'); xputc(' '); xputc('\010');
  182.          lposition--;
  183.           }
  184.       }
  185.       break;
  186.    case '\032':
  187.       xflush();
  188.       return (EOF);
  189.    default:
  190.       if (ch == '\t' || (ch >= 0x20 && ch < 0x7F)) {
  191.           lbuf[lcount] = ch;
  192.           lpos[lcount] = lposition;
  193.           if (ch == '\t')
  194.          do {
  195.              xputc(' ');
  196.          } while (++lposition & 7);
  197.           else {
  198.          xputc(ch); lposition++;
  199.           }
  200.           lcount++;
  201.       }
  202.       else {
  203.           xflush();
  204.           switch (ch) {
  205.           case '\003':   xltoplevel();   /* control-c */
  206.           case '\007':   xlcleanup();   /* control-g */
  207.           case '\020':   xlcontinue();   /* control-p */
  208.           case '\032':   return (EOF);   /* control-z */
  209.           default:      return (ch);
  210.           }
  211.       }
  212.    }
  213. }
  214. /* xflush - flush the input line buffer */
  215. static xflush()
  216. {
  217.     ostputc('\n');
  218.     osflush();
  219. }
  220.  
  221. /* osaopen - open an ascii file */
  222. FILE *osaopen(name,mode)
  223.   char *name,*mode;
  224. {
  225.     return (fopen(name,mode));
  226. }
  227. /* oserror - print an error message */
  228. oserror(msg)
  229.   char *msg;
  230. {
  231.     printf("error: %s\n",msg);
  232. }
  233.  
  234. /* xsystem - the built-in function 'system' */
  235. LVAL xsystem()
  236. {
  237.     char *str;
  238.     int result;
  239.  
  240.     /* get the command string */
  241.     str = getstring(xlgastring());
  242.     xllastarg();
  243.     result = Execute(str,0L,xlispwindow);
  244.     return (cvfixnum((FIXTYPE)result));
  245. }
  246.  
  247. /* osagetc - get a character from an ascii file */
  248. int osagetc(fp)
  249.   FILE *fp;
  250. {
  251.     return (getc(fp));
  252. }
  253. /* osaputc - put a character to an ascii file */
  254. int osaputc(ch,fp)
  255.   int ch; FILE *fp;
  256. {
  257.     return (putc(ch,fp));
  258. }
  259. /* ossymbols - lookup important symbols */
  260. ossymbols()
  261. {
  262. }
  263.  
  264.