OPERATION/OPEN now takes an mandatory argument DESCRIPTOR->DEVICE

which converts a descriptor into a user level GRAPHICS-DEVICE.

This allows a graphics device implementation access to the user level
GRAPHICS-DEVICE object at initialization time, which may be used in in
protection lists etc (as is done in the win32 implementation).

diff --git a/v7/src/runtime/graphics.scm b/v7/src/runtime/graphics.scm
index 507a43276eb7f10f5edb0e9be64352915baf1753..7937ea82e61000ed956f169bdaf2153434f6dc28 100644 (file)
--- a/v7/src/runtime/graphics.scm
+++ b/v7/src/runtime/graphics.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: graphics.scm,v 1.12 1994/04/22 04:45:40 cph Exp $
+$Id: graphics.scm,v 1.13 1994/11/06 18:06:33 adams Exp $
 
 Copyright (c) 1989-94 Massachusetts Institute of Technology
 
@@ -231,10 +231,11 @@ MIT in each case. |#
                type-name)
               (else
                (lookup-graphics-device-type type-name)))))
-    (let ((descriptor
-          (apply (graphics-device-type/operation/open type) arguments)))
-      (and descriptor
-          (%make-graphics-device type descriptor)))))
+    (apply (graphics-device-type/operation/open type)
+          (lambda (descriptor)
+            (and descriptor
+                 (%make-graphics-device type descriptor)))
+          arguments)))
 
 (let-syntax
     ((define-graphics-operation

diff --git a/v7/src/runtime/starbase.scm b/v7/src/runtime/starbase.scm
index 39cfe00798279066e836f3b2d2cb43d6403381c8..7b61fdb20ee8a8450bb6d5770bf855ccb092dc7c 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.10 1993/09/15 04:12:20 adams Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/starbase.scm,v 1.11 1994/11/06 18:06:22 adams Exp $
 
 Copyright (c) 1989-92 Massachusetts Institute of Technology
 
@@ -140,16 +140,16 @@ MIT in each case. |#
 (define (operation/available?)
   (implemented-primitive-procedure? starbase-open-device))
 
-(define (operation/open device-name driver-name)
+(define (operation/open descriptor->device device-name driver-name)
   (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)
-          (operation/set-text-slant device 0)
-          (operation/set-text-rotation device 0)
-          device))))
+        (let ((descriptor (make-starbase-descriptor identifier)))
+          (operation/set-coordinate-limits descriptor -1 -1 1 1)
+          (operation/set-text-height descriptor 0.1)
+          (operation/set-text-aspect descriptor 1)
+          (operation/set-text-slant descriptor 0)
+          (operation/set-text-rotation descriptor 0)
+          (descriptor->device descriptor)))))
 
 (define (operation/close device)
   (starbase-close-device (starbase-device/identifier device)))