system to be loaded on a DOS-only microcode.
#| -*-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
(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)))
(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
(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)
#| -*-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
(define (mark-modules-as-unloaded!)
(protection-list/for-each
- (lambda (module) (unload-module! module #f))
- *modules*))
+ (lambda (module) (unload-module! module #f))
+ *modules*))
;;
;;-------------------------------------
;;----------------------------------------------------------------------
;;
+(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*
;; (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!))
)
#| -*-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
;; (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)
(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"))
(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)
#| -*-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
(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)