Extend X graphics support to handle the new primitives

X-FONT-STRUCTURE and X-GRAPHICS-COPY-AREA.

Add a selector operations for X-FONT-STRUCTURE, the object returned
by the X-FONT-STRUCTURE operation, and for X-CHARACTER-BOUNDS, part
of the X-FONT-STRUCTURE.

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index e7f63df3c8aa526d7f024ab5b594bcd60ba2ccbc..0a4f2fa4304d156d69060193a001bc06782c7ed8 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.128 1991/11/26 07:07:00 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.129 1991/12/19 20:50:17 arthur Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -2046,7 +2046,22 @@ MIT in each case. |#
          x-image/set-pixel
          x-image/width
          x-image?
-         x-open-display)
+         x-open-display
+         x-font-structure/name
+         x-font-structure/direction
+         x-font-structure/all-chars-exist
+         x-font-structure/default-char
+         x-font-structure/min-bounds
+         x-font-structure/max-bounds
+         x-font-structure/start-index
+         x-font-structure/character-bounds
+         x-font-structure/max-ascent
+         x-font-structure/max-descent
+         x-character-bounds/lbearing
+         x-character-bounds/rbearing
+         x-character-bounds/width
+         x-character-bounds/ascent
+         x-character-bounds/descent)
   (initialization (initialize-package!)))
 
 (define-package (runtime starbase-graphics)

diff --git a/v7/src/runtime/version.scm b/v7/src/runtime/version.scm
index c19651b2cfc8f697716644f83c895bdc24c43a47..e325f775ae35119d62300ae1effe4b887ce09e91 100644 (file)
--- a/v7/src/runtime/version.scm
+++ b/v7/src/runtime/version.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.142 1991/11/26 07:07:15 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.143 1991/12/19 20:51:42 arthur Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -45,7 +45,7 @@ MIT in each case. |#
                     '()))
   (add-system! microcode-system)
   (add-event-receiver! event:after-restore snarf-microcode-version!)
-  (add-identification! "Runtime" 14 142))
+  (add-identification! "Runtime" 14 143))
 
 (define microcode-system)
 

diff --git a/v7/src/runtime/x11graph.scm b/v7/src/runtime/x11graph.scm
index ccf8599dab1c51d3af433be5b60fc9afe30df7c1..fdecb2505ac6b0282868bba8b34ffadd5ac4b11a 100644 (file)
--- a/v7/src/runtime/x11graph.scm
+++ b/v7/src/runtime/x11graph.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/x11graph.scm,v 1.10 1991/07/23 08:19:26 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/x11graph.scm,v 1.11 1991/12/19 20:49:59 arthur Exp $
 
 Copyright (c) 1989-91 Massachusetts Institute of Technology
 
@@ -46,6 +46,7 @@ MIT in each case. |#
   (x-display-flush 1)
   (x-display-get-default 3)
   (x-display-process-events 2)
+  (x-font-structure 2)
   (x-window-x-size 1)
   (x-window-y-size 1)
   (x-window-map 1)
@@ -75,6 +76,7 @@ MIT in each case. |#
   (x-graphics-draw-line 5)
   (x-graphics-draw-point 3)
   (x-graphics-draw-string 4)
+  (x-graphics-copy-area 7)
   (x-graphics-set-function 2)
   (x-graphics-set-fill-style 2)
   (x-graphics-set-line-style 2)
@@ -140,6 +142,7 @@ MIT in each case. |#
           (clear ,operation/clear)
           (close ,operation/close)
           (coordinate-limits ,operation/coordinate-limits)
+          (copy-area ,operation/copy-area)
           (create-colormap ,operation/create-colormap)
           (create-image ,operation/create-image)
           (device-coordinate-limits ,operation/device-coordinate-limits)
@@ -148,6 +151,7 @@ MIT in each case. |#
           (draw-point ,operation/draw-point)
           (draw-text ,operation/draw-text)
           (flush ,operation/flush)
+          (font-structure ,operation/font-structure)
           (get-colormap ,operation/get-colormap)
           (get-default ,operation/get-default)
           (map-window ,operation/map-window)
@@ -224,6 +228,16 @@ MIT in each case. |#
            (vector-ref limits 2)
            (vector-ref limits 3))))
 
+(define (operation/copy-area device
+                            source-x-left source-y-top
+                            width height
+                            destination-x-left destination-y-top)
+  (x-graphics-device/process-events! device)
+  (x-graphics-copy-area (x-graphics-device/window device)
+                       source-x-left source-y-top
+                       width height
+                       destination-x-left destination-y-top))
+
 (define (operation/device-coordinate-limits device)
   (x-graphics-device/process-events! device)
   (let ((xw (x-graphics-device/window device)))
@@ -250,6 +264,10 @@ MIT in each case. |#
   (x-display-flush (x-graphics-device/display device))
   (x-graphics-device/process-events! device))
 
+(define (operation/font-structure device string)
+  (x-graphics-device/process-events! device)
+  (x-font-structure (x-graphics-device/display device) string))
+
 (define (operation/get-default device resource-name class-name)
   (x-graphics-device/process-events! device)
   (x-display-get-default (x-graphics-device/display device)
@@ -488,4 +506,27 @@ MIT in each case. |#
   (x-store-color (colormap/descriptor colormap) position r g b))
 
 (define (x-colormap/store-colors colormap color-vector)
-  (x-store-colors (colormap/descriptor colormap) color-vector))
\ No newline at end of file
+  (x-store-colors (colormap/descriptor colormap) color-vector))
+\f
+;;;; Fonts
+
+(define-structure (x-font-structure (conc-name font-structure/)
+                                   (type vector))
+  (name false read-only true)
+  (direction false read-only true)
+  (all-chars-exist? false read-only true)
+  (default-char false read-only true)
+  (min-bounds false read-only true)
+  (max-bounds false read-only true)
+  (start-index false read-only true)
+  (character-bounds false read-only true)
+  (max-ascent false read-only true)
+  (max-descent false read-only true))
+
+(define-structure (x-character-bounds (conc-name character-bounds/)
+                                     (type vector))
+  (lbearing false read-only true)
+  (rbearing false read-only true)
+  (width false read-only true)
+  (ascent false read-only true)
+  (descent false read-only true))
\ No newline at end of file

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index 89f04e741fbf8297dd60f82e3ba03d02cf364bef..7632ff23da8fc34c5de87a903673164e2d344d7c 100644 (file)
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.128 1991/11/26 07:07:00 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.129 1991/12/19 20:50:17 arthur Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -2046,7 +2046,22 @@ MIT in each case. |#
          x-image/set-pixel
          x-image/width
          x-image?
-         x-open-display)
+         x-open-display
+         x-font-structure/name
+         x-font-structure/direction
+         x-font-structure/all-chars-exist
+         x-font-structure/default-char
+         x-font-structure/min-bounds
+         x-font-structure/max-bounds
+         x-font-structure/start-index
+         x-font-structure/character-bounds
+         x-font-structure/max-ascent
+         x-font-structure/max-descent
+         x-character-bounds/lbearing
+         x-character-bounds/rbearing
+         x-character-bounds/width
+         x-character-bounds/ascent
+         x-character-bounds/descent)
   (initialization (initialize-package!)))
 
 (define-package (runtime starbase-graphics)