From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 21 Feb 1995 23:20:21 +0000 (+0000)
Subject: Change IMAGE/CREATE to extract the image type from its device
X-Git-Tag: 20090517-FFI~6613
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=9d41a1c253d9a66fef35fcf7fd8f65636628ef5f;p=mit-scheme.git

Change IMAGE/CREATE to extract the image type from its device
argument.
---

diff --git a/v7/src/runtime/graphics.scm b/v7/src/runtime/graphics.scm
index f464f15ef..bf3aeeac2 100644
--- a/v7/src/runtime/graphics.scm
+++ b/v7/src/runtime/graphics.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: graphics.scm,v 1.14 1995/02/21 23:10:35 cph Exp $
+$Id: graphics.scm,v 1.15 1995/02/21 23:20:21 cph Exp $
 
 Copyright (c) 1989-95 Massachusetts Institute of Technology
 
@@ -429,7 +429,7 @@ MIT in each case. |#
 		   (and error?
 			(error "Graphics type has no associated image type:"
 			       type))))))))
-
+
 (define (make-image-type operations)
   (let ((operations
 	 (map (lambda (entry)
@@ -467,10 +467,11 @@ MIT in each case. |#
 
 (define the-destroyed-image-type #f)
 
-(define (image/create type device width height)
+(define (image/create device width height)
   ;; operation/create returns a descriptor
-  (%make-image type
-	       ((image-type/operation/create type) device width height)))
+  (let ((type (image-type device)))
+    (%make-image type
+		 ((image-type/operation/create type) device width height))))
 
 (define (image/destroy image)
   ((image-type/operation/destroy (image/type image)) image)
diff --git a/v7/src/runtime/os2graph.scm b/v7/src/runtime/os2graph.scm
index d207d618c..e633a4707 100644
--- a/v7/src/runtime/os2graph.scm
+++ b/v7/src/runtime/os2graph.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: os2graph.scm,v 1.6 1995/02/21 23:15:58 cph Exp $
+$Id: os2graph.scm,v 1.7 1995/02/21 23:20:02 cph Exp $
 
 Copyright (c) 1995 Massachusetts Institute of Technology
 
@@ -846,7 +846,7 @@ MIT in each case. |#
 	  (y (window/y->device window y-bottom)))
       (let ((width (+ (- (window/x->device window x-right) x) 1))
 	    (height (+ (- (window/y->device window y-top) y) 1)))
-	(let ((image (image/create (image-type device) device width height)))
+	(let ((image (image/create device width height)))
 	  (os2ps-bitblt (image/ps (image/descriptor image))
 			(window/backing-store window)
 			(vector x (+ x width) 0)
diff --git a/v7/src/runtime/x11graph.scm b/v7/src/runtime/x11graph.scm
index 933ee30ee..f7f13c469 100644
--- a/v7/src/runtime/x11graph.scm
+++ b/v7/src/runtime/x11graph.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: x11graph.scm,v 1.41 1995/02/21 23:11:22 cph Exp $
+$Id: x11graph.scm,v 1.42 1995/02/21 23:20:11 cph Exp $
 
 Copyright (c) 1989-95 Massachusetts Institute of Technology
 
@@ -895,7 +895,7 @@ MIT in each case. |#
 ;; Abstraction layer for generic images
 
 (define (x-graphics/create-image device width height)
-  (image/create (image-type device) device width height))
+  (image/create device width height))
 
 ;;(define x-graphics-image/create create-x-image)