File: poly.scm

package info (click to toggle)
elk 3.99.7-1
  • links: PTS
  • area: main
  • in suites: etch, etch-m68k, lenny, squeeze
  • size: 5,068 kB
  • ctags: 3,303
  • sloc: ansic: 22,248; sh: 8,936; lisp: 6,208; makefile: 851; awk: 154; cpp: 92
file content (35 lines) | stat: -rw-r--r-- 977 bytes parent folder | download | duplicates (11)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
;;; -*-Scheme-*-

(require 'xlib)

(define (poly)
  (let* ((dpy (open-display))
	 (black (black-pixel dpy)) (white (white-pixel dpy))
	 (width 400) (height 400)
	 (win (create-window 'parent (display-root-window dpy)
			   'width width 'height height
			   'background-pixel white 'event-mask '(exposure)))
	 (gc (create-gcontext 'window win 'function 'xor
	                    'background white 'foreground black))
	 (l '(#f #f #f))
	 (rand (lambda (x) (modulo (random) x))))
    (map-window win)
    (handle-events dpy #t #f
      (else (lambda args
	      (set! width (window-width win))
	      (set! height (window-height win)) #t)))
    (unwind-protect
     (let loop ((n 0))
       (if (= n 200)
	 (begin
	   (clear-window win)
	   (display-wait-output dpy #f)
	   (set! n 0)))
       (fill-polygon win gc
		     (list->vector
		      (map (lambda (x) (cons (rand width) (rand height))) l))
		     #f 'convex)
       (loop (1+ n)))
    (close-display dpy))))
		  
(poly)