Monday, October 6, 2008

The game

Yet another newbie LISP example.

When I was a little boy, my father got me a VIC-20, maybe in the hopes of raising a famous computer scientist. But I never programmed a lot, I just ended up playing a lot of games. So much for budding greatness.

But one time my father brought me along to a computer fair. One stand were showing off their machine by running a simple game on it. The game was simple enough that I figured I could make it myself. So when I got home, I sat down and produced my only piece of software on the VIC-20. Ever since I've had a soft spot for that simple puzzle.

So what could be a more fitting subject for a beginners article than showing a lisp-implementation of that game.

The object of the game is to fill all the edge squares of a 3x3 grid, while the center square is unfilled. There are nine moves, each toggles a number of squares on and off. Instead of trying to explain which moves does what, I'll just lay out the initialization of the moves array and let you figure it out yourself.

(defpackage :flipper
  (:use :common-lisp))

(in-package :flipper)

(defparameter *solution*
  '(1 1 1
    1 0 1
    1 1 1))

(defparameter *moves*
  '((1 1 0    ; 1  The array actually starts on 0, but these numbers 
     1 1 0    ;    make it easier to visualize
     0 0 0)

    (1 1 1    ; 2
     0 0 0
     0 0 0)
    (0 1 1    ; 3
     0 1 1
     0 0 0)
    (1 0 0    ; 4
     1 0 0
     1 0 0)
    (1 0 1    ; 5
     0 1 0
     1 0 1)
    (0 0 1    ; 6
     0 0 1
     0 0 1)
    (0 0 0    ; 7
     1 1 0
     1 1 0)
    (0 0 0    ; 8
     0 0 0
     1 1 1)
    (0 0 0    ; 9
     0 1 1
     0 1 1)))
Now, we need a function to generate a starting position for our puzzle. By looking at the moves available, we can easily see that any starting position is solvable, so let's just generate a random list.
(defun create-puzzle ()
  (loop for i repeat 9
        collect (random 2)))
And let's see if it works:
CL-USER 1 > (in-package :flipper)
FLIPPER 2 > (create-puzzle)
(0 1 1 0 0 1 1 0 0)
Looks good. Now we need a function that applies moves to a position:
(defun apply-move (n position)
    (loop for p in position
          for m in (nth n *moves*)
          collect (mod (+ p m) 2)))
Does it work? (Remember that the move list is 0-indexed.):
FLIPPER 3 > *solution*
(1 1 1 1 0 1 1 1 1)

FLIPPER 4 > (apply-move 1 *solution*)
(0 0 0 1 0 1 1 1 1)

FLIPPER 5 > (apply-move 0 *solution*)
(0 0 1 0 1 1 1 1 1)
Yup, still looks good.
Now, to actually play a game, all we need to do is to go in a loop asking for moves and applying them until the current position is equal to the solution:
(defun play-tty ()
  (do* ((startpos (create-puzzle))
        (move nil (- (read) 1))    ; Adjusting for the 0-indexed list
        (currentpos startpos (apply-move move currentpos))
        (moves 0 (incf moves)))
       ((equal currentpos *solution*) moves)
    (format t "~a~%" currentpos)))
And another test:
FLIPPER 6 > (play-tty)
(0 0 1 1 0 1 0 1 1)
(1 0 1 0 0 1 1 1 1)
(1 0 0 0 0 0 1 1 0)
(1 0 0 0 0 0 0 0 1)
(1 1 1 0 1 1 0 0 1)
Well, it worked, but it's hard to visualize the moves, so lets make it a bit more readable:
(defun print-grid (grid)
    (format t "~{~{ ~a~}~%~}~%" (loop for i on grid by 'cdddr
                                      collect (list (first i) (second i) (third i)))))

(defun play-tty ()
  (do* ((startpos (create-puzzle))
        (move nil (- (read) 1))
        (currentpos startpos (apply-move move currentpos))
        (moves 0 (incf moves)))
       ((equal currentpos *solution*) (progn
                                        (print-grid currentpos)
                                        (format nil "Congratulations, you finished in ~a moves." moves)))
    (print-grid currentpos)))
And that is all the code you need for a working game:
FLIPPER 14 > (play-tty)
 1 1 0
 0 1 1
 1 0 1

 1 0 1
 0 0 0
 1 0 1

 0 1 0
 0 0 0
 1 0 1

 1 1 0
 1 0 0
 0 0 1

 1 1 1
 1 0 1
 0 0 0

 1 1 1
 1 0 1
 1 1 1

"Congratulations, you finished in 5 moves."

Adding flash!

Now, it's a long time since people bothered to play text-games like this. So let's add a GUI, people love that.

I'm going to use Lispworks CAPI library in this example. If you want to follow along from here on, but don't have LispWorks installed on your machine, you can download a free "Personal Edition" from LispWorks. Even if you don't want to use CAPI you may want to read on, concepts like callbacks and layouts are common to most graphical libraries, I think.

First let's modify the package definition to gain access to the capi library:

(defpackage :flipper
  (:add-use-defaults t)
  (:use "CAPI"))
Our squares are just going to be simple output-panes, but we'll add a slot in the class to keep track of which tile it is:
(defclass game-tile (output-pane)
  ((tilenum :accessor tilenum :initarg :tilenum)))
Now we can make a interface, let's put a "New game", a "Reset" button and a counter in a row above a grid with the tiles. We do that by nesting a row-layout with the buttons and the counter inside a column-layout. We also need to specify callback functions for the buttons and tiles. This is functions that will be called when the player clicks in our interface, we do not call the functions directly.
(define-interface game-window ()
  ((game-position :accessor game-position :initform *solution*)
   (start-position :accessor start-position :initform *solution*)   
   (num-moves :accessor num-moves :initform 0))
   (buttons push-button-panel :items '("New puzzle" "Reset") :selection-callback 'button-callback )
   (counter display-pane :title "Moves:" :text "0" :title-position :left :accessor counter))
   (header row-layout '(buttons counter)
           :y-adjust :center)
   (tiles grid-layout
          (loop for i upto 8
                collect (make-instance 'game-tile
                                        :tilenum i
                                        :min-height 100
                                        :input-model '(((:button-1 :press) make-move))))
          :rows 3
          :columns 3
          :accessor tiles)
   (game column-layout
         '(header tiles)))
  (:default-initargs :title "Flipper"
   :layout 'game))
You can have a look at the interface by calling contain on an instance of the interface:
FLIPPER 17 > (contain (make-instance 'game-window))
#<GAME-WINDOW "Flipper" 20715124>
Hmm, the tiles are there, but we haven't drawn anything in them. Instead of doing any actual drawing we'll just change the background color according to the state of the tile. At the same time, I'll update the move-counter. We can use the layout-description accessor to get a list of the panes in the tiles grid:
(defun refresh-interface (interface)
  (loop for tile in (layout-description (tiles interface))
        for i upfrom 0
        do (setf (simple-pane-background tile) (if (= 1 (nth i (game-position interface)))
  (setf (display-pane-text (counter interface)) (format nil "~a" (num-moves interface))))
Let's try it out, if you didn't close the game-window you can just call the function from the REPL:
FLIPPER 18 > (refresh-interface *)
Now, if you have tried to click on any of the buttons or tiles, you would have gotten an error because we haven't made the callback funtions we specified when defining the interface. Let's start with the buttons, the callback functions for the buttons will be called with two arguments. The first argument is the text written on the button, and the second argument is the interface the button is located in. We will reuse the create-puzzle function we defined earlier:
(defun new-puzzle (interface)
  (setf (start-position interface) (create-puzzle)
        (game-position interface) (start-position interface)
        (num-moves interface) 0)
  (refresh-interface interface))

(defun button-callback (data interface)
   ((string= data "New puzzle") (new-puzzle interface))
   (t (progn
        (setf (game-position interface) (start-position interface)
              (num-moves interface) 0)
        (refresh-interface interface)))))
Well, the "New puzzle" button works, but we can't test the reset button since we're unable to make any moves. Let's add the callback function for the tiles. Callback funtions for output-panes are different from buttons. The first argument is the pane-object itself, the second and third argument is the coordinates of the mouse pointer when the pane was clicked. Useful when you want to draw something where the mouse pointer clicks, but we'll ignore the coordinates.:
(defun make-move (self x y)
  (declare (ignore x y))
  (let ((interface (element-interface self)))
    (setf (game-position interface)
          (apply-move (tilenum self)
                      (game-position interface)))
    (incf (num-moves interface))
    (refresh-interface interface)))
Now, all that is left to do is to detect if the solution has been found. We'll just add a test at the bottom of the make-move callback function, and when the solution is found we'll show a popup congratulating the player with a job well done and ask if the player wants to play another game.
(defun make-move (self x y)
  (declare (ignore x y))
  (let ((interface (element-interface self)))
    (setf (game-position interface)
          (apply-move (tilenum self)
                      (game-position interface)))
    (incf (num-moves interface))
    (refresh-interface interface)
    (when (equal *solution* (game-position interface))
      (if (capi:popup-confirmer nil 
                                (format nil "Congratulations, you finished the game in ~a moves. Do you want to play again?"
                                        (num-moves interface))
                                :callback-type :none
                                :ok-button "Sure, that was really fun"
                                :no-button "No way, I'd rather watch paint dry"
                                :cancel-button nil
                                :value-function #'(lambda (dummy) t))
        (new-puzzle interface)
        (destroy interface)))))
Finally, let's throw in a convenience function to start the whole thing:
(defun play-gui ()
  (refresh-interface (display (make-instance 'game-window))))
Yes, folks, that's it. All you need to captivate a kid walking past your stand at the local computer fair:

No comments: