Add graphics primitives:

  X-FONT-STRUCTURE
    Given an X display and the name of a font, return a Scheme
    equivalent of the X font structure, which describes the dimensions
    of each character, etc.

  X-GRAPHICS-COPY-AREA
    Given an X window and coordinates describing two rectangles in it,
    move the contents of the first rectangle to the other.

diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h
index 911813210a8ef75dd07061d9f3004fe1351ed081..195f8f1d20e6ec6ebc4eab2c2574343edc885d03 100644 (file)
--- a/v7/src/microcode/version.h
+++ b/v7/src/microcode/version.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.101 1991/11/04 21:17:50 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.102 1991/12/19 19:53:03 arthur Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -46,5 +46,5 @@ MIT in each case. */
 #define VERSION                11
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION     101
+#define SUBVERSION     102
 #endif

diff --git a/v7/src/microcode/x11base.c b/v7/src/microcode/x11base.c
index b235c9a3957d6609a700769f4691b976603b7e18..1deab94ccc945f350d5bbf6bc41df6505743440f 100644 (file)
--- a/v7/src/microcode/x11base.c
+++ b/v7/src/microcode/x11base.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11base.c,v 1.27 1991/10/29 22:55:11 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11base.c,v 1.28 1991/12/19 19:52:51 arthur Exp $
 
 Copyright (c) 1989-91 Massachusetts Institute of Technology
 
@@ -413,7 +413,7 @@ DEFUN (x_window_to_xw, (window), Window window)
   return (0);
 }
 extern void x_destroy_image ();
-    
+
 static void
 DEFUN (x_close_window, (xw), struct xwindow * xw)
 {
@@ -808,6 +808,8 @@ DEFUN (xd_process_events, (xd, non_block_p),
     }
 }
 \f
+extern XFontStruct * saved_font;
+
 static void
 DEFUN_VOID (initialize_once)
 {
@@ -817,6 +819,7 @@ DEFUN_VOID (initialize_once)
   XSetErrorHandler (x_error_handler);
   XSetIOErrorHandler (x_io_error_handler);
   add_reload_cleanup (x_close_all_displays);
+  saved_font = 0;
   initialization_done = 1;
 }
 
@@ -1158,6 +1161,92 @@ DEFINE_PRIMITIVE ("X-WINDOW-SET-FONT", Prim_x_window_set_font, 2, 2, 0)
   PRIMITIVE_RETURN (SHARP_T);
 }
 
+static SCHEME_OBJECT
+DEFUN (convert_char_struct, (char_struct), XCharStruct * char_struct)
+{
+  SCHEME_OBJECT char_structure;
+
+  if (((char_struct -> lbearing) == 0)
+      && ((char_struct -> rbearing) == 0)
+      && ((char_struct -> width) == 0)
+      && ((char_struct -> ascent) == 0)
+      && ((char_struct -> descent) == 0))
+
+    {
+      return (SHARP_F);
+    }
+  char_structure = (allocate_marked_vector (TC_VECTOR, 5, true));
+
+  VECTOR_SET (char_structure, 0, (long_to_integer (char_struct -> lbearing)));
+  VECTOR_SET (char_structure, 1, (long_to_integer (char_struct -> rbearing)));
+  VECTOR_SET (char_structure, 2, (long_to_integer (char_struct -> width)));
+  VECTOR_SET (char_structure, 3, (long_to_integer (char_struct -> ascent)));
+  VECTOR_SET (char_structure, 4, (long_to_integer (char_struct -> descent)));
+  return (char_structure);
+}
+
+XFontStruct * saved_font;
+
+DEFINE_PRIMITIVE ("X-FONT-STRUCTURE", Prim_x_font_structure, 2, 2, 0)
+{
+  PRIMITIVE_HEADER (2);
+  {
+    SCHEME_OBJECT result = (allocate_marked_vector (TC_VECTOR, 10, true));
+    SCHEME_OBJECT font_name = ARG_REF (2);
+    Display * display = (XD_DISPLAY (x_display_arg (1)));
+
+    if (saved_font == 0)
+      {
+       saved_font = (XLoadQueryFont
+                     (display, (char *) (STRING_LOC (font_name, 0))));
+       if (saved_font == 0)
+         {
+           PRIMITIVE_RETURN (SHARP_F);
+         }
+      }
+    /* Handle only 8-bit fonts because of laziness. */
+    if (((saved_font -> min_byte1) != 0) || ((saved_font -> max_byte1) != 0))
+      {
+       XFreeFont (display, saved_font);
+       saved_font = 0;
+       PRIMITIVE_RETURN (SHARP_F);
+      }
+    if ((saved_font -> per_char) == NULL)
+      {
+       VECTOR_SET (result, 6, SHARP_F);
+      }
+    else
+      {
+       unsigned int start_index = (saved_font -> min_char_or_byte2);
+       unsigned int end_index = (saved_font -> max_char_or_byte2);
+       unsigned int index;
+       SCHEME_OBJECT character_vector =
+         (allocate_marked_vector
+          (TC_VECTOR, (end_index - start_index + 1), true));
+       for (index = start_index; index <= end_index; index++)
+         {
+           VECTOR_SET (character_vector,
+                       (index - start_index),
+                       convert_char_struct ((saved_font -> per_char) + index));
+         }
+       VECTOR_SET (result, 6, (long_to_integer (start_index)));
+       VECTOR_SET (result, 7, character_vector);
+      }
+    VECTOR_SET (result, 0, font_name);
+    VECTOR_SET (result, 1, (long_to_integer (saved_font -> direction)));
+    VECTOR_SET (result, 2, (BOOLEAN_TO_OBJECT
+                           ((saved_font -> all_chars_exist) == True)));
+    VECTOR_SET (result, 3, (long_to_integer (saved_font -> default_char)));
+    VECTOR_SET (result, 4, convert_char_struct (& (saved_font -> min_bounds)));
+    VECTOR_SET (result, 5, convert_char_struct (& (saved_font -> max_bounds)));
+    VECTOR_SET (result, 8, (long_to_integer (saved_font -> ascent)));
+    VECTOR_SET (result, 9, (long_to_integer (saved_font -> descent)));
+    XFreeFont (display, saved_font);
+    saved_font = 0;
+    PRIMITIVE_RETURN (result);
+  }
+}
+
 DEFINE_PRIMITIVE ("X-WINDOW-SET-BORDER-WIDTH", Prim_x_window_set_border_width, 2, 2, 0)
 {
   PRIMITIVE_HEADER (2);

diff --git a/v7/src/microcode/x11graph.c b/v7/src/microcode/x11graph.c
index 82a250864ad9bb8f4d3c845a33a465d49851b801..916bd3c660ac9204203c29f7aaaca55f7ee8d520 100644 (file)
--- a/v7/src/microcode/x11graph.c
+++ b/v7/src/microcode/x11graph.c
@@ -1,7 +1,7 @@
 
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11graph.c,v 1.17 1991/10/02 21:16:39 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11graph.c,v 1.18 1991/12/19 19:52:39 arthur Exp $
 
 Copyright (c) 1989-91 Massachusetts Institute of Technology
 
@@ -529,6 +529,29 @@ DEFINE_PRIMITIVE ("X-GRAPHICS-SET-DASHES", Prim_x_graphics_set_dashes, 3, 3, 0)
   }
   PRIMITIVE_RETURN (UNSPECIFIC);
 }
+
+DEFINE_PRIMITIVE ("X-GRAPHICS-COPY-AREA", Prim_x_graphics_copy_area, 7, 7, 0)
+{
+  PRIMITIVE_HEADER (7);
+  {
+    struct xwindow * xw = x_window_arg (1);
+    unsigned int internal_border_width = (XW_INTERNAL_BORDER_WIDTH (xw));
+    float device_width = ((XW_X_SLOPE (xw)) * (arg_real_number (4)));
+    float device_height = ((XW_Y_SLOPE (xw)) * (arg_real_number (5)));
+
+    XCopyArea ((XW_DISPLAY (xw)),
+              (XW_WINDOW (xw)),
+              (XW_WINDOW (xw)),
+              (XW_NORMAL_GC (xw)),
+              (internal_border_width + (arg_x_coordinate (2, xw))),
+              (internal_border_width + (arg_y_coordinate (3, xw))),
+              (ROUND_FLOAT (device_width)),
+              (ROUND_FLOAT (device_height)),
+              (internal_border_width + (arg_x_coordinate (6, xw))),
+              (internal_border_width + (arg_y_coordinate (7, xw))));
+    PRIMITIVE_RETURN (UNSPECIFIC);
+  }
+}
 \f
 DEFINE_PRIMITIVE ("X-CREATE-IMAGE", Prim_x_create_image, 3, 3,
   "Arguments: Window, width, height\n\

diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h
index 6ea63682c77ed5cae344f724a4d9a864d6fd481a..c9d5423a453887d38be3d465d669d24c43794f3f 100644 (file)
--- a/v8/src/microcode/version.h
+++ b/v8/src/microcode/version.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.101 1991/11/04 21:17:50 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.102 1991/12/19 19:53:03 arthur Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -46,5 +46,5 @@ MIT in each case. */
 #define VERSION                11
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION     101
+#define SUBVERSION     102
 #endif