1;;;;
2;;;;     Title: The famous swirling vectors using CLX
3;;;;   Created: Wed Feb 14 15:51:39 1996
4;;;;    Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de>
5;;;; Copyright: None, since this code is not worth it.
6
7;;;; -- TODO --
8;;;;
9;;;; o react on resize events
10;;;; o possibly react on iconify events by stoping
11;;;; o maybe pressing 'q' should terminate it
12;;;; o window documentation line is needed
13;;;; o maybe add a root window option
14;;;; o or a spline option?!
15;;;;
16
17(in-package :clx-demos)
18
19(defvar *offset* 3)
20(defvar *delta* 6)
21
22(defun check-bounds (val del max)
23  (cond ((< val 0)   (+ (random *delta*) *offset*))
24        ((> val max) (- (+ (random *delta*) *offset*)))
25        (t           del)))
26
27;; IHMO this is worth to be added to the standard.
28(defun make-circular (x) (nconc x x))
29
30(defstruct qix
31  lines dims deltas coords)
32
33(defun gen-qix (nlines width height)
34  (make-qix :lines  (make-circular (make-list nlines))
35            :dims   (list width height width height)
36            :deltas (list #3=(+ *offset* (random *delta*)) #3# #3# #3#)
37            :coords (list #1=(random width) #2=(random height) #1# #2#) ))
38
39(defun step-qix (qix win gc white-pixel black-pixel)
40  (when (car (qix-lines qix))
41    (setf (xlib:gcontext-foreground gc) white-pixel)
42    (apply #'xlib:draw-line win gc (car (qix-lines qix)))
43    (setf (xlib:gcontext-foreground gc) black-pixel))
44  (map-into (qix-coords qix) #'+ (qix-coords qix) (qix-deltas qix))
45  (map-into (qix-deltas qix) #'check-bounds
46            (qix-coords qix) (qix-deltas qix) (qix-dims qix))
47  (apply #'xlib:draw-line win gc (qix-coords qix))
48  ;; push 'em into
49  (unless (car (qix-lines qix)) (setf (car (qix-lines qix)) (make-list 4)))
50  (map-into (car (qix-lines qix)) #'identity (qix-coords qix))
51  (setf (qix-lines qix) (cdr (qix-lines qix))) )
52
53(defun draw-qix (dpy win gc width height white-pixel black-pixel
54                 delay nqixs nlines)
55  (let ((qixs nil) (n nlines))
56    (dotimes (k nqixs) (push (gen-qix nlines width height) qixs))
57    (loop
58     (dolist (k qixs)
59       (step-qix k win gc white-pixel black-pixel))
60     (xlib:display-force-output dpy)
61     (sleep delay)
62     (decf n)
63     (if (<= n 0) (return)))))
64
65(defun qix (&key (x 10) (y 10)
66            (width 400) (height 400) (delay 0.05) (nqixs 3) (nlines 80))
67  "The famous swirling vectors."
68  (xlib:with-open-display (dpy)
69    (let* ((scr (xlib:display-default-screen dpy))
70           (root-win (xlib:screen-root scr))
71           (white-pixel (xlib:screen-white-pixel scr))
72           (black-pixel (xlib:screen-black-pixel scr))
73           (win (xlib:create-window :parent root-win :x x :y y
74                                    :width width :height height
75                                    :background white-pixel))
76           (gcon (xlib:create-gcontext :drawable win
77                                       :foreground black-pixel
78                                       :background white-pixel)))
79      (xlib:map-window win)
80      (xlib:display-finish-output dpy)
81      (format t "~&Qix uses the following parameters:~%
82  :x ~s :y ~s :width ~d :height ~d :delay ~f :nqixs ~d :nlines ~d~%"
83              x y width height delay nqixs nlines)
84      (draw-qix dpy win gcon width height white-pixel black-pixel
85                delay nqixs nlines)
86      (xlib:free-gcontext gcon)
87      (xlib:unmap-window win)
88      (xlib:display-finish-output dpy))))
89
90(provide "qix")
91