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