Change graphics operations to receive the device, not just the

descriptor, of the graphics object on which they are operating.

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index e9b4c6e01175355726c4079c6f2d4eeb9e6a4418..caf5f7b25a133c7ed10307d6b44d6eedb7455db1 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.130 1992/01/23 19:15:49 arthur Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/runtime.pkg,v 14.131 1992/01/30 00:38:28 arthur Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -2004,6 +2004,7 @@ MIT in each case. |#
          graphics-coordinate-limits
          graphics-device?
          graphics-device-coordinate-limits
+         graphics-device/descriptor
          graphics-device/properties
          graphics-disable-buffering
          graphics-drag-cursor

diff --git a/v7/src/runtime/starbase.scm b/v7/src/runtime/starbase.scm
index eb23b16a65ab0582e8c1ee5724328726bb52f621..8b863332219ac92854730a6a157f719afa0811ba 100644 (file)
--- a/v7/src/runtime/starbase.scm
+++ b/v7/src/runtime/starbase.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/starbase.scm,v 1.5 1991/11/04 20:30:02 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/starbase.scm,v 1.6 1992/01/30 00:38:38 arthur Exp $
 
 Copyright (c) 1989-91 Massachusetts Institute of Technology
 
@@ -98,10 +98,10 @@ MIT in each case. |#
 
 (define starbase-graphics-device-type)
 
-(define-structure (starbase-device
-                  (conc-name starbase-device/)
-                  (constructor make-starbase-device (descriptor)))
-  (descriptor false read-only true)
+(define-structure (starbase-graphics-descriptor
+                  (conc-name starbase-descriptor/)
+                  (constructor make-starbase-descriptor (identifier)))
+  (identifier false read-only true)
   x-left
   y-bottom
   x-right
@@ -110,14 +110,29 @@ MIT in each case. |#
   text-aspect
   text-slant
   text-rotation)
+
+(let-syntax ((define-accessor
+              (macro (name)
+                `(define (,(symbol-append 'starbase-device/ name) device)
+                   (,(symbol-append 'starbase-graphics-descriptor/ name)
+                    (graphics-device/descriptor device))))))
+  (define-accessor identifier)
+  (define-accessor x-left)
+  (define-accessor y-bottom)
+  (define-accessor x-right)
+  (define-accessor y-top)
+  (define-accessor text-height)
+  (define-accessor text-aspect)
+  (define-accessor text-slant)
+  (define-accessor text-rotation))
 \f
 (define (operation/available?)
   (implemented-primitive-procedure? starbase-open-device))
 
 (define (operation/open device-name driver-name)
-  (let ((descriptor (starbase-open-device device-name driver-name)))
-    (and descriptor
-        (let ((device (make-starbase-device descriptor)))
+  (let ((identifier (starbase-open-device device-name driver-name)))
+    (and identifier
+        (let ((device (make-starbase-descriptor identifier)))
           (operation/set-coordinate-limits device -1 -1 1 1)
           (operation/set-text-height device 0.1)
           (operation/set-text-aspect device 1)
@@ -126,15 +141,15 @@ MIT in each case. |#
           device))))
 
 (define (operation/close device)
-  (starbase-close-device (starbase-device/descriptor device)))
+  (starbase-close-device (starbase-device/identifier device)))
 
 (define (operation/flush device)
-  (starbase-flush (starbase-device/descriptor device)))
+  (starbase-flush (starbase-device/identifier device)))
 
 (define (operation/device-coordinate-limits device)
   (let ((limits
         (starbase-device-coordinates
-         (starbase-device/descriptor device))))
+         (starbase-device/identifier device))))
     (values (vector-ref limits 0)
            (vector-ref limits 1)
            (vector-ref limits 2)
@@ -147,7 +162,7 @@ MIT in each case. |#
          (starbase-device/y-top device)))
 
 (define (operation/set-coordinate-limits device x-left y-bottom x-right y-top)
-  (starbase-set-vdc-extent (starbase-device/descriptor device)
+  (starbase-set-vdc-extent (starbase-device/identifier device)
                           x-left y-bottom x-right y-top)
   (set-starbase-device/x-left! device x-left)
   (set-starbase-device/y-bottom! device y-bottom)
@@ -155,41 +170,41 @@ MIT in each case. |#
   (set-starbase-device/y-top! device y-top))
 
 (define (operation/reset-clip-rectangle device)
-  (starbase-reset-clip-rectangle (starbase-device/descriptor device)))
+  (starbase-reset-clip-rectangle (starbase-device/identifier device)))
 
 (define (operation/set-clip-rectangle device x-left y-bottom x-right y-top)
-  (starbase-set-clip-rectangle (starbase-device/descriptor device)
+  (starbase-set-clip-rectangle (starbase-device/identifier device)
                               x-left y-bottom x-right y-top))
 
 (define (operation/set-drawing-mode device drawing-mode)
-  (starbase-set-drawing-mode (starbase-device/descriptor device) drawing-mode))
+  (starbase-set-drawing-mode (starbase-device/identifier device) drawing-mode))
 
 (define (operation/set-line-style device line-style)
-  (starbase-set-line-style (starbase-device/descriptor device) line-style))
+  (starbase-set-line-style (starbase-device/identifier device) line-style))
 
 (define (operation/clear device)
-  (starbase-clear (starbase-device/descriptor device)))
+  (starbase-clear (starbase-device/identifier device)))
 
 (define (operation/draw-point device x y)
-  (starbase-draw-point (starbase-device/descriptor device) x y))
+  (starbase-draw-point (starbase-device/identifier device) x y))
 
 (define (operation/move-cursor device x y)
-  (starbase-move-cursor (starbase-device/descriptor device) x y))
+  (starbase-move-cursor (starbase-device/identifier device) x y))
 
 (define (operation/drag-cursor device x y)
-  (starbase-drag-cursor (starbase-device/descriptor device) x y))
+  (starbase-drag-cursor (starbase-device/identifier device) x y))
 
 (define (operation/draw-line device x-start y-start x-end y-end)
-  (starbase-draw-line (starbase-device/descriptor device)
+  (starbase-draw-line (starbase-device/identifier device)
                      x-start y-start x-end y-end))
 
 (define (operation/draw-text device x y text)
-  (starbase-draw-text (starbase-device/descriptor device) x y text))
+  (starbase-draw-text (starbase-device/identifier device) x y text))
 \f
 ;;; Custom Operations
 
 (define (operation/write-image-file device filename invert?)
-  (starbase-write-image-file (starbase-device/descriptor device)
+  (starbase-write-image-file (starbase-device/identifier device)
                             (->namestring (merge-pathnames filename))
                             invert?))
 
@@ -206,27 +221,27 @@ MIT in each case. |#
   (starbase-device/text-rotation device))
 
 (define (operation/set-text-height device height)
-  (starbase-set-text-height (starbase-device/descriptor device) height)
+  (starbase-set-text-height (starbase-device/identifier device) height)
   (set-starbase-device/text-height! device height))
 
 (define (operation/set-text-aspect device aspect)
-  (starbase-set-text-aspect (starbase-device/descriptor device) aspect)
+  (starbase-set-text-aspect (starbase-device/identifier device) aspect)
   (set-starbase-device/text-aspect! device aspect))
 
 (define (operation/set-text-slant device slant)
-  (starbase-set-text-slant (starbase-device/descriptor device) slant)
+  (starbase-set-text-slant (starbase-device/identifier device) slant)
   (set-starbase-device/text-slant! device slant))
 
 (define (operation/set-text-rotation device rotation)
-  (starbase-set-text-rotation (starbase-device/descriptor device) rotation)
+  (starbase-set-text-rotation (starbase-device/identifier device) rotation)
   (set-starbase-device/text-rotation! device rotation))
 
 (define (operation/color-map-size device)
-  (starbase-color-map-size (starbase-device/descriptor device)))
+  (starbase-color-map-size (starbase-device/identifier device)))
 
 (define (operation/define-color device color-index red green blue)
-  (starbase-define-color (starbase-device/descriptor device)
+  (starbase-define-color (starbase-device/identifier device)
                         color-index red green blue))
 
 (define (operation/set-line-color device color-index)
-  (starbase-set-line-color (starbase-device/descriptor device) color-index))
\ No newline at end of file
+  (starbase-set-line-color (starbase-device/identifier device) color-index))
\ No newline at end of file

diff --git a/v7/src/runtime/x11graph.scm b/v7/src/runtime/x11graph.scm
index f855fe29ebb4bc7cafc556e92ff10e56fd63bfb4..ca2f2caa06aab7acff6785f3a23f6ec109d38bf0 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.12 1991/12/19 21:58:55 arthur Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/x11graph.scm,v 1.13 1992/01/30 00:38:45 arthur Exp $
 
 Copyright (c) 1989-91 Massachusetts Institute of Technology
 
@@ -195,10 +195,16 @@ MIT in each case. |#
                                    (number->string y))
                     "")))
 
-(define-structure (x-graphics-device (conc-name x-graphics-device/))
+(define-structure (x-graphics-descriptor (conc-name x-graphics-descriptor/))
   (window false read-only true)
   (display false read-only true))
 
+(define (x-graphics-device/window device)
+  (x-graphics-descriptor/window (graphics-device/descriptor device)))
+
+(define (x-graphics-device/display device)
+  (x-graphics-descriptor/display (graphics-device/descriptor device)))
+
 (define (x-graphics-device/process-events! device)
   (let ((xd (x-graphics-device/display device)))
     (let loop ()
@@ -312,9 +318,9 @@ MIT in each case. |#
          geometry
          (and (not (default-object? suppress-map?))
               suppress-map?))))
-    (let ((device (make-x-graphics-device xw (x-window-display xw))))
-      (add-to-protection-list! window-list device xw)
-      device)))
+    (let ((descriptor (make-x-graphics-descriptor xw (x-window-display xw))))
+      (add-to-protection-list! window-list descriptor xw)
+      descriptor)))
 
 (define (operation/reset-clip-rectangle device)
   (x-graphics-device/process-events! device)

diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index f170cf30ea2f1fe9f7b8f61394ab52312466b4fc..c8c6eb8de9cf3b14202ed069e2c1dbc88f12b771 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.130 1992/01/23 19:15:49 arthur Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/runtime.pkg,v 14.131 1992/01/30 00:38:28 arthur Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -2004,6 +2004,7 @@ MIT in each case. |#
          graphics-coordinate-limits
          graphics-device?
          graphics-device-coordinate-limits
+         graphics-device/descriptor
          graphics-device/properties
          graphics-disable-buffering
          graphics-drag-cursor