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 / sgx.c < prev    next >
C/C++ Source or Header  |  1999-01-02  |  8KB  |  291 lines
  1. /* -*-C-*-
  2.  
  3. $Id: sgx.c,v 1.9 1999/01/02 06:11:34 cph Exp $
  4.  
  5. Copyright (c) 1988-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. /* Simple X graphics for HP 9000 series 300 machines. */
  23.  
  24. #include <X/Xlib.h>
  25. #include <X/Xhp.h>
  26. #include "scheme.h"
  27. #include "prims.h"
  28. #include "sgraph.h"
  29.  
  30. static Display * display = NULL;
  31. static Window window = 0;
  32. static char filename [1024] = "";
  33. static int raster_state = 0;
  34.  
  35. static void close_display ();
  36. static void close_window ();
  37. static void delete_raster ();
  38.  
  39. #define GUARANTEE_DISPLAY()                        \
  40. {                                    \
  41.   if (display == NULL)                            \
  42.     error_external_return ();                        \
  43. }
  44.  
  45. #define GUARANTEE_WINDOW()                        \
  46. {                                    \
  47.   if (window == 0)                            \
  48.     error_external_return ();                        \
  49. }
  50.  
  51. #define GUARANTEE_RASTER()                        \
  52. {                                    \
  53.   GUARANTEE_WINDOW ();                            \
  54.   if (raster_state == 0)                        \
  55.     error_external_return ();                        \
  56. }
  57.  
  58. static int
  59. x_io_error_handler (display)
  60.      Display *display;
  61. {
  62.   fprintf (stderr, "\nX IO Error\n");
  63.   error_external_return ();
  64. }
  65.  
  66. static int
  67. x_error_handler (display, error_event)
  68.      Display *display;
  69.      XErrorEvent *error_event;
  70. {
  71.   fprintf (stderr, "\nX Error: %s\n",
  72.        (XErrDescrip (error_event -> error_code)));
  73.   fprintf (stderr, "         Request code: %d\n",
  74.        (error_event -> request_code));
  75.   fprintf (stderr, "         Request function: %d\n", (error_event -> func));
  76.   fprintf (stderr, "         Request window: %x\n", (error_event -> window));
  77.   fprintf (stderr, "         Error serial: %x\n", (error_event -> serial));
  78.   error_external_return ();
  79. }
  80.  
  81. DEFINE_PRIMITIVE ("X-GRAPHICS-OPEN-DISPLAY", Prim_x_graphics_open_display, 1, 1,
  82.   "Opens display DISPLAY-NAME.  DISPLAY-NAME may be #F, in which case the\n\
  83. default display is opened (based on the DISPLAY environment\n\
  84. variable).  Returns #T if the open succeeds, #F otherwise.\n\
  85. \n\
  86. This primitive is additionally useful for determining whether the\n\
  87. X server is running on the named display.")
  88. {
  89.   PRIMITIVE_HEADER (1);
  90.   /* Only one display at a time. */
  91.   close_display ();
  92.   /* Grab error handlers. */
  93.   XErrorHandler (x_error_handler);
  94.   XIOErrorHandler (x_io_error_handler);
  95.   display =
  96.     (XOpenDisplay (((ARG_REF (1)) == SHARP_F) ? NULL : (STRING_ARG (1))));
  97.   window = 0;
  98.   (filename [0]) = '\0';
  99.   raster_state = 0;
  100.   PRIMITIVE_RETURN (BOOLEAN_TO_OBJECT (display != NULL));
  101. }
  102.  
  103. DEFINE_PRIMITIVE ("X-GRAPHICS-CLOSE-DISPLAY", Prim_x_graphics_close_display, 0, 0, 0)
  104. {
  105.   PRIMITIVE_HEADER (0);
  106.   close_display ();
  107.   PRIMITIVE_RETURN (UNSPECIFIC);
  108. }
  109.  
  110. static void
  111. close_display ()
  112. {
  113.   if (display != NULL)
  114.     {
  115.       close_window ();
  116.       XCloseDisplay (display);
  117.       display = NULL;
  118.     }
  119.   return;
  120. }
  121.  
  122. /* (X-GRAPHICS-OLD-OPEN-WINDOW x y width height border-width)
  123.    Opens a window at the given position, with the given border width,
  124.    on the current display.  If another window was previously opened
  125.    using this primitive, it is closed.  */
  126.  
  127. DEFINE_PRIMITIVE ("X-GRAPHICS-OLD-OPEN-WINDOW", Prim_x_graphics_old_open_window, 5, 5, 0)
  128. {
  129.   XhpArgItem arglist [7];
  130.   PRIMITIVE_HEADER (5);
  131.   GUARANTEE_DISPLAY ();
  132.   /* Allow only one window open at a time. */
  133.   close_window ();
  134.   /* Open the window with the given arguments. */
  135.   window =
  136.     (XCreateWindow (RootWindow,
  137.             (arg_nonnegative_integer (1)),
  138.             (arg_nonnegative_integer (2)),
  139.             (arg_nonnegative_integer (3)),
  140.             (arg_nonnegative_integer (4)),
  141.             (arg_nonnegative_integer (5)),
  142.             WhitePixmap,
  143.             BlackPixmap));
  144.   if (window == 0)
  145.     error_external_return ();
  146.   XStoreName (window, "scheme-graphics");
  147.   XFlush ();
  148.   (filename [0]) = '\0';
  149.   raster_state = 0;
  150.   /* Create a starbase device file. */
  151.   if ((XhpFile ((& (filename [0])), window, display)) == 0)
  152.     {
  153.       (filename [0]) = '\0';
  154.       close_window ();
  155.       error_external_return ();
  156.     }
  157.   /* Return the filename so it can be passed to starbase. */
  158.   PRIMITIVE_RETURN (char_pointer_to_string (& (filename [0])));
  159. }
  160.  
  161. DEFINE_PRIMITIVE ("X-GRAPHICS-CLOSE-WINDOW", Prim_x_graphics_close_window, 0, 0, 0)
  162. {
  163.   PRIMITIVE_HEADER (0);
  164.   close_window ();
  165.   PRIMITIVE_RETURN (UNSPECIFIC);
  166. }
  167.  
  168. static void
  169. close_window ()
  170. {
  171.   sb_close_device ();
  172.   if ((filename [0]) != '\0')
  173.     {
  174.       XhpDestroy (filename);
  175.       (filename [0]) = '\0';
  176.     }
  177.   if (window != 0)
  178.     {
  179.       delete_raster ();
  180.       XDestroyWindow (window);
  181.       XFlush ();
  182.       window = 0;
  183.     }
  184.   return;
  185. }
  186.  
  187. DEFINE_PRIMITIVE ("X-GRAPHICS-MAP-WINDOW", Prim_x_graphics_map_window, 0, 0, 0)
  188. {
  189.   PRIMITIVE_HEADER (0);
  190.   GUARANTEE_WINDOW ();
  191.   XMapWindow (window);
  192.   XFlush ();
  193.   PRIMITIVE_RETURN (UNSPECIFIC);
  194. }
  195.  
  196. DEFINE_PRIMITIVE ("X-GRAPHICS-UNMAP-WINDOW", Prim_x_graphics_unmap_window, 0, 0, 0)
  197. {
  198.   PRIMITIVE_HEADER (0);
  199.   GUARANTEE_WINDOW ();
  200.   XUnmapWindow (window);
  201.   XFlush ();
  202.   PRIMITIVE_RETURN (UNSPECIFIC);
  203. }
  204.  
  205. DEFINE_PRIMITIVE ("X-GRAPHICS-RAISE-WINDOW", Prim_x_graphics_raise_window, 0, 0, 0)
  206. {
  207.   PRIMITIVE_HEADER (0);
  208.   GUARANTEE_WINDOW ();
  209.   XRaiseWindow (window);
  210.   XFlush ();
  211.   PRIMITIVE_RETURN (UNSPECIFIC);
  212. }
  213.  
  214. DEFINE_PRIMITIVE ("X-GRAPHICS-LOWER-WINDOW", Prim_x_graphics_lower_window, 0, 0, 0)
  215. {
  216.   PRIMITIVE_HEADER (0);
  217.   GUARANTEE_WINDOW ();
  218.   XLowerWindow (window);
  219.   XFlush ();
  220.   PRIMITIVE_RETURN (UNSPECIFIC);
  221. }
  222.  
  223. DEFINE_PRIMITIVE ("X-GRAPHICS-CONFIGURE-WINDOW", Prim_x_graphics_configure_window, 4, 4, 0)
  224. {
  225.   PRIMITIVE_HEADER (4);
  226.   GUARANTEE_WINDOW ();
  227.   if (raster_state != 0)
  228.     error_external_return ();
  229.   XConfigureWindow
  230.     (window,
  231.      (arg_nonnegative_integer (1)),
  232.      (arg_nonnegative_integer (2)),
  233.      (arg_nonnegative_integer (3)),
  234.      (arg_nonnegative_integer (4)));
  235.   XFlush ();
  236.   PRIMITIVE_RETURN (UNSPECIFIC);
  237. }
  238.  
  239. /* Routines to control the backup raster. */
  240.  
  241. DEFINE_PRIMITIVE ("X-GRAPHICS-CREATE-RASTER", Prim_x_graphics_create_raster, 0, 0, 0)
  242. {
  243.   PRIMITIVE_HEADER (0);
  244.   GUARANTEE_WINDOW ();
  245.   delete_raster ();
  246.   XhpRetainWindow (window, XhpCREATE_RASTER);
  247.   XFlush ();
  248.   raster_state = 1;
  249.   PRIMITIVE_RETURN (UNSPECIFIC);
  250. }
  251.  
  252. DEFINE_PRIMITIVE ("X-GRAPHICS-DELETE-RASTER", Prim_x_graphics_delete_raster, 0, 0, 0)
  253. {
  254.   PRIMITIVE_HEADER (0);
  255.   GUARANTEE_WINDOW ();
  256.   delete_raster ();
  257.   PRIMITIVE_RETURN (UNSPECIFIC);
  258. }
  259.  
  260. static void
  261. delete_raster ()
  262. {
  263.   if (raster_state != 0)
  264.     {
  265.       XhpRetainWindow (window, XhpDELETE_RASTER);
  266.       XFlush ();
  267.       raster_state = 0;
  268.     }
  269.   return;
  270. }
  271.  
  272. DEFINE_PRIMITIVE ("X-GRAPHICS-START-RETAIN", Prim_x_graphics_start_retain, 0, 0, 0)
  273. {
  274.   PRIMITIVE_HEADER (0);
  275.   GUARANTEE_WINDOW ();
  276.   GUARANTEE_RASTER ();
  277.   XhpRetainWindow (window, XhpSTART_RETAIN);
  278.   XFlush ();
  279.   PRIMITIVE_RETURN (UNSPECIFIC);
  280. }
  281.  
  282. DEFINE_PRIMITIVE ("X-GRAPHICS-STOP-RETAIN", Prim_x_graphics_stop_retain, 0, 0, 0)
  283. {
  284.   PRIMITIVE_HEADER (0);
  285.   GUARANTEE_WINDOW ();
  286.   GUARANTEE_RASTER ();
  287.   XhpRetainWindow (window, XhpSTOP_RETAIN);
  288.   XFlush ();
  289.   PRIMITIVE_RETURN (UNSPECIFIC);
  290. }
  291.