From: Arthur Gleckler <edu/mit/csail/zurich/arthur>
Date: Thu, 19 Dec 1991 19:53:03 +0000 (+0000)
Subject: Add graphics primitives:
X-Git-Tag: 20090517-FFI~10029
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=1dee8c955f422b5846116005c00c9bcc92f2460d;p=mit-scheme.git

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 911813210..195f8f1d2 100644
--- 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 b235c9a39..1deab94cc 100644
--- 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),
     }
 }
 
+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 82a250864..916bd3c66 100644
--- 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);
+  }
+}
 
 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 6ea63682c..c9d5423a4 100644
--- 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