scx/scheme/examples/picture.scm

55 lines
1.3 KiB
Scheme
Raw Normal View History

2001-12-04 08:49:07 -05:00
#!/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