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 / prostty.c < prev    next >
C/C++ Source or Header  |  1999-01-02  |  5KB  |  154 lines
  1. /* -*-C-*-
  2.  
  3. $Id: prostty.c,v 1.7 1999/01/02 06:11:34 cph Exp $
  4.  
  5. Copyright (c) 1987-1999 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. /* Primitives to perform I/O to and from the console. */
  23.  
  24. #include "scheme.h"
  25. #include "prims.h"
  26. #include "ostty.h"
  27. #include "osctty.h"
  28. #include "osfile.h"
  29. #include "osio.h"
  30.  
  31. DEFINE_PRIMITIVE ("TTY-INPUT-CHANNEL", Prim_tty_input_channel, 0, 0,
  32.   "Return the standard input channel.")
  33. {
  34.   PRIMITIVE_HEADER (0);
  35.   PRIMITIVE_RETURN (long_to_integer (OS_tty_input_channel ()));
  36. }
  37.  
  38. DEFINE_PRIMITIVE ("TTY-OUTPUT-CHANNEL", Prim_tty_output_channel, 0, 0,
  39.   "Return the standard output channel.")
  40. {
  41.   PRIMITIVE_HEADER (0);
  42.   PRIMITIVE_RETURN (long_to_integer (OS_tty_output_channel ()));
  43. }
  44.  
  45. DEFINE_PRIMITIVE ("TTY-X-SIZE", Prim_tty_x_size, 0, 0,
  46.   "Return the display width in character columns.")
  47. {
  48.   PRIMITIVE_HEADER (0);
  49.   PRIMITIVE_RETURN (long_to_integer (OS_tty_x_size ()));
  50. }
  51.  
  52. DEFINE_PRIMITIVE ("TTY-Y-SIZE", Prim_tty_y_size, 0, 0,
  53.   "Return the display height in character lines.")
  54. {
  55.   PRIMITIVE_HEADER (0);
  56.   PRIMITIVE_RETURN (long_to_integer (OS_tty_y_size ()));
  57. }
  58.  
  59. DEFINE_PRIMITIVE ("TTY-COMMAND-BEEP", Prim_tty_command_beep, 0, 0,
  60.   "Return a string that, when written to the display, will make it beep.")
  61. {
  62.   PRIMITIVE_HEADER (0);
  63.   PRIMITIVE_RETURN
  64.     (char_pointer_to_string ((unsigned char *) (OS_tty_command_beep ())));
  65. }
  66.  
  67. DEFINE_PRIMITIVE ("TTY-COMMAND-CLEAR", Prim_tty_command_clear, 0, 0,
  68.   "Return a string that, when written to the display, will clear it.")
  69. {
  70.   PRIMITIVE_HEADER (0);
  71.   PRIMITIVE_RETURN
  72.     (char_pointer_to_string ((unsigned char *) (OS_tty_command_clear ())));
  73. }
  74.  
  75. DEFINE_PRIMITIVE ("TTY-NEXT-INTERRUPT-CHAR", Prim_tty_next_interrupt_char, 0, 0,
  76.   "Return the next interrupt character in the console input buffer.\n\
  77. The character is returned as an unsigned integer.")
  78. {
  79.   PRIMITIVE_HEADER (0);
  80.   PRIMITIVE_RETURN (long_to_integer (OS_tty_next_interrupt_char ()));
  81. }
  82.  
  83. DEFINE_PRIMITIVE ("TTY-GET-INTERRUPT-ENABLES", Prim_tty_get_interrupt_enables, 0, 0,
  84.   "Return the current keyboard interrupt enables.")
  85. {
  86.   PRIMITIVE_HEADER (0);
  87.   {
  88.     Tinterrupt_enables mask;
  89.     OS_ctty_get_interrupt_enables (&mask);
  90.     PRIMITIVE_RETURN (long_to_integer (mask));
  91.   }
  92. }
  93.  
  94. DEFINE_PRIMITIVE ("TTY-SET-INTERRUPT-ENABLES", Prim_tty_set_interrupt_enables, 1, 1,
  95.   "Change the keyboard interrupt enables to MASK.")
  96. {
  97.   PRIMITIVE_HEADER (1);
  98.   {
  99.     Tinterrupt_enables mask = (arg_integer (1));
  100.     OS_ctty_set_interrupt_enables (&mask);
  101.   }
  102.   PRIMITIVE_RETURN (UNSPECIFIC);
  103. }
  104.  
  105. DEFINE_PRIMITIVE ("TTY-GET-INTERRUPT-CHARS", Prim_tty_get_interrupt_chars, 0, 0,
  106.   "Return the current interrupt characters as a string.")
  107. {
  108.   PRIMITIVE_HEADER (0);
  109.   {
  110.     unsigned int i;
  111.     unsigned int num_chars = (OS_ctty_num_int_chars ());
  112.     SCHEME_OBJECT result = (allocate_string (num_chars * 2));
  113.     cc_t * int_chars = (OS_ctty_get_int_chars ());
  114.     cc_t * int_handlers = (OS_ctty_get_int_char_handlers ());
  115.     unsigned char * scan = (STRING_LOC (result, 0));
  116.  
  117.     for (i = 0; i < num_chars; i++)
  118.     {
  119.       (*scan++) = ((unsigned char) int_chars[i]);
  120.       (*scan++) = ((unsigned char) int_handlers[i]);
  121.     }
  122.     PRIMITIVE_RETURN (result);
  123.   }
  124. }
  125.  
  126. DEFINE_PRIMITIVE ("TTY-SET-INTERRUPT-CHARS!", Prim_tty_set_interrupt_chars, 1, 1,
  127.   "Change the current interrupt characters to STRING.\n\
  128. STRING must be in the correct form for this operating system.")
  129. {
  130.   PRIMITIVE_HEADER (1);
  131.   {
  132.     unsigned int i;
  133.     unsigned int num_chars = (OS_ctty_num_int_chars ());
  134.     cc_t * int_chars = (OS_ctty_get_int_chars ());
  135.     cc_t * int_handlers = (OS_ctty_get_int_char_handlers ());
  136.     SCHEME_OBJECT argument = (ARG_REF (1));
  137.     unsigned char * scan;
  138.  
  139.     if (! ((STRING_P (argument))
  140.        && (((unsigned int) (STRING_LENGTH (argument)))
  141.            == (num_chars * 2))))
  142.       error_wrong_type_arg (1);
  143.  
  144.     for (i = 0, scan = (STRING_LOC (argument, 0)); i < num_chars; i++)
  145.     {
  146.       int_chars[i] = (*scan++);
  147.       int_handlers[i] = (*scan++);
  148.     }
  149.     OS_ctty_set_int_chars (int_chars);
  150.     OS_ctty_set_int_char_handlers (int_handlers);
  151.   }
  152.   PRIMITIVE_RETURN (UNSPECIFIC);
  153. }
  154.