<<>> <<;;; Paint.scheme>> <<;;; Copyright Ó 1988, 1991 by Xerox Corporation. All rights reserved.>> <<;;; Michael Plass, March 11, 1988 2:39:54 pm PST>> <<;;; Last changed by Pavel on August 31, 1988 8:34:58 pm PDT>> <<>> (define (flush) <<;; flushes any previous input>> (when (viewer-input-ready?) (viewer-read) (flush))) (define (paint) (define x0 #f) (define y0 #f) (define (buttondown x y) (set! x0 x) (set! y0 y)) (define (mouseto x y shift) (case shift ((0) (set-stroke-width 5)) ; plain ((1) (set-stroke-width 10)) ; control ((2) (set-stroke-width 15)) ; shift ((3) (set-stroke-width 20)) ; control-shift ) (mask-vector (if x0 x0 x) (if y0 y0 y) x y) (set! x0 x) (set! y0 y)) (set-stroke-end 'round) (flush) (format #t "Right-click to stop painting.~%") (let loop ((event (viewer-read))) (case (event-kind event) ((buttonup) (set! x0 #f) (set! y0 #f) (unless (eq? (event-button event) 'right) (loop (viewer-read)))) ((mouseto) (mouseto (event-x event) (event-y event) (event-shift event)) (loop (viewer-read))) ((buttondown) (buttondown (event-x event) (event-y event)) (loop (viewer-read))) ((destroyed) (format #t "Viewer destroyed.")) (else (format #t "Unhandled event: ~S~%" event) (loop (viewer-read))))))