Altered event:after-restarts to allow a band containing the win32
authorStephen Adams <edu/mit/csail/zurich/adams>
Wed, 1 Dec 1993 03:08:03 +0000 (03:08 +0000)
committerStephen Adams <edu/mit/csail/zurich/adams>
Wed, 1 Dec 1993 03:08:03 +0000 (03:08 +0000)
system to be loaded on a DOS-only microcode.

v7/src/win32/graphics.scm
v7/src/win32/module.scm
v7/src/win32/win_ffi.scm
v7/src/win32/wt_user.scm

index efd1de11758e1adc41314498d569a597bde85b2b..da80f89b6510bf73b58facdccd72d61f20884680 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: graphics.scm,v 1.2 1993/11/10 21:38:05 adams Exp $
+$Id: graphics.scm,v 1.3 1993/12/01 03:08:03 adams Exp $
 
 Copyright (c) 1993 Massachusetts Institute of Technology
 
@@ -659,8 +659,8 @@ MIT in each case. |#
 
 (define (->color spec)
   (cond ((integer? spec)
-        (if (< spec 0x02000000)
-            (+ spec 0x02000000)
+        (if (< spec #x02000000)
+            (+ spec #x02000000)
             spec))
         ((and (vector? spec) (= (vector-length spec) 3))
          (rgb (vector-ref spec 0) (vector-ref spec 1) (vector-ref spec 2)))
@@ -854,7 +854,6 @@ MIT in each case. |#
     (register-class (+) (get-handle 3) 0 0 hInstance
                     hIcon 32515 NULL_BRUSH 0 "SCHEME-GRAPHICS")))
 
-
 (define (initialize-package!)
   (set! win32-graphics-device-type
        (make-graphics-device-type
@@ -909,7 +908,8 @@ MIT in each case. |#
     (lambda (pair) (win32-graphics/define-color #f (car pair) (cdr pair)))
     initial-color-definitions)
   (register-graphics-window-class)
-  (add-event-receiver! event:after-restore register-graphics-window-class)
+  (add-event-receiver! event:after-restore
+                      (when-microcode-supports-win32 register-graphics-window-class))
   (register-graphics-device-type 'win32 win32-graphics-device-type)
   unspecific)
 
index 04ba4fc50a81a4d2db91c90c343ca8229068e0b5..cd11a714e9c98e9b762d32a40eb783938bb9c4cc 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: module.scm,v 1.2 1993/11/10 21:36:46 adams Exp $
+$Id: module.scm,v 1.3 1993/12/01 03:08:03 adams Exp $
 
 Copyright (c) 1993 Massachusetts Institute of Technology
 
@@ -136,8 +136,8 @@ MIT in each case. |#
 
 (define (mark-modules-as-unloaded!)
   (protection-list/for-each
-    (lambda (module) (unload-module! module #f))    
-    *modules*))
+   (lambda (module) (unload-module! module #f))    
+   *modules*))
 
 ;;
 ;;-------------------------------------
@@ -218,6 +218,12 @@ MIT in each case. |#
 ;;----------------------------------------------------------------------
 ;;
 
+(define (when-microcode-supports-win32 thunk)
+  ;; This is for wrapping event:after-restore procedures so that a windows
+  ;; band will restore into a DOS only microcode.
+  (lambda ()
+    (if (implemented-primitive-procedure? (ucode-primitive nt:load-library 1))
+       (thunk))))
 
 (define (initialize-module-package!)
   (set! *modules*
@@ -228,5 +234,6 @@ MIT in each case. |#
       ;;     (free-library (cell-contents handle))))
       (lambda (handle-cell) handle-cell)
       ))
-  (add-event-receiver! event:after-restore mark-modules-as-unloaded!)
+  (add-event-receiver! event:after-restore
+                      (when-microcode-supports-win32 mark-modules-as-unloaded!))
 )
index 379072fda105b775ad82f75a46f979a462ccc98c..acd0c5812a4b4ecca4c9b350433ad0357957117d 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: win_ffi.scm,v 1.2 1993/11/10 21:41:48 adams Exp $
+$Id: win_ffi.scm,v 1.3 1993/12/01 03:08:03 adams Exp $
 
 Copyright (c) 1993 Massachusetts Institute of Technology
 
@@ -378,7 +378,6 @@ MIT in each case. |#
 ;;  (make-windows-procedure kernel32.dll "SetLastError" void-result int-arg))
     
 (define close-window)
-(define create-rect-rgn)
 (define create-round-rect-rgn)
 (define create-window-ex)
 (define dispatch-message)
@@ -433,11 +432,6 @@ MIT in each case. |#
                               (widthellipse int)(heightellipse int))
       hrgn gdi32.dll "CreateRoundRectRgn"))
 
-  (set! create-rect-rgn
-     (windows-procedure
-        (create-rect-rgn (left int) (top int) (right int) (bottom int))
-       hrgn gdi32.dll "CreateRectRgn"))
-
   (set! pt-in-region
     (windows-procedure (pt-in-region (hrgn hrgn) (x int) (y int))
       bool gdi32.dll "PtInRegion"))
@@ -508,7 +502,9 @@ MIT in each case. |#
   (purify general-scheme-wndproc)
   (flush-purification-queue!)
   (install-general-scheme-wndproc!)
-  (add-event-receiver! event:after-restore install-general-scheme-wndproc!)
+  (add-event-receiver!
+    event:after-restore
+    (when-microcode-supports-win32 install-general-scheme-wndproc!))
   (create-windows-procedures!)
 
   (initialize-wndproc-registry)
index 6f0cac2858cbe3ecacff37555a449b19880184d6..ddfd2bbc4e8e9367c4272d661fd9f73d99bf8c3b 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: wt_user.scm,v 1.2 1993/11/10 21:43:04 adams Exp $
+$Id: wt_user.scm,v 1.3 1993/12/01 03:08:03 adams Exp $
 
 Copyright (c) 1993 Massachusetts Institute of Technology
 
@@ -136,7 +136,7 @@ MIT in each case. |#
   (int32-offset-set! (paintstruct/mem r) 20 v))
 (define-integrable (set-paintstruct/f-restore! r v)
   (byte-offset-set! (paintstruct/mem r) 24 (bool->int v)))
-(define-integrable (set-paintstruct/f-erase! r v)
+(define-integrable (set-paintstruct/f-inc-update! r v)
   (byte-offset-set! (paintstruct/mem r) 28 (bool->int v)))
 
 (define (make-paintstruct)