From: Frank Buss
Subject: tilt mazes
Date: 
Message-ID: <ck7b2s$1ac$1@newsreader2.netcologne.de>
For my Lisp CPU I need a small game, so I've implemented it first, 
because then I know what I need to implement for the CPU :-)

It is a 2D maze, but you can tilt to the walls, only. The sample board 
layouts are from the Java Applet version:

http://www.clickmazes.com/newtilt/ixtilt2d.htm

Below is the text-mode Lisp version. In LispWorks the keys are evaluated 
after you press it, in CLisp you have to press "enter" after a key.

Start it with (play-maze 0) or (play-maze 1). Solutions:

level 0: jlklkhklkhjl
level 1: kljhkhjhklkhjhk

The source: (thanks for the Generalized Reference answers, but now I use 
a standard array, so I don't need it any more)

(defparameter *mazes*
  '(("###########"
     "#o    #   #"
     "# ### # # #"
     "#         #"
     "# # # # ###"
     "# #       #"
     "# # ### # #"
     "#         #"
     "# ### # ###"
     "#     #  T#"
     "###########")
    ("#############"
     "# #       # #"
     "# # ### # # #"
     "#           #"
     "# # # # ### #"
     "# # #o#     #"
     "# # ##### ###"
     "#     #T#   #"
     "### # # # # #"
     "#           #"
     "# # # # # ###"
     "#   # #     #"
     "#############")))

(defun print-maze-array (maze-array)
  (terpri)
  (destructuring-bind (width height) (array-dimensions maze-array)
    (loop for y from 0 to (1- height) do
          (loop for x from 0 to (1- width) do
                (let ((field (aref maze-array x y)))
                  (princ (cond ((eq field 'stone) #\o)
                               ((eq field 'target) #\T)
                               ((eq field 'empty) #\Space)
                               (t #\#)))))
          (terpri))))

(defun search-stone (maze-array)
  (destructuring-bind (width height) (array-dimensions maze-array)
    (loop for y from 0 to (1- height) do
          (loop for x from 0 to (1- width) do
                (when (eq (aref maze-array x y) 'stone)
                  (return-from search-stone (values x y)))))))

(defun search-wall (maze-array x y dx dy)
  (loop until (eq (aref maze-array x y) 'wall) do
        (incf x dx)
        (incf y dy))
  (values x y))

(defun move-stone (maze-array dx dy)
  (multiple-value-bind (x y) (search-stone maze-array)
    (setf (aref maze-array x y) 'empty)
    (multiple-value-bind (x y) (search-wall maze-array x y dx dy)
      (let* ((xb (- x dx))
             (yb (- y dy))
             (old (aref maze-array xb yb)))
        (setf (aref maze-array xb yb) 'stone)
        old))))

(defun make-maze-array (maze)
  (let* ((width (length (car maze)))
         (height (length maze))
         (maze-array (make-array (list width height)))
         (y 0))
    (dolist (line maze)
      (loop for x from 0 to (1- (length line)) do
            (let ((char (elt line x)))
              (setf (aref maze-array x y)
                    (cond ((eq char #\o) 'stone)
                          ((eq char #\T) 'target)
                          ((eq char #\Space) 'empty)
                          (t 'wall)))))
      (incf y))
    maze-array))

(defun play-maze (number)
  (format t "Keys are standard VI keys:~%")
  (format t "l: right~%")
  (format t "k: up~%")
  (format t "j: down~%")
  (format t "h: left~%")
  (format t "q: quit~%")
  (let ((maze-array (make-maze-array (elt *mazes* number)))
        (old nil))
    (do ((char nil (read-char)))
        ((eq char #\q) "quit")
      (cond ((eq char #\h) (setf old (move-stone maze-array -1 0)))
            ((eq char #\l) (setf old (move-stone maze-array 1 0)))
            ((eq char #\k) (setf old (move-stone maze-array 0 -1)))
            ((eq char #\j) (setf old (move-stone maze-array 0 1))))
      (print-maze-array maze-array)
      (when (eq old 'target) (return "won")))))


-- 
Frank Bu�, ··@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de

From: Time Waster
Subject: Re: tilt mazes
Date: 
Message-ID: <1097312022.DqKdecTHNoo23olLFnCfig@teranews>
On Sat, 9 Oct 2004 00:23:57 +0000 (UTC), <··@frank-buss.de> wrote:
> It is a 2D maze, but you can tilt to the walls, only. The sample board 
> layouts are from the Java Applet version:
>
> Start it with (play-maze 0) or (play-maze 1). Solutions:
>
> level 0: jlklkhklkhjl

ljhklkhjl
From: Frank Buss
Subject: Re: tilt mazes
Date: 
Message-ID: <ck8qk3$g4c$1@newsreader2.netcologne.de>
Time Waster <········@CloudDancer.com> wrote:

>> level 0: jlklkhklkhjl
> 
> ljhklkhjl

yes, this is the shortest way. I've implemented a solver (it is really 
fast, because you have to save at most one path for a field) and converted 
all 25 mazes from the Java Applet:

http://www.frank-buss.de/lisp/tilt-mazes.lisp.txt

Now the functions needs to be enhanced for the Multi-Goal mazes and the 
program needs a GUI.

I think such game projects, or parts of such projects, would be nice for 
homework, because it would be more motivating, compared to boring tasks 
like median calculating.

-- 
Frank Bu�, ··@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de
From: Time Waster
Subject: Re: tilt mazes
Date: 
Message-ID: <1097350719.KfwSbhOCGyyx0xa/Ao3WBQ@teranews>
On Sat, 9 Oct 2004 13:55:16 +0000 (UTC), <··@frank-buss.de> wrote:
>
> I think such game projects, or parts of such projects, would be nice for 
> homework, because it would be more motivating, compared to boring tasks 
> like median calculating.


Actually, I was looking at it as a test program to see if I've got
Kozas GPP running correctly (and have fed it the 'right stuff').
From: Pascal Bourguignon
Subject: Re: tilt mazes
Date: 
Message-ID: <874ql4x9gl.fsf@thalassa.informatimago.com>
Frank Buss <··@frank-buss.de> writes:
> (defun play-maze (number)
>   (format t "Keys are standard VI keys:~%")
>   (format t "l: right~%")
>   (format t "k: up~%")
>   (format t "j: down~%")
>   (format t "h: left~%")
>   (format t "q: quit~%")
>   (let ((maze-array (make-maze-array (elt *mazes* number)))
>         (old nil))
>     (do ((char nil (read-char)))
>         ((eq char #\q) "quit")
>       (cond ((eq char #\h) (setf old (move-stone maze-array -1 0)))
>             ((eq char #\l) (setf old (move-stone maze-array 1 0)))
>             ((eq char #\k) (setf old (move-stone maze-array 0 -1)))
>             ((eq char #\j) (setf old (move-stone maze-array 0 1))))
>       (print-maze-array maze-array)
>       (when (eq old 'target) (return "won")))))

In clisp you can use the with-keyboard / * keyboard-input* extension. Try:

(ext:with-keyboard 
   (loop do (when (char= #\return (print (system::input-character-char 
                                            (read-char ext:*keyboard-input*))))
                 (loop-finish))))

(ext:with-keyboard 
    (do ((char nil (system::input-character-char 
                        (read-char ext:*keyboard-input*))))
         ((eq char #\q) "quit")
       (cond ((eq char #\h) (setf old (move-stone maze-array -1 0)))
             ((eq char #\l) (setf old (move-stone maze-array 1 0)))
             ((eq char #\k) (setf old (move-stone maze-array 0 -1)))
             ((eq char #\j) (setf old (move-stone maze-array 0 1))))
       (print-maze-array maze-array)
       (when (eq old 'target) (return "won"))) )


(I've not found another API than this "private"
system::input-character-char to extract the character from the
input-character...)

-- 
__Pascal Bourguignon__                     http://www.informatimago.com/

Voting Democrat or Republican is like choosing a cabin in the Titanic.
From: Szymon
Subject: Re: tilt mazes
Date: 
Message-ID: <87k6tzrorh.fsf@eva.rplacd.net>
Frank Buss <··@frank-buss.de> writes:

> For my Lisp CPU I need a small game, so I've implemented it first, 
> because then I know what I need to implement for the CPU :-)

? wow... ?
post a link please...

> ...............................

>     (loop for y from 0 to (1- height) do

why not 'upto height', 'upto width'?

>           (loop for x from 0 to (1- width) do
>                 (let ((field (aref maze-array x y)))
>                   (princ (cond ((eq field 'stone) #\o)
>                                ((eq field 'target) #\T)
>                                ((eq field 'empty) #\Space)
>                                (t #\#)))))

(case field
  (stone #\o)
  (target #\T)
  (empty #\Space)
  (t #\#))


> ...............................

>               (setf (aref maze-array x y)
>                     (cond ((eq char #\o) 'stone)
>                           ((eq char #\T) 'target)
>                           ((eq char #\Space) 'empty)
>                           (t 'wall)))))

You do not like CASE?

> ..............................

>       (cond ((eq char #\h) (setf old (move-stone maze-array -1 0)))
>             ((eq char #\l) (setf old (move-stone maze-array 1 0)))
>             ((eq char #\k) (setf old (move-stone maze-array 0 -1)))
>             ((eq char #\j) (setf old (move-stone maze-array 0 1))))

why not:

(setf old
      (apply #'move-stone maze-array
	     (case char (#\h '(-1 0)) (#\l '(1 0)) (#\k '(0 -1)) (#\j '(0 1)))))

Regards, Szymon.
From: Kenny Tilton
Subject: Re: tilt mazes
Date: 
Message-ID: <mb7ad.13860$4C.3629120@twister.nyc.rr.com>
Szymon wrote:
> Frank Buss <··@frank-buss.de> writes:
>>    (loop for y from 0 to (1- height) do
> 
> 
> why not 'upto height', 'upto width'?

"to (1- height)" would be "below height", not upto.
btw, "from 0" can be left off since that is the default:

   (loop for y below height do...

kenny

-- 
Cells? Cello? Celtik?: http://www.common-lisp.net/project/cells/
Why Lisp? http://alu.cliki.net/RtL%20Highlight%20Film
From: Szymon
Subject: Re: tilt mazes
Date: 
Message-ID: <87fz4msmj0.fsf@eva.rplacd.net>
Kenny Tilton <·······@nyc.rr.com> writes:

> Szymon wrote:
> > Frank Buss <··@frank-buss.de> writes:
> >>    (loop for y from 0 to (1- height) do
> > why not 'upto height', 'upto width'?
> 
> "to (1- height)" would be "below height", not upto.
> btw, "from 0" can be left off since that is the default:
> 
>    (loop for y below height do...

Oh, I'm sorry. I was in hurry... (bikeriding :)

Regards, Szymon.
From: Pascal Bourguignon
Subject: Re: tilt mazes
Date: 
Message-ID: <877jpyvew3.fsf@thalassa.informatimago.com>
Kenny Tilton <·······@nyc.rr.com> writes:
> btw, "from 0" can be left off since that is the default:
> 
>    (loop for y below height do...

But this assumes a human reader that have read and memorized the
relevant page of CLHS!

    (loop for y from 0 below height do ...

can be understood by any programmer, had him read or not CLHS, knowing
or not lisp.

-- 
__Pascal Bourguignon__                     http://www.informatimago.com/

Voting Democrat or Republican is like choosing a cabin in the Titanic.
From: Kenny Tilton
Subject: Re: tilt mazes
Date: 
Message-ID: <wJcad.14517$4C.3701247@twister.nyc.rr.com>
Pascal Bourguignon wrote:

> Kenny Tilton <·······@nyc.rr.com> writes:
> 
>>btw, "from 0" can be left off since that is the default:
>>
>>   (loop for y below height do...
> 
> 
> But this assumes a human reader that have read and memorized the
> relevant page of CLHS!
> 
>     (loop for y from 0 below height do ...
> 
> can be understood by any programmer, had him read or not CLHS, knowing
> or not lisp.

Rubbish. If Bubba your ignorant programmer cannot guess from the context 
(iterating over an array) that the unspecified starting point must be 
zero, then he is not smart enough to be using or even reading Lisp.

Besides, I am supposed to clutter up my (or the OP's) code with noise so 
some imagined, ignorant, CLHS-eschewing dweeb who should be reading a 
tabloid newspaper will be able to understand my code without thinking? 
Maybe not...

By your reasoning, if I may be so generous, we must also go back to (1- 
height) because Bubba the Hapless Lisp Reader will not be aware the LOOP 
designers made easy the frequent requirement to iterate N times with 
indices 0 to (1- N).

:)

kenny


-- 
Cells? Cello? Celtik?: http://www.common-lisp.net/project/cells/
Why Lisp? http://alu.cliki.net/RtL%20Highlight%20Film
From: Coby Beck
Subject: Re: tilt mazes
Date: 
Message-ID: <FVgad.3436$Ia5.573@edtnps89>
"Kenny Tilton" <·······@nyc.rr.com> wrote in message 
···························@twister.nyc.rr.com...
> Pascal Bourguignon wrote:
>> Kenny Tilton <·······@nyc.rr.com> writes:
>>
>>>btw, "from 0" can be left off since that is the default:
>>>
>>>   (loop for y below height do...
>>
>> But this assumes a human reader that have read and memorized the
>> relevant page of CLHS!
>>
>>     (loop for y from 0 below height do ...
>>
>> can be understood by any programmer, had him read or not CLHS, knowing
>> or not lisp.
>
> Rubbish. If Bubba your ignorant programmer cannot guess from the context 
> (iterating over an array) that the unspecified starting point must be 
> zero, then he is not smart enough to be using or even reading Lisp.
>
> Besides, I am supposed to clutter up my (or the OP's) code with noise so 
> some imagined, ignorant, CLHS-eschewing dweeb who should be reading a 
> tabloid newspaper will be able to understand my code without thinking? 
> Maybe not...
>
> By your reasoning, if I may be so generous, we must also go back to (1- 
> height) because Bubba the Hapless Lisp Reader will not be aware the LOOP 
> designers made easy the frequent requirement to iterate N times with 
> indices 0 to (1- N).

Indeed!  Also how do I know it goes up by 1 (or up at all) each iteration? 
Better write:

(loop for y upfrom 0 by 1 to (1- height) do ...)

;)

-- 
Coby Beck
(remove #\Space "coby 101 @ big pond . com")
From: Kenny Tilton
Subject: Re: tilt mazes
Date: 
Message-ID: <ft7ad.13891$4C.3630598@twister.nyc.rr.com>
Szymon wrote:

> Frank Buss <··@frank-buss.de> writes:
>>              (setf (aref maze-array x y)
>>                    (cond ((eq char #\o) 'stone)
>>                          ((eq char #\T) 'target)
>>                          ((eq char #\Space) 'empty)
>>                          (t 'wall)))))
> 
> 
> You do not like CASE?
> 
> 
>>..............................
> 
> 
>>      (cond ((eq char #\h) (setf old (move-stone maze-array -1 0)))
>>            ((eq char #\l) (setf old (move-stone maze-array 1 0)))
>>            ((eq char #\k) (setf old (move-stone maze-array 0 -1)))
>>            ((eq char #\j) (setf old (move-stone maze-array 0 1))))
> 
> 
> why not:
> 
> (setf old
>       (apply #'move-stone maze-array
> 	     (case char (#\h '(-1 0)) (#\l '(1 0)) (#\k '(0 -1)) (#\j '(0 1)))))

Which also corrects the mistake of using EQ on chars (because CASE uses 
EQL):

"An implementation is permitted to make "copies" of characters and 
numbers at any time. The effect is that Common Lisp makes no guarantee 
that eq is true even when both its arguments are "the same thing" if 
that thing is a character or number." - clhs 5.3.33


-- 
Cells? Cello? Celtik?: http://www.common-lisp.net/project/cells/
Why Lisp? http://alu.cliki.net/RtL%20Highlight%20Film
From: Szymon
Subject: Re: tilt mazes
Date: 
Message-ID: <87brfasiuf.fsf@eva.rplacd.net>
Frank Buss <··@frank-buss.de> writes:

> [ ... nice code ... ]

More concise versions:

Yours version 11 lines.

> (defun print-maze-array (maze-array)
>   (terpri)
>   (destructuring-bind (width height) (array-dimensions maze-array)
>     (loop for y from 0 to (1- height) do
>           (loop for x from 0 to (1- width) do
>                 (let ((field (aref maze-array x y)))
>                   (princ (cond ((eq field 'stone) #\o)
>                                ((eq field 'target) #\T)
>                                ((eq field 'empty) #\Space)
>                                (t #\#)))))
>           (terpri))))

;; 9 lines

(defun print-maze-array (maze-array)
  (terpri)
  (destructuring-bind (width height) (array-dimensions maze-array)
    (loop for y below height do
          (loop for x below width do
		(format t "~[o~;T~; ~;#~]"
			(case (aref maze-array x y)
			  (stone 0) (target 1) (empty 2) (t 3))))
          (terpri))))


;; 7 lines

(defun print-maze-array (maze-array)
  (destructuring-bind (width height) (array-dimensions maze-array)
    (format t "~%~{~{~[o~;T~; ~;#~]~}~%~}"
	    (loop for y below height collect
		  (loop for x below width collect
			(case (aref maze-array x y)
			  (stone 0) (target 1) (empty 2) (t 3)))))))

Yours version 17 lines.

> (defun play-maze (number)
>   (format t "Keys are standard VI keys:~%")
>   (format t "l: right~%")
>   (format t "k: up~%")
>   (format t "j: down~%")
>   (format t "h: left~%")
>   (format t "q: quit~%")
>   (let ((maze-array (make-maze-array (elt *mazes* number)))
>         (old nil))
>     (do ((char nil (read-char)))
>         ((eq char #\q) "quit")
>       (cond ((eq char #\h) (setf old (move-stone maze-array -1 0)))
>             ((eq char #\l) (setf old (move-stone maze-array 1 0)))
>             ((eq char #\k) (setf old (move-stone maze-array 0 -1)))
>             ((eq char #\j) (setf old (move-stone maze-array 0 1))))
>       (print-maze-array maze-array)
>       (when (eq old 'target) (return "won")))))

;; not tested.

;; 12 lines.

(defun play-maze (number)
  (format t "Keys are standard VI keys:~:{~%~(~A: ~A~)~}"
	  '((l right) (k up) (j down) (h left) (q quit)))
  (let ((maze-array (make-maze-array (elt *mazes* number)))
	(old nil))
    (do ((char nil (read-char)))
	((eql char #\q) "quit")
      (setf old
	    (apply #'move-stone maze-array
		   (case char (#\h '(-1 0)) (#\l '(1 0)) (#\k '(0 -1)) (#\j '(0 1)))))
      (print-maze-array maze-array)
      (when (eql old 'target) (return "won")))))

Regards, Szymon.
From: Frank Buss
Subject: Re: tilt mazes
Date: 
Message-ID: <ckbt2o$o00$1@newsreader2.netcologne.de>
Szymon <············@o2.pl> wrote:

>> For my Lisp CPU I need a small game, so I've implemented it first, 
>> because then I know what I need to implement for the CPU :-)

> ? wow... ?
> post a link please...

http://www.frank-buss.de/lispcpu/index.html

> (defun print-maze-array (maze-array)
>   (terpri)
>   (destructuring-bind (width height) (array-dimensions maze-array)
>     (loop for y below height do
>           (loop for x below width do
>           (format t "~[o~;T~; ~;#~]"
>                (case (aref maze-array x y)
>                  (stone 0) (target 1) (empty 2) (t 3))))
>           (terpri))))

yes, that's shorter, but not more readable. "case" is a good idea, but 
the format looks too complicated, because the (human) reader has to 
switch back and forth between the format string and the case. I've 
changed it like this:

(defun print-maze-array (maze-array)
  (terpri)
  (destructuring-bind (width height) (array-dimensions maze-array)
    (loop for y below height do
          (loop for x below width do
                (princ (case (aref maze-array x y)
                         (stone #\o)
                         (target #\T)
                         (empty #\Space)
                         (t #\#))))
          (terpri))))

ok, it's 11 lines, but you can write all case conditions in one line (but 
I know it from C and Java, where I spent one line for each case), then it 
is 8 lines.

> ;; 7 lines
> 
> (defun print-maze-array (maze-array)
>   (destructuring-bind (width height) (array-dimensions maze-array)
>     (format t "~%~{~{~[o~;T~; ~;#~]~}~%~}"
>          (loop for y below height collect
>             (loop for x below width collect
>                (case (aref maze-array x y)
>                  (stone 0) (target 1) (empty 2) (t 3)))))))

This looks like Perl to me, not like a readable Lisp program :-)

> ;; 12 lines.
> 
> (defun play-maze (number)
>   (format t "Keys are standard VI keys:~:{~%~(~A: ~A~)~}"
>        '((l right) (k up) (j down) (h left) (q quit)))
>   (let ((maze-array (make-maze-array (elt *mazes* number)))
>      (old nil))
>     (do ((char nil (read-char)))
>      ((eql char #\q) "quit")
>       (setf old
>          (apply #'move-stone maze-array
>              (case char (#\h '(-1 0)) (#\l '(1 0)) (#\k '(0 -1)) (#\j
>              '(0 1))))) 
>       (print-maze-array maze-array)
>       (when (eql old 'target) (return "won")))))

This doesn't work, because the move stone expected two variables, not a 
list and if an unknown key is pressed, or at startup, NIL is returned by 
the case, which is not recognized by the move-stone.

The program needs the directions for the solving algorithm, so I've 
defined it as a constant alist, so the play-maze looks like this. I can't 
see any improvement by obscuring the manual with complex format strings, 
so it is my original version, but I've embedded some lets in a do* form, 
I think know it is more readable:

(defconstant *stone-directions*
  '((#\h -1 0) (#\l 1 0) (#\k 0 -1) (#\j 0 1)))

;;(which is the same as 
;;  '((#\h . (-1 0)) (#\l . (1 0)) (#\k . (0 -1)) (#\j . (0 1)))) )

(defun play-maze (number)
  (format t "Keys are standard VI keys:~%")
  (format t "l: right~%")
  (format t "k: up~%")
  (format t "j: down~%")
  (format t "h: left~%")
  (format t "q: quit~%")
  (do* ((maze-array (make-maze-array (car (elt *mazes* number))))
        (char nil (read-char))
        (direction nil (cdr (assoc char *stone-directions*))))
       ((eql char #\q) "quit")
    (if direction 
        (move-stone maze-array (car direction) (cadr direction)))
    (print-maze-array maze-array)
    (when (= (count-maze-targets maze-array) 0) (return "won"))))

The count-maze-targets is necessary, because otherwise it won't work for 
multi-goal mazes.

The full source is available here:

http://www.frank-buss.de/lisp/tilt-mazes.lisp.txt

Now I want to enhance the solver for multi-goal mazes. Any ideas?

I think first I should build a list of paths to all targets and then 
checking, if some path includes all targets. I don't know if the 
constraints of the rules are such that it is guaranteed that there is one 
path which contains all targets, but I don't think so. But then I have to 
check the path from every target to every other target and in turn from 
this target to the rest targets and so on, which would require for the 
worst case n! checks for n targets, for 26 targets like in the last maze 
4e26 checks. This is too much :-)

-- 
Frank Bu�, ··@frank-buss.de
http://www.frank-buss.de, http://www.it4-systems.de
From: Szymon
Subject: Re: tilt mazes
Date: 
Message-ID: <877jpys5zq.fsf@eva.rplacd.net>
Frank Buss <··@frank-buss.de> writes:

> Szymon <············@o2.pl> wrote:
> 
> >> For my Lisp CPU I need a small game, so I've implemented it first, 
> >> because then I know what I need to implement for the CPU :-)
> 
> > ? wow... ?
> > post a link please...

Thank you. Nice idea. Btw:

"...

+ - < > <= >= /= = * set quote setq defun progn if cons car cdr nil

..."

add 't' to this list...

You do not need 'setq' if you have 'set' and 'quote'.

I wish for 'apply', 'progv', 'tagbody/go', 'catch/throw', '(f)makunbound'.

> [.......]

> > ;; 7 lines
> > 
> > (defun print-maze-array (maze-array)
> >   (destructuring-bind (width height) (array-dimensions maze-array)
> >     (format t "~%~{~{~[o~;T~; ~;#~]~}~%~}"
> >          (loop for y below height collect
> >             (loop for x below width collect
> >                (case (aref maze-array x y)
> >                  (stone 0) (target 1) (empty 2) (t 3)))))))
> 
> This looks like Perl to me, not like a readable Lisp program :-)

;-)

Btw, this is terribly inefficient (copy entire array into tree).

> 
> > ;; 12 lines.
> > 
> > (defun play-maze (number)
> >   (format t "Keys are standard VI keys:~:{~%~(~A: ~A~)~}"
> >        '((l right) (k up) (j down) (h left) (q quit)))
> >   (let ((maze-array (make-maze-array (elt *mazes* number)))
> >      (old nil))
> >     (do ((char nil (read-char)))
> >      ((eql char #\q) "quit")
> >       (setf old
> >          (apply #'move-stone maze-array
> >              (case char (#\h '(-1 0)) (#\l '(1 0)) (#\k '(0 -1)) (#\j
> >              '(0 1))))) 
> >       (print-maze-array maze-array)
> >       (when (eql old 'target) (return "won")))))
> 
> This doesn't work, because the move stone expected two variables, not a 
> list

with APPLY i can write:

(apply #'foo-function arg-1 arg-2 ..... list-of-args)

for example

(apply #'move-stone maze-array   '(-1 0))

                     <arg-1>   <list-of-args>             

> and if an unknown key is pressed, or at startup, NIL is returned by 
> the case, which is not recognized by the move-stone.

Ok. I can use CATCH/THROW. I rewrite this function from scratch.

;; this is working code, enjoy.
;; but it is not very elegant :P

(defun play-maze (num &aux (maze-array (make-maze-array (elt *mazes* num))))
  (format t "Keys are standard VI keys:~:{~%~(~A: ~A~)~}~%"
	  '((l right) (k up) (j down) (h left) (q quit)))
  (loop (print-maze-array maze-array)
	(catch 'X
	  (when (eql (apply #'move-stone maze-array
			    (case (read-char)
			      (#\q (return-from play-maze "quit"))
			      (#\h '(-1 0))
			      (#\l '(1 0))
			      (#\k '(0 -1))
			      (#\j '(0 1))
			      (t (throw 'X nil))))
		     'target)
	    (print-maze-array maze-array)
	    (return-from play-maze "won")))))

> The program needs the directions for the solving algorithm, so I've 
> defined it as a constant alist, so the play-maze looks like this. I can't 
> see any improvement by obscuring the manual with complex format strings, 
> so it is my original version, but I've embedded some lets in a do* form, 
> I think know it is more readable:
> 
> (defconstant *stone-directions*
>   '((#\h -1 0) (#\l 1 0) (#\k 0 -1) (#\j 0 1)))
> 
> ;;(which is the same as 
> ;;  '((#\h . (-1 0)) (#\l . (1 0)) (#\k . (0 -1)) (#\j . (0 1)))) )
> 
> (defun play-maze (number)
>   (format t "Keys are standard VI keys:~%")
>   (format t "l: right~%")
>   (format t "k: up~%")
>   (format t "j: down~%")
>   (format t "h: left~%")
>   (format t "q: quit~%")
>   (do* ((maze-array (make-maze-array (car (elt *mazes* number))))
>         (char nil (read-char))
>         (direction nil (cdr (assoc char *stone-directions*))))
>        ((eql char #\q) "quit")
>     (if direction 
>         (move-stone maze-array (car direction) (cadr direction)))
>     (print-maze-array maze-array)
>     (when (= (count-maze-targets maze-array) 0) (return "won"))))

I like this (but I'm newbie too, ask someone else).

> The count-maze-targets is necessary, because otherwise it won't work for 
> multi-goal mazes.
> 
> The full source is available here:
> 
> http://www.frank-buss.de/lisp/tilt-mazes.lisp.txt
> 
> Now I want to enhance the solver for multi-goal mazes. Any ideas?

I must go back to work, sorry for now. Wish you luck.

> [.......]

Regards, Szymon.
From: Szymon
Subject: Re: tilt mazes
Date: 
Message-ID: <873c0ms4xu.fsf@eva.rplacd.net>
Szymon <············@o2.pl> writes:

> Thank you. Nice idea. Btw:
> 
> "...
> 
> + - < > <= >= /= = * set quote setq defun progn if cons car cdr nil
> 
> ..."

EQ !!!

Regards, Szymon.
From: Rainer Joswig
Subject: Re: tilt mazes
Date: 
Message-ID: <joswig-203278.23091110102004@news-50.dca.giganews.com>
In article <············@newsreader2.netcologne.de>,
 Frank Buss <··@frank-buss.de> wrote:

> Szymon <············@o2.pl> wrote:
> 
> >> For my Lisp CPU I need a small game, so I've implemented it first, 
> >> because then I know what I need to implement for the CPU :-)
> 
> > ? wow... ?
> > post a link please...
> 
> http://www.frank-buss.de/lispcpu/index.html
> 
> > (defun print-maze-array (maze-array)
> >   (terpri)
> >   (destructuring-bind (width height) (array-dimensions maze-array)
> >     (loop for y below height do
> >           (loop for x below width do
> >           (format t "~[o~;T~; ~;#~]"
> >                (case (aref maze-array x y)
> >                  (stone 0) (target 1) (empty 2) (t 3))))
> >           (terpri))))
> 
> yes, that's shorter, but not more readable. "case" is a good idea, but 
> the format looks too complicated, because the (human) reader has to 
> switch back and forth between the format string and the case. I've 
> changed it like this:
> 
> (defun print-maze-array (maze-array)
>   (terpri)
>   (destructuring-bind (width height) (array-dimensions maze-array)
>     (loop for y below height do
>           (loop for x below width do
>                 (princ (case (aref maze-array x y)
>                          (stone #\o)
>                          (target #\T)
>                          (empty #\Space)
>                          (t #\#))))
>           (terpri))))

Reading Peter Norvig's book PAIP might be of some use
when implementing something like this. Chapter 18
has a discussion of implementing the board
game of Othello. Peter Norvig describes representation
choices, search, user interface, ...

Highly recommended.

PAIP:  http://www.norvig.com/paip.html

Source:
 http://www.norvig.com/paip/README.html
 http://www.norvig.com/paip/auxfns.lisp
 http://www.norvig.com/paip/othello.lisp
 http://www.norvig.com/paip/othello2.lisp
 http://www.norvig.com/paip/edge-tab.lisp

Rainer Joswig
From: Gareth McCaughan
Subject: Re: tilt mazes
Date: 
Message-ID: <87r7o4nsbz.fsf@g.mccaughan.ntlworld.com>
Frank Buss wrote:

> yes, that's shorter, but not more readable. "case" is a good idea, but 
> the format looks too complicated, because the (human) reader has to 
> switch back and forth between the format string and the case. I've 
> changed it like this:
> 
> (defun print-maze-array (maze-array)
>   (terpri)
>   (destructuring-bind (width height) (array-dimensions maze-array)
>     (loop for y below height do
>           (loop for x below width do
>                 (princ (case (aref maze-array x y)
>                          (stone #\o)
>                          (target #\T)
>                          (empty #\Space)
>                          (t #\#))))
>           (terpri))))

(defvar *maze-chars* '((stone . #\o) (target . #\T) (empty . #\Space)))

(defmacro array-print-loop ((array-expr)
                            (&key before-row after-row)
                            &body body)
  (let ((array-sym (gensym)))
    `(let ((,array-sym ,array-expr))
       (destructuring-bind (width height) (array-dimensions ,array-sym)
         (loop for y below height do
           ,before-row
           (loop for x below width do ,@body)
           ,after-row)))))
           
(defun print-maze-array (maze-array)
  (terpri)
  (array-loop (maze-array)
              (:after-row (terpri))
    (princ (or (cdr (assoc (aref maze-array x y) *maze-chars*))
                           #\#))))

> Now I want to enhance the solver for multi-goal mazes. Any ideas?
> 
> I think first I should build a list of paths to all targets and then 
> checking, if some path includes all targets. I don't know if the 
> constraints of the rules are such that it is guaranteed that there is one 
> path which contains all targets, but I don't think so. But then I have to 
> check the path from every target to every other target and in turn from 
> this target to the rest targets and so on, which would require for the 
> worst case n! checks for n targets, for 26 targets like in the last maze 
> 4e26 checks. This is too much :-)

Compute shortest distances target-to-target (and of course initial-position
to each target). Now you have a smallish graph on which you need to solve
the travelling salesman problem.

  - This is a known Hard Problem. Therefore, either you can't
    provably solve it quickly or else you should publish your
    proof that P=NP and get famous.

  - There are some good heuristics known for solving large TSP
    instances, and some decent algorithms for finding optimal
    solutions to small ones. N=26 counts as small.

See
    http://www2.toki.or.id/book/AlgDesignManual/BOOK/BOOK4/NODE175.HTM
or google for
    "traveling salesman problem" "branch and bound" exact
for more information.

-- 
Gareth McCaughan
.sig under construc