Index: CLX/README.Lispworks
diff -c /dev/null CLX/README.Lispworks:1.3
*** /dev/null	Wed Nov  5 19:47:46 2003
--- CLX/README.Lispworks	Sat Sep 27 15:13:11 2003
***************
*** 0 ****
--- 1,17 ----
+ ;;-*- Mode: Text -*-
+ Note : For Domain socket access, get uk.org.bew.comm-ext and load it BEFORE
+ compiling. The port will run fine however on tcp sockets WITHOUT this.
+ 
+ I did not rename any of the .l files to .lisp - Just define a logical pathname
+ translation "CLX" something like :
+ 
+ (setf (logical-pathname-translations "CLX")
+       '(("**;*.LISP.*"      "D:\\Projects\\CLX\\**\\*.l")
+         ("**;*.FSL.*"      "D:\\Projects\\CLX\\**\\*.fsl")))
+ 
+ Other than that, just load defsys.lisp, Compile System CLX and load CLX:demo;qix.lisp. Then run:
+ (xlib::qix :host "yourhost")
+ or, if you loaded my comm-ext stuff,
+ (xlib::qix :host "") or (xlib::qix :host "/local")
+ 
+ Have fun!
Index: CLX/clx.l
diff -c CLX/clx.l:1.1.1.2 CLX/clx.l:1.2
*** CLX/clx.l:1.1.1.2	Sun Sep 23 21:43:15 2001
--- CLX/clx.l	Fri Sep 28 20:49:29 2001
***************
*** 92,97 ****
--- 92,103 ----
  
  (defparameter *x-tcp-port* 6000) ;; add display number
  
+ ;;; For UNIX Domain socket access. The below is correct on Linux
+ ;;; (and FWIW, Solaris 2.6 too). I guess it may be different for other systems 
+ #+LispWorks
+ (defvar *x-unix-path* "/tmp/.X11-unix/X0"
+   "The path for UNIX domain socket access")
+ 
  ;; Note: if you have read the Version 11 protocol document or C Xlib manual, most of
  ;; the relationships should be fairly obvious.  We have no intention of writing yet
  ;; another moby document for this interface.
Index: CLX/defsys.lisp
diff -c /dev/null CLX/defsys.lisp:1.2
*** /dev/null	Wed Nov  5 19:47:46 2003
--- CLX/defsys.lisp	Fri Sep 28 20:49:29 2001
***************
*** 0 ****
--- 1,20 ----
+ ;;; LispWorks
+ #+(or Genera Minima LispWorks)
+ (eval-when (:compile-toplevel :load-toplevel :execute)
+   (common-lisp:pushnew :clx-ansi-common-lisp common-lisp:*features*)
+   (require "comm"))
+ 
+ #+clx-ansi-common-lisp
+ (common-lisp:in-package :common-lisp-user)
+ 
+ #+LispWorks
+ (lw:defsystem CLX
+     (:default-pathname "CLX:"
+     :default-type :lisp-file
+     )
+   :members
+   ("package" "depdefs"  "clx" "dependent" "macros" "bufmac"
+     "buffer" "display" "gcontext" "input" "requests" "fonts" "graphics"
+     "text" "attributes" "translate" "keysyms" "manager" "image" "resource")
+   :rules ((:in-order-to :compile :all
+            (:requires (:load :previous)))))
\ No newline at end of file
Index: CLX/dependent.l
diff -c CLX/dependent.l:1.1.1.2 CLX/dependent.l:1.6
*** CLX/dependent.l:1.1.1.2	Sun Sep 23 21:43:14 2001
--- CLX/dependent.l	Sat Sep 27 15:13:11 2003
***************
*** 19,24 ****
--- 19,26 ----
  ;;;
  
  (in-package :xlib)
+ #+LispWorks
+ (require "comm")
  
  ;;; The size of the output buffer.  Must be a multiple of 4.
  (defparameter *output-buffer-size* 8192)
***************
*** 833,839 ****
  
  ;;; MAKE-PROCESS-LOCK: Creating a process lock.
  
! #-(or LispM excl Minima)
  (defun make-process-lock (name)
    (declare (ignore name))
    nil)
--- 835,841 ----
  
  ;;; MAKE-PROCESS-LOCK: Creating a process lock.
  
! #-(or LispM excl Minima LispWorks)
  (defun make-process-lock (name)
    (declare (ignore name))
    nil)
***************
*** 854,859 ****
--- 856,865 ----
  (defun make-process-lock (name)
    (minima:make-lock name :recursive t))
  
+ #+LispWorks
+ (defun make-process-lock (name)
+   (mp:make-lock :name name))
+  
  ;;; HOLDING-LOCK: Execute a body of code with a lock held.
  
  ;;; The holding-lock macro takes a timeout keyword argument.  EVENT-LISTEN
***************
*** 862,872 ****
  
  ;; If you're not sharing DISPLAY objects within a multi-processing
  ;; shared-memory environment, this is sufficient
! #-(or lispm excl lcl3.0 Minima CMU)
  (defmacro holding-lock ((locator display &optional whostate &key timeout) &body body)
    (declare (ignore locator display whostate timeout))
    `(progn ,@body))
  
  ;;; HOLDING-LOCK for CMU Common Lisp.
  ;;;
  ;;; We are not multi-processing, but we use this macro to try to protect
--- 868,886 ----
  
  ;; If you're not sharing DISPLAY objects within a multi-processing
  ;; shared-memory environment, this is sufficient
! #-(or lispm excl lcl3.0 Minima CMU LispWorks)
  (defmacro holding-lock ((locator display &optional whostate &key timeout) &body body)
    (declare (ignore locator display whostate timeout))
    `(progn ,@body))
  
+ 
+ #+LispWorks
+ (defmacro holding-lock ((locator display &optional whostate &key timeout)
+ 			&body body)
+   (declare (ignore display whostate))
+   `(mp:with-lock (,locator :timeout ,timeout)
+      ,@body))
+ 
  ;;; HOLDING-LOCK for CMU Common Lisp.
  ;;;
  ;;; We are not multi-processing, but we use this macro to try to protect
***************
*** 1008,1017 ****
  ;;; request writing and reply reading to ensure that requests are atomically
  ;;; written and replies are atomically read from the stream.
  
! #-(or Genera excl lcl3.0)
  (defmacro without-aborts (&body body)
    `(progn ,@body))
  
  #+Genera
  (defmacro without-aborts (&body body)
    `(sys:without-aborts (clx "CLX is in the middle of an operation that should be atomic.")
--- 1022,1032 ----
  ;;; request writing and reply reading to ensure that requests are atomically
  ;;; written and replies are atomically read from the stream.
  
! #-(or Genera excl lcl3.0 )
  (defmacro without-aborts (&body body)
    `(progn ,@body))
  
+ 
  #+Genera
  (defmacro without-aborts (&body body)
    `(sys:without-aborts (clx "CLX is in the middle of an operation that should be atomic.")
***************
*** 1029,1040 ****
  ;;; Caller guarantees that PROCESS-WAKEUP will be called after the predicate's
  ;;; value changes.
  
! #-(or lispm excl lcl3.0 Minima)
  (defun process-block (whostate predicate &rest predicate-args)
    (declare (ignore whostate))
    (or (apply predicate predicate-args)
        (error "Program tried to wait with no scheduler.")))
  
  #+Genera
  (defun process-block (whostate predicate &rest predicate-args)
    (declare (type function predicate)
--- 1044,1060 ----
  ;;; Caller guarantees that PROCESS-WAKEUP will be called after the predicate's
  ;;; value changes.
  
! #-(or lispm excl lcl3.0 Minima LispWorks)
  (defun process-block (whostate predicate &rest predicate-args)
    (declare (ignore whostate))
    (or (apply predicate predicate-args)
        (error "Program tried to wait with no scheduler.")))
  
+ #+LispWorks
+ (defun process-block (whostate predicate &rest predicate-args)
+   (declare (dynamic-extent predicate-args))
+   (mp:process-wait whostate predicate predicate-args))
+ 
  #+Genera
  (defun process-block (whostate predicate &rest predicate-args)
    (declare (type function predicate)
***************
*** 1075,1085 ****
  
  (declaim (inline process-wakeup))
  
! #-(or excl Genera Minima)
  (defun process-wakeup (process)
    (declare (ignore process))
    nil)
  
  #+excl
  (defun process-wakeup (process)
    (let ((curproc mp::*current-process*))
--- 1095,1115 ----
  
  (declaim (inline process-wakeup))
  
! #-(or excl Genera Minima LispWorks)
  (defun process-wakeup (process)
    (declare (ignore process))
    nil)
  
+ #+LispWorks
+ (defun process-wakeup (process)
+   (let ((curproc mp:*current-process*))
+     (when (and curproc process)
+       (unless (mp:process-p curproc)
+ 	(error "~s is not a process" curproc))
+       (unless (mp::process-p process)
+ 	(error "~s is not a process" process))
+       (if (> (mp:process-priority process) (mp:process-priority curproc))
+ 	  (mp:process-allow-scheduling process)))))
  #+excl
  (defun process-wakeup (process)
    (let ((curproc mp::*current-process*))
***************
*** 1107,1113 ****
  
  ;;; Default return NIL, which is acceptable even if there is a scheduler.
  
! #-(or lispm excl lcl3.0 Minima)
  (defun current-process ()
    nil)
  
--- 1137,1143 ----
  
  ;;; Default return NIL, which is acceptable even if there is a scheduler.
  
! #-(or lispm excl lcl3.0 Minima LispWorks)
  (defun current-process ()
    nil)
  
***************
*** 1128,1139 ****
  (defun current-process ()
    (minima:current-process))
  
  ;;; WITHOUT-INTERRUPTS -- provide for atomic operations.
  
! #-(or lispm excl lcl3.0 Minima)
  (defmacro without-interrupts (&body body)
    `(progn ,@body))
  
  #+(and lispm (not Genera))
  (defmacro without-interrupts (&body body)
    `(sys:without-interrupts ,@body))
--- 1158,1177 ----
  (defun current-process ()
    (minima:current-process))
  
+ #+LispWorks
+ (defun current-process ()
+   mp:*current-process*)
+ 
  ;;; WITHOUT-INTERRUPTS -- provide for atomic operations.
  
! #-(or lispm excl lcl3.0 Minima LispWorks)
  (defmacro without-interrupts (&body body)
    `(progn ,@body))
  
+ #-LispWorks
+ (defmacro without-interrupts (&body body)
+   `(mp:without-preemption ,@body))
+ 
  #+(and lispm (not Genera))
  (defmacro without-interrupts (&body body)
    `(sys:without-interrupts ,@body))
***************
*** 1222,1232 ****
  ;;; OPEN-X-STREAM - create a stream for communicating to the appropriate X
  ;;; server
  
! #-(or explorer Genera lucid kcl ibcl excl Minima CMU)
  (defun open-x-stream (host display protocol)
    host display protocol ;; unused
    (error "OPEN-X-STREAM not implemented yet."))
  
  ;;; Genera:
  
  ;;; TCP and DNA are both layered products, so try to work with either one.
--- 1260,1288 ----
  ;;; OPEN-X-STREAM - create a stream for communicating to the appropriate X
  ;;; server
  
! 
! #-(or explorer Genera lucid kcl ibcl excl Minima LispWorks CMU)
  (defun open-x-stream (host display protocol)
    host display protocol ;; unused
    (error "OPEN-X-STREAM not implemented yet."))
  
+ ;;; LispWorks
+ 
+ 
+ #+LispWorks
+ (defun open-x-stream (host display protocol)
+   (declare (ignore protocol))
+   (if (or (string= host "") (not host) (string= host "/local"))
+       #+uk.org.bew.comm-ext(uk.org.bew.comm-ext:open-unix-stream host *x-unix-path*
+                                             :direction :io
+                                             :element-type 'unsigned-byte
+                                             :errorp t)
+     #-uk.org.bew.comm-ext(error "Need to load uk.org.bew.comm-ext for unix domain sockets")
+   (comm:open-tcp-stream host (+ *x-tcp-port* display)
+                         :direction :io
+                         :element-type 'unsigned-byte
+                         :errorp t)))
+ 
  ;;; Genera:
  
  ;;; TCP and DNA are both layered products, so try to work with either one.
***************
*** 1464,1475 ****
  			      vector start (- end start))
  	 nil)))
  
  ;;; WARNING:
  ;;;	CLX performance will suffer if your lisp uses read-byte for
  ;;;	receiving all data from the X Window System server.
  ;;;	You are encouraged to write a specialized version of
  ;;;	buffer-read-default that does block transfers.
! #-(or Genera explorer excl lcl3.0 Minima CMU)
  (defun buffer-read-default (display vector start end timeout)
    (declare (type display display)
  	   (type buffer-bytes vector)
--- 1520,1545 ----
  			      vector start (- end start))
  	 nil)))
  
+ #+LispWorks
+ (defun buffer-read-default (display vector start end timeout)
+   (declare (type display display)
+ 	   (type buffer-bytes vector)
+ 	   (type array-index start end)
+ 	   (type (or null (real 0 *)) timeout))
+   #.(declare-buffun)
+   (cond ((and (and timeout (= timeout 0))
+ 	      (not (listen (display-input-stream display))))
+ 	 :timeout)
+ 	(t
+          (read-sequence vector (display-input-stream display) :start start :end end)
+          nil)))
+ ;;; (read-sequence vector (display-input-stream display) :start start :end end)
  ;;; WARNING:
  ;;;	CLX performance will suffer if your lisp uses read-byte for
  ;;;	receiving all data from the X Window System server.
  ;;;	You are encouraged to write a specialized version of
  ;;;	buffer-read-default that does block transfers.
! #-(or Genera explorer excl lcl3.0 Minima CMU LispWorks)
  (defun buffer-read-default (display vector start end timeout)
    (declare (type display display)
  	   (type buffer-bytes vector)
***************
*** 1491,1496 ****
--- 1561,1567 ----
  		(return t)
  	      (setf (aref vector index) (the card8 c))))))))
  
+ 
  ;;; BUFFER-WRITE-DEFAULT - write data to the X stream
  
  #+(or Genera explorer)
***************
*** 1551,1563 ****
    (system:output-raw-bytes (display-output-stream display) vector start end)
    nil)
  
  ;;; WARNING:
  ;;;	CLX performance will be severely degraded if your lisp uses
  ;;;	write-byte to send all data to the X Window System server.
  ;;;	You are STRONGLY encouraged to write a specialized version
  ;;;	of buffer-write-default that does block transfers.
  
! #-(or Genera explorer excl lcl3.0 Minima CMU)
  (defun buffer-write-default (vector display start end)
    ;; The default buffer write function for use with common-lisp streams
    (declare (type buffer-bytes vector)
--- 1622,1643 ----
    (system:output-raw-bytes (display-output-stream display) vector start end)
    nil)
  
+ #+LispWorks
+ (defun buffer-write-default (vector display start end)
+   (declare (type buffer-bytes vector)
+ 	   (type display display)
+ 	   (type array-index start end))
+   #.(declare-buffun)
+   (write-sequence vector (display-output-stream display) :start start :end end)
+   nil)
+ 
  ;;; WARNING:
  ;;;	CLX performance will be severely degraded if your lisp uses
  ;;;	write-byte to send all data to the X Window System server.
  ;;;	You are STRONGLY encouraged to write a specialized version
  ;;;	of buffer-write-default that does block transfers.
  
! #-(or Genera explorer excl lcl3.0 Minima CMU LispWorks)
  (defun buffer-write-default (vector display start end)
    ;; The default buffer write function for use with common-lisp streams
    (declare (type buffer-bytes vector)
***************
*** 2302,2308 ****
  ;;  HOST hacking
  ;;-----------------------------------------------------------------------------
  
! #-(or explorer Genera Minima Allegro CMU)
  (defun host-address (host &optional (family :internet))
    ;; Return a list whose car is the family keyword (:internet :DECnet :Chaos)
    ;; and cdr is a list of network address bytes.
--- 2382,2388 ----
  ;;  HOST hacking
  ;;-----------------------------------------------------------------------------
  
! #-(or explorer Genera Minima LispWorks Allegro CMU)
  (defun host-address (host &optional (family :internet))
    ;; Return a list whose car is the family keyword (:internet :DECnet :Chaos)
    ;; and cdr is a list of network address bytes.
***************
*** 2312,2317 ****
--- 2392,2419 ----
    host family
    (error "HOST-ADDRESS not implemented yet."))
  
+ #+LispWorks
+ (defun host-address (host &optional (family :internet))
+   ;; Return a list whose car is the family keyword (:internet :DECnet :Chaos)
+   ;; and cdr is a list of network address bytes.
+   (declare (type stringable host)
+ 	   (type (or null (member :internet :decnet :chaos) card8) family))
+   (declare (values list))
+   (labels ((no-host-error ()
+ 	     (error "Unknown host ~S" host))
+ 	   (no-address-error ()
+ 	     (error "Host ~S has no ~S address" host family)))
+     (let ((addr (comm:get-host-entry (string host) :fields '(:address))))
+       (when (not addr)
+ 	(no-host-error))
+       (ecase family
+ 	((:internet 0)
+          (list :internet
+                (ldb (byte 8 24) addr)
+                (ldb (byte 8 16) addr)
+                (ldb (byte 8  8) addr)
+                (ldb (byte 8  0) addr)))))))
+ 
  #+explorer
  (defun host-address (host &optional (family :internet))
    ;; Return a list whose car is the family keyword (:internet :DECnet :Chaos)
***************
*** 2541,2546 ****
--- 2643,2649 ----
  
  (defun default-resources-pathname ()
    (homedir-file-pathname ".Xdefaults"))
+ 
  
  ;;; RESOURCES-PATHNAME - The pathname of the resources file to load after the
  ;;; defaults have been loaded.
Index: CLX/display.l
diff -c CLX/display.l:1.1.1.2 CLX/display.l:1.3
*** CLX/display.l:1.1.1.2	Sun Sep 23 21:43:15 2001
--- CLX/display.l	Mon Sep 24 21:13:41 2001
***************
*** 49,81 ****
  	    (let* ((host-family (ecase protocol
  				  ((:tcp :internet nil) 0)
  				  ((:dna :DECnet) 1)
! 				  ((:chaos) 2)))
! 		   (host-address (rest (host-address host host-family)))
  		   (best-name nil)
  		   (best-data nil))
  	      (loop
! 		(let ((family (read-short stream nil)))
! 		  (when (null family)
! 		    (return))
! 		  (let* ((address (read-short-length-vector stream))
! 			 (number (parse-integer (read-short-length-string stream)))
! 			 (name (read-short-length-string stream))
! 			 (data (read-short-length-vector stream)))
! 		    (when (and (= family host-family)
! 			       (equal host-address (coerce address 'list))
! 			       (= number display)
! 			       (let ((pos1 (position name *known-authorizations* :test #'string=)))
! 				 (and pos1
! 				      (or (null best-name)
! 					  (< pos1 (position best-name *known-authorizations*
! 							    :test #'string=))))))
! 		      (setf best-name name)
! 		      (setf best-data data)))))
  	      (when best-name
  		(return-from get-best-authorization
  		  (values best-name best-data)))))))))
    (values "" ""))
  
  ;;
  ;; Resource id management
  ;;
--- 49,85 ----
  	    (let* ((host-family (ecase protocol
  				  ((:tcp :internet nil) 0)
  				  ((:dna :DECnet) 1)
! 				  ((:chaos) 2)
! 				  ((:unix) 256)))
! 		   (host-address (if (eq protocol :unix)
! 				     (map 'list #'char-int (machine-instance))
!                                    (rest (host-address host host-family))))
  		   (best-name nil)
  		   (best-data nil))
  	      (loop
! 	       (let ((family (read-short stream nil)))
! 		 (when (null family)
! 		   (return))
! 		 (let* ((address (read-short-length-vector stream))
! 			(number (parse-integer (read-short-length-string stream)))
! 			(name (read-short-length-string stream))
! 			(data (read-short-length-vector stream)))
! 		   (when (and (= family host-family)
! 			      (equal host-address (coerce address 'list))
! 			      (= number display)
! 			      (let ((pos1 (position name *known-authorizations* :test #'string=)))
! 				(and pos1
! 				     (or (null best-name)
! 					 (< pos1 (position best-name *known-authorizations*
! 							   :test #'string=))))))
! 		     (setf best-name name)
! 		     (setf best-data data)))))
  	      (when best-name
  		(return-from get-best-authorization
  		  (values best-name best-data)))))))))
    (values "" ""))
  
+ 
  ;;
  ;; Resource id management
  ;;
***************
*** 290,299 ****
    ;; if any, is assumed to come from the environment somehow.
    (declare (type integer display))
    (declare (clx-values display))
!   ;; Get the authorization mechanism from the environment.
    (when (null authorization-name)
      (multiple-value-setq (authorization-name authorization-data)
!       (get-best-authorization host display protocol)))
    ;; PROTOCOL is the network protocol (something like :TCP :DNA or :CHAOS). See OPEN-X-STREAM.
    (let* ((stream (open-x-stream host display protocol))
  	 (disp (make-buffer *output-buffer-size* #'make-display-internal
--- 294,309 ----
    ;; if any, is assumed to come from the environment somehow.
    (declare (type integer display))
    (declare (clx-values display))
!   ;; Get the authorization mechanism from the environment.  Handle the
!   ;; special case of a host name of "" and "/local" which means the
!   ;; protocol is :unix
    (when (null authorization-name)
      (multiple-value-setq (authorization-name authorization-data)
!       (get-best-authorization host
! 			      display
! 			      (if (member host '("" "/local") :test #'string-equal)
! 				  :unix
! 				  protocol))))
    ;; PROTOCOL is the network protocol (something like :TCP :DNA or :CHAOS). See OPEN-X-STREAM.
    (let* ((stream (open-x-stream host display protocol))
  	 (disp (make-buffer *output-buffer-size* #'make-display-internal
Index: CLX/package.l
diff -c CLX/package.l:1.1.1.2 CLX/package.l:1.3
*** CLX/package.l:1.1.1.2	Sun Sep 23 21:43:17 2001
--- CLX/package.l	Mon Sep 24 21:13:41 2001
***************
*** 233,238 ****
--- 233,239 ----
    #+(or kcl ibcl) (:shadow rational)
    #+allegro (:use cltl1)
    #+allegro (:import-from excl without-interrupts)
+   #+LispWorks (:import-from mp without-interrupts)
    #+excl (:import-from excl arglist)
    #+Genera (:import-from zwei indentation)
    #+lcl3.0 (:import-from lcl arglist)
Index: CLX/demo/qix.l
diff -c /dev/null CLX/demo/qix.l:1.1
*** /dev/null	Wed Nov  5 19:47:46 2003
--- CLX/demo/qix.l	Sat Sep 27 15:13:11 2003
***************
*** 0 ****
--- 1,96 ----
+ ;;;;
+ ;;;;     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 :xlib)
+ 
+ (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)
+      (setq n (- n 1))
+      (if (<= n 0) (return)))))
+ 
+ (defun qix (&key host display dpy
+             (width 400) (height 400) (delay 0.05) (nqixs 3) (nlines 80))
+  #+ignore(setf (values host display) (x-host-display))
+   (let* ((dp1 (or dpy (xlib:open-display host))) ;:display display)))
+          (scr (first (xlib:display-roots dp1)))
+          (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 10 :y 10
+                                   :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 dp1)
+     (format t "~&Qix uses the following parameters:~%  :dpy: ~s
+   :host ~s :display ~s
+   :width ~d :height ~d :delay ~f :nqixs ~d :nlines ~d~%"
+             dp1 host display  width height delay nqixs nlines)
+     (draw-qix dp1 win gcon width height white-pixel black-pixel
+               delay nqixs nlines)
+     (xlib:unmap-window win)
+     (xlib:destroy-window win)
+     ;;clean-up
+     (unless dpy (xlib:close-display dp1))))
+ 
+ ;; since we have no herald, simply dump it:
+ (format t "~& The famous swirling vectors.~%
+   (xlib::qix :host :display :dpy :width :height :delay :nqixs :nlines)
+ ~% Call (xlib::qix :host \"\") or (xlib::qix :host \"\" :delay 0).~%")
+ 
