(define (os2-graphics/close device)
(let ((window (graphics-device/descriptor device)))
- (without-interrupts
+ (without-interruption
(lambda ()
(close-window window)))))
(define (os2-graphics/clear device)
(let ((window (graphics-device/descriptor device)))
- (without-interrupts
+ (without-interruption
(lambda ()
(let ((width (window/pel-width window))
(height (window/pel-height window)))
(define (os2-graphics/coordinate-limits device)
(let ((window (graphics-device/descriptor device)))
- (without-interrupts
+ (without-interruption
(lambda ()
(values (window/x-left window)
(window/y-bottom window)
(define (os2-graphics/device-coordinate-limits device)
(let ((window (graphics-device/descriptor device)))
- (without-interrupts
+ (without-interruption
(lambda ()
(values 0
0
\f
(define (os2-graphics/drag-cursor device x y)
(let ((window (graphics-device/descriptor device)))
- (without-interrupts
+ (without-interruption
(lambda ()
(let ((xs (window/x-gcursor window))
(ys (window/y-gcursor window))
(define (os2-graphics/draw-lines device xv yv)
(let ((window (graphics-device/descriptor device)))
- (without-interrupts
+ (without-interruption
(lambda ()
(let ((xv (vector-map (lambda (x) (window/x->device window x)) xv))
(yv (vector-map (lambda (y) (window/y->device window y)) yv)))
(define (os2-graphics/draw-point device x y)
;; This sucks. Implement a real point-drawing primitive.
(let ((window (graphics-device/descriptor device)))
- (without-interrupts
+ (without-interruption
(lambda ()
(let ((x (window/x->device window x))
(y (window/y->device window y)))
(define (os2-graphics/draw-text device x y string)
(let ((window (graphics-device/descriptor device))
(length (string-length string)))
- (without-interrupts
+ (without-interruption
(lambda ()
(let ((psid (window/backing-store window))
(metrics (window/font-metrics window))
\f
(define (os2-graphics/flush device)
(let ((window (graphics-device/descriptor device)))
- (without-interrupts
+ (without-interruption
(lambda ()
(let ((changes (window/changes window)))
(if changes
\f
(define (os2-graphics/move-cursor device x y)
(let ((window (graphics-device/descriptor device)))
- (without-interrupts
+ (without-interruption
(lambda ()
(let ((x (window/x->device window x))
(y (window/y->device window y)))
(define (os2-graphics/set-clip-rectangle device x-left y-bottom x-right y-top)
(let ((window (graphics-device/descriptor device)))
- (without-interrupts
+ (without-interruption
(lambda ()
(os2ps-set-clip-rectangle (window/backing-store window)
(window/x->device window x-left)
(define (os2-graphics/set-coordinate-limits device
x-left y-bottom x-right y-top)
(let ((window (graphics-device/descriptor device)))
- (without-interrupts
+ (without-interruption
(lambda ()
(set-window/x-left! window x-left)
(set-window/y-bottom! window y-bottom)
(define (os2-graphics/set-background-color device color)
(let ((window (graphics-device/descriptor device))
(color (->color color 'SET-BACKGROUND-COLOR)))
- (without-interrupts
+ (without-interruption
(lambda ()
(set-window/background-color! window color)
(update-colors window)))))
(define (os2-graphics/set-foreground-color device color)
(let ((window (graphics-device/descriptor device))
(color (->color color 'SET-FOREGROUND-COLOR)))
- (without-interrupts
+ (without-interruption
(lambda ()
(set-window/foreground-color! window color)
(update-colors window)))))
(define (pm-synchronize)
(os2pm-synchronize)
- (with-thread-events-blocked
+ (without-interruption
(lambda () (do () ((not (read-and-process-event)))))))
(define (read-and-process-event)
(begin (process-event event) #t))))
(define (process-event event)
- (without-interrupts
- (lambda ()
- (let ((window
- (search-gc-finalizer window-finalizer
- (let ((wid (event-wid event)))
- (lambda (window)
- (eq? (window/wid window) wid))))))
- (if window
- (begin
- (let ((handler (vector-ref event-handlers (event-type event))))
- (if handler
- (handler window event)))
- (maybe-queue-user-event window event)))))))
+ (let ((window
+ (search-gc-finalizer window-finalizer
+ (let ((wid (event-wid event)))
+ (lambda (window)
+ (eq? (window/wid window) wid))))))
+ (if window
+ (begin
+ (let ((handler (vector-ref event-handlers (event-type event))))
+ (if handler
+ (handler window event)))
+ (maybe-queue-user-event window event)))))
(define event-handlers (make-vector number-of-event-types #f))
(define (os2-graphics/read-user-event device)
device
- (with-thread-events-blocked
+ (without-interruption
(lambda ()
(let loop ()
(if (queue-empty? user-event-queue)
(define (os2-graphics/discard-events device)
device
- (with-thread-events-blocked
+ (without-interruption
(lambda ()
(let loop ()
(flush-queue! user-event-queue)
(loop))))))
(define (flush-queue! queue)
- (without-interrupts
+ (without-interruption
(lambda ()
(let loop ()
(if (not (queue-empty? queue))
(define bitmaps-initialized? #f)
(define (maybe-initialize-bitmaps!)
- (without-interrupts
+ (without-interruption
(lambda ()
(if (not bitmaps-initialized?)
(begin