74 lines
1.7 KiB
Scheme
74 lines
1.7 KiB
Scheme
|
../../scx <<EOF
|
||
|
|
|
||
|
|
,batch on
|
||
|
|
,open xlib
|
||
|
|
,batch off
|
||
|
|
|
||
|
|
(define (regions)
|
||
|
|
(let* ((dpy (open-display))
|
||
|
|
(cm (display-default-colormap dpy))
|
||
|
|
(black (black-pixel dpy))
|
||
|
|
(white (white-pixel dpy))
|
||
|
|
(blue (alloc-named-color cm 'blue))
|
||
|
|
(win (create-window (display-root-window dpy) 500 500
|
||
|
|
'event-mask '(button-press exposure)
|
||
|
|
'background-pixel white))
|
||
|
|
(gc (create-gcontext win
|
||
|
|
'background white
|
||
|
|
'foreground black))
|
||
|
|
|
||
|
|
(rectangles '((10 20 60 60) (50 100 30 30)))
|
||
|
|
(colors (list black blue))
|
||
|
|
(regions-alist
|
||
|
|
(list (cons (union-rectangle-with-region (car rectangles)
|
||
|
|
(create-region))
|
||
|
|
"black rectangle")
|
||
|
|
(cons (union-rectangle-with-region (cadr rectangles)
|
||
|
|
(create-region))
|
||
|
|
"blue rectangle")))
|
||
|
|
|
||
|
|
(handle-event
|
||
|
|
(lambda (e)
|
||
|
|
(let ((args (event-args e))
|
||
|
|
(type (event-type e)))
|
||
|
|
(case type
|
||
|
|
;; Zeichnen...
|
||
|
|
((expose) (begin
|
||
|
|
(for-each (lambda (rect color)
|
||
|
|
(set-gcontext-foreground! gc color)
|
||
|
|
(fill-rectangle win gc rect))
|
||
|
|
rectangles colors)
|
||
|
|
#t))
|
||
|
|
;; Hit-Tests
|
||
|
|
((button-press)
|
||
|
|
(let* ((x (cdr (assq 'x args)))
|
||
|
|
(y (cdr (assq 'y args)))
|
||
|
|
(rs (filter (lambda (r-n)
|
||
|
|
(point-in-region? (car r-n)
|
||
|
|
x y))
|
||
|
|
regions-alist)))
|
||
|
|
(for-each (lambda (region-name)
|
||
|
|
(display "You clicked: ")
|
||
|
|
(display (cdr region-name))
|
||
|
|
(newline))
|
||
|
|
rs)
|
||
|
|
;; break if none was hit.
|
||
|
|
(not (null? rs))))
|
||
|
|
)))))
|
||
|
|
|
||
|
|
(map-window win)
|
||
|
|
(let loop ()
|
||
|
|
(display-flush-output dpy)
|
||
|
|
(let ((e (next-event dpy)))
|
||
|
|
(if (handle-event e)
|
||
|
|
(loop)
|
||
|
|
(close-display dpy))))))
|
||
|
|
|
||
|
|
(regions)
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
,exit
|
||
|
|
y
|
||
|
|
EOF
|