+ added more example scripts.
This commit is contained in:
parent
35cbba0dc3
commit
9a316771fc
|
@ -0,0 +1,54 @@
|
||||||
|
#!/bin/sh
|
||||||
|
|
||||||
|
../../scx <<EOF
|
||||||
|
|
||||||
|
,batch on
|
||||||
|
,open xlib
|
||||||
|
,batch off
|
||||||
|
|
||||||
|
(define (picture point-count)
|
||||||
|
(let* ((dpy (open-display))
|
||||||
|
(width 400)
|
||||||
|
(height 400)
|
||||||
|
(black (black-pixel dpy))
|
||||||
|
(white (white-pixel dpy))
|
||||||
|
(root (display-root-window dpy))
|
||||||
|
(win (create-window root width height
|
||||||
|
'background-pixel white
|
||||||
|
'event-mask '(exposure button-press)))
|
||||||
|
(gc (create-gcontext win
|
||||||
|
'background white 'foreground black)))
|
||||||
|
(map-window win)
|
||||||
|
(let event-loop ()
|
||||||
|
(let ((e (next-event dpy)))
|
||||||
|
(if
|
||||||
|
(case (event-type e)
|
||||||
|
((expose) (begin
|
||||||
|
(clear-window win)
|
||||||
|
(draw-points win gc point-count 0 0
|
||||||
|
(/ width 2) (/ height 2))
|
||||||
|
(draw-poly-text win gc 10 10 "Click a button to exit"
|
||||||
|
'1-byte)
|
||||||
|
#f))
|
||||||
|
(else #t))
|
||||||
|
#t
|
||||||
|
(event-loop))))
|
||||||
|
(close-display dpy)))
|
||||||
|
|
||||||
|
(define (draw-points win gc count x y hw hh)
|
||||||
|
(if (zero? (modulo count 100))
|
||||||
|
(display-flush-output (window-display win)))
|
||||||
|
(if (not (zero? count))
|
||||||
|
(let ((xf (floor (* (+ 1.2 x) hw ))) ; These lines center the picture
|
||||||
|
(yf (floor (* (+ 0.5 y) hh ))))
|
||||||
|
(draw-point win gc (cons (inexact->exact xf) (inexact->exact yf)))
|
||||||
|
(draw-points win gc (- count 1)
|
||||||
|
(- (* y (+ 1 (sin (* 0.7 x)))) (* 1.2 (sqrt (abs x))))
|
||||||
|
(- 0.21 x)
|
||||||
|
hw hh))))
|
||||||
|
|
||||||
|
(picture 1000)
|
||||||
|
|
||||||
|
,exit
|
||||||
|
y
|
||||||
|
EOF
|
|
@ -0,0 +1,73 @@
|
||||||
|
../../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
|
|
@ -0,0 +1,33 @@
|
||||||
|
#!/bin/sh
|
||||||
|
|
||||||
|
../../scx <<EOF
|
||||||
|
|
||||||
|
,batch on
|
||||||
|
,open xlib
|
||||||
|
,batch off
|
||||||
|
|
||||||
|
(define (scxev)
|
||||||
|
(let* ((dpy (open-display))
|
||||||
|
(black (black-pixel dpy))
|
||||||
|
(white (white-pixel dpy))
|
||||||
|
(win (create-window (display-default-root-window dpy)
|
||||||
|
300 200
|
||||||
|
'event-mask '(all-events)
|
||||||
|
'background-pixel white))
|
||||||
|
)
|
||||||
|
(set-wm-name! win '("scx Event Listener"))
|
||||||
|
(map-window win)
|
||||||
|
(let event-loop ()
|
||||||
|
(display-flush-output dpy)
|
||||||
|
(let ((e (wait-event dpy)))
|
||||||
|
(display (event-type e)) (display " Event, Data:\n")
|
||||||
|
(display (event-args e)) (newline) (newline)
|
||||||
|
|
||||||
|
(event-loop))
|
||||||
|
(close-display dpy))))
|
||||||
|
|
||||||
|
(scxev)
|
||||||
|
|
||||||
|
,exit
|
||||||
|
y
|
||||||
|
EOF
|
Loading…
Reference in New Issue