Nostalgia number game done the CHICKEN way

Today I would like to share a little coffee break game I have written with CHICKEN Scheme. I call it "The Number Game", Alaric calls it "a sliding block puzzle". You see a grid of numbered tiles and a hole. You can move one tile at a time and the game's goal is to rearrange the tiles in ascending order.

We will start out with with a basic text based implementation and will end up with a nice graphical version where we navigate the tiles with our mouse.

First let's settle on some design decisions. We will have a square as our game board, let's represent this as a continuous list of elements and worry about the presentation later. The hole in our set shall be represented by the symbol * (star).

To hold our game state consisting of the board, the length of our cube's sides and the position of the hole (here called the cursor), we define a record.

A new board is initialized with a random distribution of numbers and the cursor put at the end of the board.

(use srfi-1)

(define-record game board size cursor-pos)

(define (new-board size)
  (let* ((b (make-list (* size size)))
         (l (length b))
         (numbers (iota (sub1 l) 1)))
    (set! (list-ref b (sub1 l)) '*)
    (let loop ((i 0)
               (numbers numbers))
      (let ((n (random (length numbers))))
        (cond ((null? numbers) b)
              (else
               (set! (list-ref b i) (list-ref numbers n))
               (loop (add1 i) (delete (list-ref numbers n) numbers))))))))

(define (new-game size)
  (make-game (new-board size)
                   size
                   (sub1 (* size size))))

To neatly print this board we need a way to separate the columns. SRFI-1's split-at procedure helps us with this. As this procedure returns multiple values, we need to catch those specially with let-values.

(define (board->cols b s)
  (let helper ((l b)
               (r '()))
    (cond ((null? l) (reverse r))
          (else (let-values (((c tl)
                               (split-at l s)))
                            (helper tl (cons c r)))))))

(define (print-board s)
  (for-each
   (lambda (r) (print r))
   (board->cols (game-board s)
                (game-size s))))

As you can see, once we are done with that, printing a list of lists is a piece of cake! Let's try this in our repl:

#;1> (define g (new-game 3))
#;2> (print-board (new-game 3))
(3 5 2)
(1 6 4)
(7 8 *)

Excellent! To know when we have won we need a procedure that tells us that by looking at the game state. Since the iota procedure usually starts building the list with a 0, we need to tell it explicitly what we need.

(define (game-over? state)
  (equal? (reverse (iota (sub1 (* (game-size state)
                                  (game-size state))) 1))
          (cdr (reverse (game-board state)))))

Now once this is done, let's check whether we have won our game above:

#;3> (game-over? g)
#f

Now let's move this cursor around. As we will need this a lot, let's define a procedure that moves the cursor and returns a new game state:

(define (move-cursor state u)
  (let ((state state)
        (n (list-ref
             (game-board state)
             u)))
    (set! (list-ref (game-board state)
                    (game-cursor-pos state))
                 n)
    (set! (list-ref (game-board state)
                    u)
                 '*)
    (game-cursor-pos-set! state u)
    state))

The argument u will tell us the new position to set it to. Where does u come from? This all depends on the direction we want to move the cursor and the constraints given by the board size.

To ease things a bit, let's write a macro, that defines a movement procedure for us. This can be done without of course, let's do it anyway.

(define-syntax define-movement
  (ir-macro-transformer
   (lambda (x i c)
     (let ((name (second x))
           (update (third x))
           (pred (fourth x)))
       `(define (,name ,(i 'state))
          (if ,pred
              (move-cursor ,(i 'state) ,update)
              ,(i 'state)))))))

(define-movement up
  (- (game-cursor-pos state)
     (game-size state))
  (<= 0 (- (game-cursor-pos state)
           (game-size state))))

(define-movement down
  (+ (game-cursor-pos state)
     (game-size state))
  (< (+ (game-cursor-pos state)
        (game-size state))
     (* (game-size state)
        (game-size state))))

(define-movement left
  (sub1 (game-cursor-pos state))
  (not (= 0 (modulo
             (game-cursor-pos state)
             (game-size state)))))

(define-movement right
  (add1 (game-cursor-pos state))
  (not (= 0 (modulo
             (add1 (game-cursor-pos state))
             (game-size state)))))

See? And it only hurt a bit. Now that we now when the game is over and that we can move the hole around, the only thing that's left for the game to be playable is a simple loop that takes our input, updates the game state and prints the new board.

(define (start-game s)
  (call-with-current-continuation
   (lambda (exit)
     (let game-loop ((b (new-game s)))
       (print-board b)
       (when (game-over? b)
         (print "Congratulations, you won the game!")
             (exit 'done))
       (printf "> ")
       (game-loop (case (read-char)
                    ((#\u #\U) (up b))
                    ((#\d #\D) (down b))
                    ((#\l #\L) (left b))
                    ((#\r #\R) (right b))
                    ((#\q #\Q) (exit 'aborted))
                    (else (print "please use (u)p (d)own (l)eft (r)ight or (q)uit")
                          b)))))))

Let's play!

#;8> (start-game 3)
(4 5 2)
(1 7 8)
(6 3 *)
> u
(4 5 2)
(1 7 *)
(6 3 8)
> l
(4 5 2)
(1 * 7)
(6 3 8)
> l
(4 5 2)
(* 1 7)
(6 3 8)
> u
(* 5 2)
(4 1 7)
(6 3 8)
> r
(5 * 2)
(4 1 7)
(6 3 8)
> d
(5 1 2)
(4 * 7)
(6 3 8)
> q

With this in place we can start writing our graphical version of it. For this game I will use a 400x400 pixel window with a dark gray background.

(use doodle matchable)

(new-doodle height: 400 width: 400 background: '( 0.5 0.5 0.5 1))

(define offsetx 20)
(define offsety 20)

(define area-length 360)

Within this area we have a 20x20 pixels border, thus leaving us with a square of 360x360 pixels as a gaming area. Before we start drawing our tiles we need to define a mapping procedure which will give us screen coordinates for a given tile.

(define (tile->coords game tile)
  (let* ((tile-size (/ area-length (game-size game)))
         (idx (list-index (cut equal? tile <>) (game-board game)))
         (row (quotient idx (game-size game)))
         (r (remainder idx (game-size game)))
         (col (if (null? r) 3 r)))
    (values (+ offsetx (* col tile-size))
            (+ offsety (* row tile-size)))))

Whith this, we can draw the board. If we encounter our cursor, we will draw a light grey square, else we will draw a white rectangle with the number in the centre (well almost in the centre).

(define (draw-board s)
  (let ((tile-size  (/ area-length (game-size s))))
    (for-each
     (lambda (tile)
       (let-values (((x y) (tile->coords s tile)))
         (cond ((eq? tile '*)
                (filled-rectangle x y tile-size tile-size '(0.7 0.7 0.7 1))
                (rectangle x y tile-size tile-size solid-black))
               (else
                (rectangle x y tile-size tile-size solid-black)
                (text (+ x
                         (/ tile-size 2))
                      (+ y
                         (/ tile-size 2))
                      (->string tile)
                      align: #:center)))))
     (game-board s))))

Now we are ready to write a simple gaming loop with doodle. We will store the current game state in the variable *b* and the current board size in *s*. When the world initializes we create a new world, then listen in on the input.

(define *b* #f)
(define *s* 4)

(world-inits
 (lambda ()
   (set! *b* (new-game *s*))))

(world-changes
 (lambda (events dt quit)
   (clear-screen)
   ;; draw the gaming area white
   (filled-rectangle offsetx offsety area-length area-length solid-white)

   ;; Handle user input
   (for-each
    (lambda (e)
      (set! *b*
            (match e
                   ;; handle movement with cursor keys
                   (('key 'pressed 'up) (up *b*))
                   (('key 'pressed 'down) (down *b*))
                   (('key 'pressed 'left) (left *b*))
                   (('key 'pressed 'right) (right *b*))
                   ;; Exit by pressing q
                   (('key 'pressed #\q) (quit 'aborted))
                   ;; Restart a game with r
                   (('key 'pressed #\r) (set! *b* (new-game *s*)) *b*)
                   ;; Increase and decrease the number of tiles
                   (('key 'pressed #\+) (set! *s* (add1 *s*)) (set! *b* (new-game *s*)) *b*)
                   (('key 'pressed #\-) (when (< 3 *s*) (set! *s* (sub1 *s*)) (set! *b* (new-game *s*))) *b*)
                   ;; Move the blocks by clicking on them
                   (('mouse 'pressed x y _) (handle-clicks *b* x y))
                   (else *b*))))
    events)


   ;; draw our board
   (draw-board *b*)
   ;; update the window
   (show!)
   (when (game-over? *b*)
         (parameterize
          ((font-color '(1 0 0 1))
           (font-size 42))
          (text 100 200  "YOU WIN!" '(1 0 0 1) align: #:center))
         (show!)
         (thread-sleep! 3)
         (set! *b* (new-game *s*)))))

(run-event-loop run-in-background: #t)

You may notice one missing part. Above we also listen to mouse events. Let's fill in this blank. Again we start out by defining a mapping procedure that will give us a tile index when we have clicked on a tile. Then we compute the tiles that can be moved, compare the clicked tile to that list and update our cursor accordingly.

(define (coords->tile s x y)
  (and-let* ((_ (>= x offsetx))
             (_ (>= y offsety))
             (_ (<= y (+ offsety area-length)))
             (_ (<= x (+ offsetx area-length)))
             (x (- x offsetx))
             (y (- y offsety))
             (tile-size  (/ area-length (game-size s)))
             (col (quotient x tile-size))
             (row (quotient y tile-size)))
            (+ col (* row (game-size s)))))

(define (find-movable-tiles game)
  (let* ((star (game-cursor-pos game))
         (size (game-size game))
         (board-size (length (game-board game)))
         (potentials (list (- star size)
                           (+ star 1)
                           (- star 1)
                           (+ star size)))
         (inside? (lambda (p)
                    (and (<= 0 p)
                         (< p board-size)))))
    (filter inside? potentials)))

(define (handle-clicks b x y)
  (let ((idx (coords->tile b x y))
        (star (game-cursor-pos b)))
    (when (member idx (find-movable-tiles *b*))
          (set! b (move-cursor b idx)))
    b))

That's it! We have now everything we need to play our number game. Once assembled yours will look a bit like this:

I invite you to play (with) our silly little game a bit. You can

• Make the pieces prettier
• Add a status bar and count moves
• Implement an AI for solving the puzzle for you

I hope you have enjoyed the little coffee break game of mine. I appreciate any feedback on it and I would love to hear of your attempts with this game and doodle.

Take care and have fun writing games in CHICKEN scheme!