;;; 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 (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))))))