15-puzzle: A complete example

We have by now covered quite a lot of ground, having seen how to both create and build user interfaces with Haggis. To bring all these different parts together, let's try implementing a `real' program using Haggis. The example is the 15-puzzle, similar to the demo example given in the Tcl/Tk distribution, here's a snapshot of the Haggis version:

First of all, let's figure out how to do the layout of the puzzle pieces, for which we will use a table abstraction to arrange them all:

fixedTable :: Size    {- width and height of array -}
           -> Size    {- gaps between the rows and columns -}
           -> [(Coord, DisplayHandle)] {- initial set of components. -}
           -> Component (Table, DisplayHandle)

Given the dimensions of the table and the space between the components, fixedTable creates a table layout with table cells of fixed size, width equal to the maximum of all the components in the table (and similarly for the cell height). The fixedTable layout combinator returns a separate handle of type Table which can later be used to dynamically change or query the contents of the table.

To represent the pieces, we could have developed our own abstraction using a glyph and the catchDeviceEv, See section Adding interaction. Instead let's take the easy way out and make use of the standard Button abstraction in Haggis:

button :: Picture -> a -> Component (Button a, DisplayHandle)

the button is parameterised over the Picture label to use and the value to report on the Button handle each time the user presses the button. Having got the layout combinator and the components to represent the pieces of the puzzle, we can now build the board:

board :: Size -> Component ([Button Int], Table, DisplayHandle)
board (w,h) env =
  {- Create the pieces of the puzzle.

     Each button displays the number they will
     output when clicked.
  -}
 mapIO (\ x -> button (text (show x)) x dc) [1..(w*h-1)] >>= \ ls ->
 let
  (btns,dhs) = unzip ls
  posns      = [(x,y) | y<-[1..h],x<-[1..w]]

  tab_elts   = zip posns dhs
 in
  {- Lay all the components out in a fixed-size table/spreadsheet -}
 fixedTable (w,h) (1,1) tab_elts dc	         >>= \ (tab,dh) ->
 return (btns, tab, dh)

A button is created for each piece, each of them outputting the same value via their Button handle as they display, i.e., the operation

getButtonClick :: Button a -> IO a

on the button labelled '5', will return the value 5 each time the user clicks on the button.

The buttons are then put into the table created with fixedTable, starting in the lower lefthand corner of the table and filling it up, leaving initially the top right empty.

To glue the board to the circuitry that controls the valid movement of pieces together, nnPuzzle sets up a loop that catches all button clicks:

nnPuzzle :: Size -> IO ()
nnPuzzle (w,h) =
 mkDC ["*name: Puzzle"]           >>= \ dc ->
  board (w,h)                     >>= \ (pieces, tab, dh) ->
  newArray (1,(w*h-1)) (error "") `thenPrimIO` \barr ->
   {- 
     Fill in the array mapping button number to table coord.
   -}
  sequence
   (zipWith (\ pos v -> writeArray barr pos v `seqPrimIO` return ())
            [1..(w*h-1)]
	    posns)			         `seqPrimIO`
   {- Join all the pieces together. -}
  combineButtons pieces			         >>= \ btn ->
 realiseDH dc dh				 >>
 let
   {- The controlling loop for the puzzle. Each time
      a button is pressed, we check whether it is
      next to the hole. If it is, we swap the entry
      the button resides at with the hole and continue.

      Illegal moves are just ignored.
   -}
  loop hole =
   getButtonClick btn		     >>=          \ val ->
   readArray barr val		     `thenPrimIO` \ pos ->
   if nextTo pos hole then
      swapTableElts tab pos hole >>
      writeArray barr val hole   `seqPrimIO`
      loop pos
   else
      loop hole
 in
 loop (w,h) >>
 return ()

{- Two coords. are next-to each other if the Manhattan dist.
   is 1 -}
nextTo :: (Int,Int) -> (Int,Int) -> Bool
nextTo (ax,ay) (bx,by) = (abs (ax-bx) + abs (ay-by)) == 1

Apart from creating board, nnPuzzle sets up an array for keeping track of the position of each piece on the board. The reason for this is that when a button is pressed we need to check whether it is next to the hole in the table. To combine all the Button handles together, nnPuzzle uses

combineButtons :: [Button a] -> IO (Button a)

that joins a collection of buttons into one, such that clicks on any of the buttons is also reported on the `combined' button. The controlling loop is then quite self explanatory, catching each button click and checking if the button is next to the whole. If it is, we swap hole and the the table cell for the button and continue.

At the toplevel, main just reads the dimensions of the puzzle board before calling on nnPuzzle to take care of playing the game:

main =
 getArgs >>= \ (a:b:_) ->
 nnPuzzle (read a,read b)