File clisp-2.49-clx_demos.dif of Package clisp

Overview Repositories Revisions Requests Users Attributes Meta

File clisp-2.49-clx_demos.dif of Package clisp

---
 modules/clx/new-clx/demos/README         |    4 +--
 modules/clx/new-clx/demos/clx-demos.lisp |    2 -
 modules/clx/new-clx/demos/koch.lisp      |   29 +++++++++++++++++++++++++-
 modules/clx/new-clx/demos/qix.lisp       |   30 ++++++++++++++++++++++++++-
 modules/clx/new-clx/demos/sokoban.lisp   |   34 +++++++++++++++++++++++++++++--
 5 files changed, 92 insertions(+), 7 deletions(-)

--- a/modules/clx/new-clx/demos/README
+++ b/modules/clx/new-clx/demos/README
@@ -3,8 +3,8 @@ Most came with the original CLX and has
 Some are original with CLISP (notably sokoban).
 
 To try them, do
-$ clisp -i clx-demos
+$ clisp -K full -i clx-demos
 and read the instructions.
 
 To try them all, one by one, do
-$ clisp -i clx-demos -x '(clx-demos:run-all-demos)'
+$ clisp -K full -i clx-demos -x '(clx-demos:run-all-demos)'
--- a/modules/clx/new-clx/demos/clx-demos.lisp
+++ b/modules/clx/new-clx/demos/clx-demos.lisp
@@ -13,7 +13,7 @@
 
 (defparameter *demos*
   ;; (demo-name [package requirements])
-  '((koch) (qix) (sokoban #:xpm) (greynetic) (petal) (hanoi)
+  '((greynetic) (petal) (hanoi)
     (recurrence) (plaid) (clclock) (bball) (bwindow)))
 
 (defmacro do-demos ((fun-var) &body body)
--- a/modules/clx/new-clx/demos/koch.lisp
+++ b/modules/clx/new-clx/demos/koch.lisp
@@ -5,7 +5,30 @@
 ;;; See http://www.gnu.org/copyleft/gpl.html
 ;;;
 
-(in-package :clx-demos)
+(defpackage "KOCH"
+  (:use "COMMON-LISP" "XLIB" "EXT")
+  (:import-from "SYS" "GETENV")
+  (:shadowing-import-from "XLIB" "CHAR-WIDTH") ; EXT has CHAR-WIDTH
+  (:export "KOCH"))
+
+(in-package :koch)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun x-host-display (&optional (disp (getenv "DISPLAY")))
+  "Parse the DISPLAY environment variable.
+Return 3 values: host, server, screen."
+  (if disp
+      (let* ((pos1 (position #\: disp))
+             (pos2 (and pos1 (position #\. disp :start pos1))))
+        (values (subseq disp 0 pos1)
+                (if pos1 (parse-integer (subseq disp (1+ pos1) pos2)) 0)
+                (if pos2 (parse-integer (subseq disp (1+ pos2))) 0)))
+      (values "" 0 0)))
+
+(defun x-open-display ()
+  "Open the appropriate X display."
+  (multiple-value-bind (host di) (x-host-display)
+    (xlib:open-display host :display di)))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defun koch-point (cx width/2 height/2 scale)
   (list (round (+ width/2 (* scale width/2 (realpart cx))))
@@ -121,4 +144,8 @@ Returns the new list and an indicator of
       (xlib:unmap-window win)
       (xlib:display-finish-output dpy))))
 
+(format t "~& Koch snoflake:~%
+  (koch:koch :width :height :delay :x :y :scale :font)
+~% Call (koch:koch)~%~%")
+
 (provide "koch")
--- a/modules/clx/new-clx/demos/qix.lisp
+++ b/modules/clx/new-clx/demos/qix.lisp
@@ -14,7 +14,30 @@
 ;;;; o or a spline option?!
 ;;;;
 
-(in-package :clx-demos)
+(defpackage "QIX"
+  (:use "COMMON-LISP" "XLIB" "EXT")
+  (:import-from "SYS" "GETENV")
+  (:shadowing-import-from "XLIB" "CHAR-WIDTH") ; EXT has CHAR-WIDTH
+  (:export "QIX"))
+
+(in-package :qix)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun x-host-display (&optional (disp (getenv "DISPLAY")))
+  "Parse the DISPLAY environment variable.
+Return 3 values: host, server, screen."
+  (if disp
+      (let* ((pos1 (position #\: disp))
+             (pos2 (and pos1 (position #\. disp :start pos1))))
+        (values (subseq disp 0 pos1)
+                (if pos1 (parse-integer (subseq disp (1+ pos1) pos2)) 0)
+                (if pos2 (parse-integer (subseq disp (1+ pos2))) 0)))
+      (values "" 0 0)))
+
+(defun x-open-display ()
+  "Open the appropriate X display."
+  (multiple-value-bind (host di) (x-host-display)
+    (xlib:open-display host :display di)))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defvar *offset* 3)
 (defvar *delta* 6)
@@ -87,4 +110,9 @@
       (xlib:unmap-window win)
       (xlib:display-finish-output dpy))))
 
+;; since we have no herald, simply dump it:
+(format t "~& The famous swirling vectors.~%
+ (qix:qix :host :display :dpy :width :height :delay :nqixs :nlines)
+~% Call (qix:qix) or (qix:qix :delay 0)~%~%")
+
 (provide "qix")
--- a/modules/clx/new-clx/demos/sokoban.lisp
+++ b/modules/clx/new-clx/demos/sokoban.lisp
@@ -41,7 +41,30 @@
 ;;;;  - maximum field size is hard wired to 20x20. (This is not in the LISP spirit!)
 ;;;;  - sometimes the programm could not count correctly ...
 
-(in-package :clx-demos)
+(defpackage "SOKOBAN"
+  (:use "COMMON-LISP")
+  (:import-from "SYS" "GETENV")
+  (:import-from "XLIB" "CLOSED-DISPLAY-P")
+  (:export "SOKOBAN"))
+
+(in-package :sokoban)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun x-host-display (&optional (disp (getenv "DISPLAY")))
+  "Parse the DISPLAY environment variable.
+Return 3 values: host, server, screen."
+  (if disp
+      (let* ((pos1 (position #\: disp))
+             (pos2 (and pos1 (position #\. disp :start pos1))))
+        (values (subseq disp 0 pos1)
+                (if pos1 (parse-integer (subseq disp (1+ pos1) pos2)) 0)
+                (if pos2 (parse-integer (subseq disp (1+ pos2))) 0)))
+      (values "" 0 0)))
+
+(defun x-open-display ()
+  "Open the appropriate X display."
+  (multiple-value-bind (host di) (x-host-display)
+    (xlib:open-display host :display di)))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ;;;; First a lot of global variables ...
 (defvar *pixmaps* nil)                  ;array of pixmaps according to below indices
@@ -228,7 +251,12 @@
                  (nny (+ ny dy)))
              (when (>= (field nnx nny) %floor)
                ;;Ok its legal ...
-               (when (and (= (field nx ny) %object)
+               ;;Allow moving through
+               (when (and (= (field nx ny)   %treasure)
+                          (= (field nnx nny) %floor))
+                 (incf *n-objects*))
+               ;;Take this point
+               (when (and (= (field nx ny)   %object)
                           (= (field nnx nny) %goal))
                  (decf *n-objects*))
                (incf (field nx ny) 4)   ;remove object and add man
@@ -475,4 +503,6 @@ If you quit sokoban using 'q' the curren
          (setq *level* 1)
          (init-field))) )
 
+(format t "~&~% Call (sokoban:sokoban)~%~%")
+
 (provide "sokoban")

Places

File clisp-2.49-clx_demos.dif of Package clisp

Places