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