home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mitsch75.zip / scheme-7_5_17-src.zip / scheme-7.5.17 / src / microcode / nttterm.c < prev    next >
C/C++ Source or Header  |  2000-12-05  |  3KB  |  92 lines
  1. /* -*-C-*-
  2.  
  3. $Id: nttterm.c,v 1.4 2000/12/05 21:23:46 cph Exp $
  4.  
  5. Copyright (c) 1992-2000 Massachusetts Institute of Technology
  6.  
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or (at
  10. your option) any later version.
  11.  
  12. This program is distributed in the hope that it will be useful, but
  13. WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with this program; if not, write to the Free Software
  19. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. */
  21.  
  22. /* termcap(3) interface for Scheme -- Only a subset needed for Win32. */
  23.  
  24. #include "scheme.h"
  25. #include "prims.h"
  26. #include "osterm.h"
  27.  
  28. extern char * EXFUN (tparam, (char *, char*, int, int, ...));
  29. extern char * EXFUN (tgoto, (char *, int, int));
  30. extern int EXFUN (tputs, (char *, int, void (*) (int)));
  31. extern char * BC;
  32. extern char * UP;
  33. extern char PC;
  34. extern short ospeed;
  35.  
  36. #ifndef TERMCAP_BUFFER_SIZE
  37. #define TERMCAP_BUFFER_SIZE 2048
  38. #endif
  39.  
  40. static char tputs_output [TERMCAP_BUFFER_SIZE];
  41. static char * tputs_output_scan;
  42.  
  43. static void
  44. DEFUN (tputs_write_char, (c), int c)
  45. {
  46.   (*tputs_output_scan++) = c;
  47.   return;
  48. }
  49.  
  50. DEFINE_PRIMITIVE ("TERMCAP-PARAM-STRING", Prim_termcap_param_string, 5, 5, 0)
  51. {
  52.   PRIMITIVE_HEADER (5);
  53.   {
  54.     char * s =
  55.       (tparam ((STRING_ARG (1)), 0, 0,
  56.            (arg_nonnegative_integer (2)),
  57.            (arg_nonnegative_integer (3)),
  58.            (arg_nonnegative_integer (4)),
  59.            (arg_nonnegative_integer (5))));
  60.     SCHEME_OBJECT result = (char_pointer_to_string ((unsigned char *) s));
  61.     free (s);
  62.     PRIMITIVE_RETURN (result);
  63.   }
  64. }
  65.  
  66. DEFINE_PRIMITIVE ("TERMCAP-GOTO-STRING", Prim_termcap_goto_string, 5, 5, 0)
  67. {
  68.   PRIMITIVE_HEADER (5);
  69.   {
  70.     BC = (((ARG_REF (4)) == SHARP_F) ? 0 : (STRING_ARG (4)));
  71.     UP = (((ARG_REF (5)) == SHARP_F) ? 0 : (STRING_ARG (5)));
  72.     PRIMITIVE_RETURN
  73.       (char_pointer_to_string
  74.        ((unsigned char *)
  75.     (tgoto ((STRING_ARG (1)),
  76.         (arg_nonnegative_integer (2)),
  77.         (arg_nonnegative_integer (3))))));
  78.   }
  79. }
  80.  
  81. DEFINE_PRIMITIVE ("TERMCAP-PAD-STRING", Prim_termcap_pad_string, 4, 4, 0)
  82. {
  83.   PRIMITIVE_HEADER (4);
  84.   ospeed = (arg_baud_index (3));
  85.   PC = (((ARG_REF (4)) == SHARP_F) ? '\0' : ((STRING_ARG (4)) [0]));
  86.   tputs_output_scan = tputs_output;
  87.   tputs ((STRING_ARG (1)), (arg_nonnegative_integer (2)), tputs_write_char);
  88.   PRIMITIVE_RETURN
  89.     (memory_to_string ((tputs_output_scan - tputs_output),
  90.                ((unsigned char *) tputs_output)));
  91. }
  92.