17 July 2013

The Polar Game in Haskell, Day 7: Towards a GUI, Continued

So, trying wxHaskell. First, I want to try removing everything that might be left over from yesterday's experiments:

Pauls-Mac-Pro:~ paul$ brew list
gettext  libffi  pkg-config xz
Pauls-Mac-Pro:~ paul$ brew uninstall gettext libffi pkg-config xz
Uninstalling /usr/local/Cellar/gettext/0.18.3...
Uninstalling /usr/local/Cellar/libffi/3.0.13...
Uninstalling /usr/local/Cellar/pkg-config/0.28...
Uninstalling /usr/local/Cellar/xz/5.0.5...
Pauls-Mac-Pro:~ paul$ port installed
The following ports are currently installed:
  libiconv @1.14_0 (active)
  pkgconfig @0.28_0 (active)
Pauls-Mac-Pro:~ paul$ sudo port uninstall pkgconfig libiconv
--->  Deactivating pkgconfig @0.28_0
--->  Cleaning pkgconfig
--->  Uninstalling pkgconfig @0.28_0
--->  Cleaning pkgconfig
--->  Deactivating libiconv @1.14_0
--->  Cleaning libiconv
--->  Uninstalling libiconv @1.14_0
--->  Cleaning libiconv

Then install wx: I'm attempting the directions here.

brew install wxmac --use-llvm --devel
brew install wxmac --devel
Warning: It appears you have MacPorts or Fink installed.
Software installed with other package managers causes known problems
for Homebrew. If a formula fails to build, uninstall MacPorts/Fink
and try again.

(There shouldn't be any libraries or binaries in the various paths to interfere, so I'll ignore this). And it seemed to succeed. So, next step from the instructions above: Check your path to make sure you are using your wxWidgets and not the default Mac one. The command which wx-config should not return the file path /usr/bin/wx-config (On my system it returns /usr/local/bin/wx-config). Next, cabal install wx cabal-macosx. That chugs away for a while and I see an unnervingly large number of warnings, but it builds. And then, I saved this file as hello-ex.hs and ghc --make HelloWorld.hs and macosx-app hello-wx and ./hello-wx.app/Contents/MacOS/hello-wx and the result runs and I get a window, although it pops up off the bottom of my primary display, and the application's main menu does not seem to render its menu items quite right (they say "Hide H" and "Quit H" instead of the application name). But still -- promising!

So -- some code. To facilitate working with a GUI module in a separate .hs file I am now calling the core logic ArcticSlideCore.hs. and that file begins with module ArcticSlideCore where. I don't have very much working yet, but here's what is in my ArcticSlideGui.hs file so far. First I define my module and do my imports:

module Main where

import Graphics.UI.WX
import ArcticSlideCore

Then I define some bitmaps. For purposes of experimentation I made .png files out of the original Polar game's CICN resources. I want to redraw them -- first, to avoid blatant copyright infringement and second, to make them bigger. But temporarily:

bomb = bitmap "bomb.png"
heart = bitmap "heart.png"
house = bitmap "house.png"
ice = bitmap "ice_block.png"
tree = bitmap "tree.png"

While they are game tiles as such, there are icons for the penguin facing in the four cardinal directions and icons for a breaking ice block and exploding bomb that were used in original animations:

penguin_e = bitmap "penguin_east.png"
penguin_s = bitmap "penguin_south.png"
penguin_w = bitmap "penguin_west.png"
penguin_n = bitmap "penguin_north.png"

ice_break = bitmap "ice_block_breaking.png"
bomb_explode = bitmap "bomb_exploding.png"

I noticed that wxHaskell's Point type operates in reverse. I'm accustomed to C arrays where the higher-rank indices come first (so y, x or row index, column index for tile positions), but points are backwards. My icons are 24x24 pixels, so I rearrange and scale them like so:

posToPoint :: Pos -> Point
posToPoint pos = ( Point ( posX pos * 24 ) ( posY pos * 24 ) )

Now, some convenience function for drawing bitmaps based on Tile type or based on a wxHaskell bitmap. These are two more cases where I was not sure of the type signature, so I wrote the functions without them:

drawBmp dc bmp pos = drawBitmap dc bmp point True []
    where point = posToPoint pos

drawTile dc tile pos = drawBmp dc bmp pos
    where bmp = case tile of Bomb  -> bomb
                             Heart -> heart
                             House -> house
                             Ice   -> ice
                             Tree  -> tree

GHCI says:

Prelude Main> :t drawBmp
  :: Graphics.UI.WXCore.WxcClassTypes.DC a
     -> Graphics.UI.WXCore.WxcClassTypes.Bitmap ()
     -> ArcticSlideCore.Pos
     -> IO ()

That boils down to drawBmp :: DC a -> Bitmap () -> Pos -> IO (), and the signature for DrawTile similarly boils down to drawTile :: DC a -> Tile -> Pos -> IO (). Thanks, GHCI!

Next, I need a view method. This is just a placeholder test to verify that I can draw all my icons in the bounds where I expect them:

draw dc view
    = do
        drawTile dc Bomb        ( Pos 0 0  )
        drawTile dc Heart       ( Pos 0 1  )
        drawTile dc House       ( Pos 0 2  )
        drawTile dc Ice         ( Pos 0 3  )
        drawTile dc Tree        ( Pos 0 4  )
        drawBmp dc penguin_e    ( Pos 1 0  )
        drawBmp dc penguin_s    ( Pos 1 1  )
        drawBmp dc penguin_w    ( Pos 1 2  )
        drawBmp dc penguin_n    ( Pos 1 3  )
        drawBmp dc ice_break    ( Pos 0 23 )
        drawBmp dc bomb_explode ( Pos 3 23 )

Now, my guy function is where things get interesting and wxHaskell shows off a little. I read this paper that talks about some of the layout options and other tricks of the wxHaskell implementation, and discovered that this maps really nicely to defining my window in terms of a grid of icons. space 24 24 returns a layout item of the appropriate size, and grid returns a layout item when given spacing values (I want the icons touching, so I use 0 0) and a list of lists for rows and columns. To generate the proper structure of 4 rows of 24 columns I just take what I need from infinite lists: take 4 $ repeat $ take 24 $ repeat $ space 24 24 Oh, that's nifty!

gui :: IO ()
    = do f <- frame [text := "Arctic Slide"]
         t <- timer f [ interval := 250
         set f [ layout   := grid 0 0 $ take 4 $ repeat $
                             take 24 $ repeat $ space 24 24   
                ,bgcolor  := white
                ,on paint := draw
         return ()

And finally, main:

main :: IO ()
  = start gui

To build this for use as a MacOS X GUI app I just do ghc --make ./arcticSlideGui.hs, and if it compiles properly then macosx-app arcticSlideGui; ./arcticSlideGui.app/Contents/MacOS/arcticSlideGui and I have a little GUI window:

Sweet! Now I've got some more thinking to do. There's some plumbing that needs to get hooked up between the core game logic and the GUI layer. The core game logic is mostly factored the way I want it to be -- it gets a world and a penguin move and returns an updated world -- but I need to do a little more than just map the tiles to a series of drawTile calls. I might want to support timed sequences of changes to the GUI representation of the board -- for example, smooth sliding of game pieces and smooth walking of the penguin. The draw method should draw the board pieces and the penguin all at once, with no redundancy if possible. Sound effects would be nice. Animation for crushing an ice block and blowing up a mountain would be nice. I've got some ideas along these lines based on event queues and a timer, and some other pieces of sample code I've been looking at.

Meanwhile, if any of you would like to take a crack at redrawing the graphics, please be my guest. It would be nice if the replacement icons would fit on an iPhone or iPod Touch. 48x84 is just a little bit too big -- 48 pixels by 24 icons is 1152 pixels, and the iPhone 4 and 5 screens are 640x960 and 640x1136. 40 pixels wide would fit perfectly on an iPhone 4. Note that the icons don't actually have to be square -- there is room to spare vertically. It might be nice, though, to leave room for a few extra rows, to support game boards that break out of the original 4-row height.

16 July 2013

The Polar Game in Haskell, Day 6/12: Towards a GUI, Continued

OK, so when I left off last time, I was running into a gruesome link error. I found this Stack Overflow thread and the first accepted answer fixed the problem. However, it seems that the answer may be to avoid MacPorts versions of the libraries I need. So I'm going to attempt to clean that all out and use Homebrew. So, first:

sudo port -fp uninstall --follow-dependents installed

And then I'm manually cleaning out some of the stuff mentioned in this article.

Next, I'm removing this from my .profile (hey, I'm so pleased that it is clearly marked!

# MacPorts Installer addition on 2013-07-16_at_11:57:13:
adding an appropriate PATH variable for use with MacPorts.
export PATH=/opt/local/bin:/opt/local/sbin:$PATH
# Finished adapting your PATH environment variable for 
use with MacPorts.

Now to install Homebrew:

ruby -e "$(curl -fsSL https://raw.github.com/mxcl/homebrew/go)"

I ran brew doctor and wow, I have a mountain of warnings. I got rid of most of them except for several about "unbrewed" things -- static libraries, .la files, and dylibs in /usr/local/lib. I get a warning about MacGPG2 but that seems to be fixed by upgrading to the current version. So now I'm trying cabal install --reinstall gtk, and I get:

Configuring gtk-0.12.4...
setup: The pkg-config package gthread-2.0 is required but it could not be

And so, attempting to follow the directions here:

brew install glib cairo gtk gettext fontconfig

...and that actually crashes. I get "confest cannot be opened because of a problem." In the console log:

Process:         conftest [12844]
Path:            /private/tmp/*/conftest
Identifier:      conftest
Version:         0
Code Type:       X86-64 (Native)
Parent Process:  sh [12843]
User ID:         501

Date/Time:       2013-07-16 15:42:18.117 -0400
OS Version:      Mac OS X 10.8.4 (12E55)
Report Version:  10

Crashed Thread:  0

Exception Codes: 0x0000000000000002, 0x0000000000000000

Application Specific Information:
dyld: launch, loading dependent libraries

Dyld Error Message:
  Library not loaded: /usr/local/lib/libintl.8.dylib
  Referenced from: /private/tmp/*/conftest
  Reason: no suitable image found.  Did find:
            no matching architecture in universal wrapper
            no matching architecture in universal wrapper

And I get an error about "GLib requires a 64 bit type." I also had to do some manual clean-out of some files that had the wrong permissions and were interfering with installing pkgconfig. I found a number of people reporting this problem, but none of the solutions they outlined seemed to work for me. So... what else can I try?

There's this: http://www.haskell.org/haskellwiki/Gtk2Hs/Mac#GTK.2B_OS_X_Framework

OK! Deep sigh... let's try this!

Pauls-Mac-Pro:Downloads paul$ sh ./gtk-osx-build-setup.sh 
Checking out jhbuild (07b5a7d) from git...
Cloning into 'jhbuild'...
remote: Counting objects: 37027, done.
remote: Compressing objects: 100% (14715/14715), done.
remote: Total 37027 (delta 28610), reused 28612 (delta 22178)
Receiving objects: 100% (37027/37027), 7.27 MiB | 2.27 MiB/s, done.
Resolving deltas: 100% (28610/28610), done.
Switched to a new branch 'stable'
Patch is empty.  Was it split wrong?
If you would prefer to skip this patch, instead run "git am --skip".
To restore the original branch and stop patching run "git am --abort".
Installing jhbuild...
gnome-autogen.sh not available
yelp-tools not available
Configuring jhbuild without autotools
Now type `make' to compile jhbuild
Installing jhbuild configuration...
Installing gtk-osx moduleset files...
PATH does not contain /Users/paul/.local/bin, it is recommended that you add that.


Ummm... OK, wow, that installed source in my home directory build tools in a hidden directory (prefaced with a period) under my home directory. There are warning notes about how the build process conflicts with MacPorts and fink. There's also a note that says "Note: jhbuild requires Python 2.5 to unpack tar files" (of course it does... that's the simplest and most system-compatible way to unpack tar files, right?) Ugh. Anyway... in ~/Source/jhbuild I type ~/.local/bin/jhbuild bootstrap and it builds about a bazillion things including cmake. (Talk amongst yourselves, this is going to take a while... time for another snack...)

That seemed to work. And so: ~/.local/bin/jhbuild build meta-gtk-osx-bootstrap and ~/.local/bin/jhbuild build meta-gtk-osx-core. Somewhat to my shock, everything succeeded! I tried to build gimp, but that failed with "we require Pango with the optional support for Cairo compiled in," and I don't want to go too far down that rabbit hole, so I gave up on that. So let's see if I can make that work with GHC. The next step is package-config. Which requires glib. Ummm, wait a minute... oh, crap. That's still broken with homebrew. Ummm. What about package-config from MacPorts, which the instructions for GTK OSX warned me about? Sure, let's try it, what the hell... after all, I've wasted nearly a full day already... so, sudo port selfupdate, sudo port install pkg-config... that seemed to work. So then we download the Gtk2HS tarball... ummm, the link from the instructions is broken. Ummm... from SourceForge here... but that version is looking much older than the one described here. I'm getting a bad feeling about this. But anyway... 0.10.1 it is! Configure away!

checking for pkg-config... /opt/local/bin/pkg-config
checking pkg-config is at least version 0.9.0... yes
checking for GLIB... no
configure: error:

The development files for the glib-2.x library were not found.
Perhaps you need to install glib or glib-devel

Huh. Well. It's just about the end of my work day; I've got to go downstairs and help my wife get dinner ready. Ummm. So! I hope you've enjoyed this tutorial on how to use the GTK GUI library in Haskell! Please join me next time when I perform brain surgery on myself using a hacksaw, a folding mirror, and a bottle of Scotch!

The Polar Game in Haskell, Day 6: Towards a GUI

So, I have some time today to program and I want to see how far I can get in starting to develop a GUI for my game, incomplete as it is. Can I get a window displayed and reacting to mouse or keyboard events, and drive the game logic with it?

I came across the paper FranTk -- A Declarative GUI Language for Haskell (PDF file link) by Meurig Sage and it looked interesting, so I considered trying FranTk. However, that led to broken links. Moving on...

Let's see if I can get somewhere with FG. That needs gtk2hs. Hmmm... cabal update, cabal install gtk2hs-buildtools, cabal install gtk.

[1 of 2] Compiling Gtk2HsSetup
    ( Gtk2HsSetup.hs, dist/setup-wrapper/Gtk2HsSetup.o )
[2 of 2] Compiling Main
    ( SetupMain.hs, dist/setup-wrapper/Main.o )
Linking dist/setup-wrapper/setup ...
Configuring cairo-0.12.4...
setup: The program pkg-config version >=0.9.0 is required but it
could not be found.
Failed to install cairo-0.12.4

I tried downloading pkg-config-0.28 source from here and that got me as far as running ./configure --prefix=/usr/local/ and seeing:

configure: error: Either a previously installed
pkg-config or "glib-2.0 >= 2.16" could not be found.
Please set GLIB_CFLAGS and GLIB_LIBS to the correct
values or pass --with-internal-glib to configure to use
the bundled copy.

So I tried ./configure --prefix=/usr/local/ --with-internal-glib and that seemed to go OK; I was able to do make, make check -- one failure out of 25 tests in "check-path" -- and sudo make install. Back to cabal install gtk == nope.

Configuring cairo-0.12.4...
setup: The pkg-config package cairo-pdf is required but it
could not be found.
Failed to install cairo-0.12.4

Configuring glib-0.12.4...
setup: The pkg-config package glib-2.0 is required but it
could not be found.
Failed to install glib-0.12.4
cabal: Error: some packages failed to install:
cairo-0.12.4 failed during the configure step. The exception was:
ExitFailure 1
gio-0.12.4 depends on glib-0.12.4 which failed to install.
glib-0.12.4 failed during the configure step. The exception was:
ExitFailure 1
gtk-0.12.4 depends on glib-0.12.4 which failed to install.
pango-0.12.4 depends on glib-0.12.4 which failed to install.

OK... so I guess it's time to install MacPorts because the Cairo page suggests using it to install cairo. I know there are competing tools -- fink and Homebrew and I've used both of them at some point, years ago, but removed them, for reasons I can no longer remember... I think it had something to do with the way they insisted on installing things under /opt and it was clear to me if they would interfere with each other. But anyway, I'll try the MacPorts installer for 2.13 for Mountain Lion... and then sudo port install cairo... oh, wow, it's installing the universe... bzip2, zlib, libpng, free type, perl5, python27... oh, the humanity...

OK, where are we... oh, cabal install gtk again. "The pkg-config package cairo-pdif is required but it could not be found." Let's try glib again.

Pauls-Mac-Pro:Gitit Wiki paul$ sudo port install glib2
--->  Computing dependencies for glib2
--->  Cleaning glib2
--->  Scanning binaries for linking errors: 100.0%
--->  No broken files found.

But cabal install gtk is still broken. Is there a MacPorts version of gtk2? Yes, apparently OH GOD IT'S BUILDING THE WHOLE WORLD...

(Musical interlude...)

But then cabal install gtk seems to go OK. A lot of deprecated function warnings. Another twenty minutes go by... what was I doing again? You know, I'm getting all confused, why don't I start with gtk2hs because Real World Haskell uses it... I need to sudo port install glade3... and OH GOD IT'S BUILDING THE WHOLE WORLD AGAIN... aaand welcome to hour three of "The Polar Game in Haskell, Day 6: Towards a GUI..."

OK, glade and glade3 don't have any executables in my path. Oh, it's glade-3, how silly of me, even though the port is called glade3. And it says Gtk-WARNING **: cannot open display:. Oh yeah, it's X-Windows JUST SHOOT ME IN THE GODDAMN FACE... oh, I mean now I will happily go down another rabbit hole, thank you sir may I have another? So... the older X server is not supported in Mountain Lion anymore but there's something called XQuartz. XQuartz-2.7.4.dmg... "you need to log out and log back in to make XQuartz your default X11 server." Oh, thanks, I'll just close these FOURTEEN browser tabs, SEVEN bash terminal sessions, and other apps... you know, it's time for a food break anyway...

...aaand we're back. It launches, but I get "an error occurred while loading or saving configuration information for glade-3. Some of your configuration settings may not work properly." There's a "Details" button:

Failed to contact configuration server; the most common
cause is a missing or misconfigured D-Bus session bus daemon.
See http://projects.gnome.org/gconf/ for information. (Details -
1: Failed to get connection to session: Session D-Bus not running.
Try running `launchctl load -w 
Failed to contact configuration server; the most common cause 
is a missing or misconfigured D-Bus session bus daemon. See 
http://projects.gnome.org/gconf/ for information. (Details -
1: Failed to get connection to session: Session D-Bus not running. 
Try running `launchctl load -w 
Failed to contact configuration server; the most common cause 
is a missing or misconfigured D-Bus session bus daemon. See 
http://projects.gnome.org/gconf/ for information. (Details -
1: Failed to get connection to session: Session D-Bus not running. 
Try running `launchctl load -w 
Failed to contact configuration server; the most common cause 
is a missing or misconfigured D-Bus session bus daemon. See 
http://projects.gnome.org/gconf/ for information. (Details -
1: Failed to get connection to session: Session D-Bus not running.
Try running `launchctl load -w 
Failed to contact configuration server; the most common cause
is a missing or misconfigured D-Bus session bus daemon. See
http://projects.gnome.org/gconf/ for information. (Details -
1: Failed to get connection to session: Session D-Bus not running.
Try running `launchctl load -w 

Gaaah! Well, OK, I can do that... and I'm able to edit a little file. Now to look at some tutorials. I get 404s on http://www.haskell.org/gtk2hs/docs/tutorial/glade/ and also http://dmwit.com/gtk2hs/%7C -- ooof. My first attempt at adapting a little code from Real World Haskell -- not going so well. This tutorial is still available: http://www.haskell.org/haskellwiki/Gtk2Hs/Tutorials/ThreadedGUIs but as to how useful it is... I'm gonna have to get back to you on that. There's also this tutorial: http://home.telfort.nl/sp969709/gtk2hs/chap2.html so I can create a little GTK GUI entirely in code rather than using a Glade file. Something like this:

import qualified Graphics.UI.Gtk

main :: IO ()
main = do
    window <- Graphics.UI.Gtk.windowNew
    Graphics.UI.Gtk.widgetShowAll window

Aaand I get an immediate segmentation fault. Hmmm. I think I read about running with "-threaded..."

Pauls-Mac-Pro:arctic-slide-haskell paul$ ghci -threaded
GHCi, version 7.4.1: http://www.haskell.org/ghc/  :? for help
Warning: -debug, -threaded and -ticky are ignored by GHCi

OK, how about GHC?

Pauls-Mac-Pro:arctic-slide-haskell paul$ ghc basic-gui.hs -threaded
[1 of 1] Compiling Main             ( basic-gui.hs, basic-gui.o )
Linking basic-gui ...
Undefined symbols for architecture x86_64:
  "_iconv", referenced from:
      _hs_iconv in libHSbase-
     (maybe you meant: _hs_iconv_open, 
_base_GHCziIOziEncodingziIconv_iconvEncoding6_info , 
_hs_iconv , _base_GHCziIOziEncodingziIconv_iconvEncoding4_closure , _base_GHCziIOziEncodingziIconv_iconvEncoding3_info , 
_base_GHCziIOziEncodingziIconv_iconvEncoding5_closure , 
_base_GHCziIOziEncodingziIconv_iconvEncoding6_closure , 
_base_GHCziIOziEncodingziIconv_iconvEncoding3_closure , 
_base_GHCziIOziEncodingziIconv_iconvEncoding2_closure , 
_base_GHCziIOziEncodingziIconv_iconvEncoding2_info , 
_base_GHCziIOziEncodingziIconv_iconvEncoding5_info , 
_base_GHCziIOziEncodingziIconv_iconvEncoding7_closure , 
_hs_iconv_close , 
_base_GHCziIOziEncodingziIconv_iconvEncoding7_info )
  "_iconv_close", referenced from:
      _hs_iconv_close in libHSbase-
     (maybe you meant: _hs_iconv_close)
  "_iconv_open", referenced from:
      _hs_iconv_open in libHSbase-
     (maybe you meant: _hs_iconv_open)
  "_locale_charset", referenced from:
      _localeEncoding in libHSbase-
ld: symbol(s) not found for architecture x86_64
collect2: ld returned 1 exit status

Hmmm. It seems like this might take longer than I thought...

12 July 2013

The Polar Game in Haskell, Day 5 3/4: a Bug Fix and liftM

Jeff Licquia has been playing further with the code and so have I. He discovered a bug in the version I posted in yesterday's installment (my bad). In slide' I neglected to call slide' in the recursive version of slide' but called the existing non-monadic slide. In other words, I had:

slide' ( t : Empty : ts ) = noscore ( Empty : ( slide ( t : ts ) ) )

The problem here is that we'll add nothing to the accumulated score, and proceed into a chain of function invocations that handle ordinary lists. So the score increase that should happen at that point never happens:

*Main> runWriter $ collide' [Heart, House]
([Empty,House],Sum {getSum = 1})
*Main> runWriter $ collide' [Heart, Empty, House]
([Empty,Empty,House],Sum {getSum = 0})

Oops. Yeah, that's a bug. Note that the compiler can't catch this because it's doing what I've asked; there are not actually any type conflicts. The monadic slide' returns the type it is supposed to return, but in building up the "payload, the [ Tile ] part of ScoreTracker [ Tile ], the code fails to continue to build up the state. Let this be a lesson to me -- leaving around the previous version of a function, when I'm testing a new one can be hazardous!

So, we can just fix that by calling slide', right?

slide' ( t : Empty : ts ) = noscore ( Empty : ( slide' ( t : ts ) ) )

Um, not so much:

    Couldn't match expected type `[Tile]'
                with actual type `ScoreTracker [Tile]'
    In the return type of a call of slide'
    In the second argument of `(:)', namely `(slide' (t : ts))'
    In the first argument of `noscore', namely
      `(Empty : (slide' (t : ts)))'

Oh... yeah. There's that. We want to continue building up the monadic version of the list, but the (:) just takes a regular list. Now it's all complicated! But really there's a simple solution. I'll quote Jeff for a while, since he explained it so well to me. I have not quoted his code exactly, but the ideas are the same:

...the straightforward fix fails, because slide' returns a ScoreTracker, not a [ Tile ]. So the fix is a little more complicated. Since slide' returns pretty much exactly what we need, we can start with just that:
slide' ( t : Empty : ts ) = slide' ( t : ts )
That's not quite right; we just dropped a tile. To get it back, remember that everything is a function, including the : operator [and so it is easily composed with other functions -- PRP]. That means we can create a function that prepends an Empty element to a list...
prefix_empty :: [ Tile ] -> [ Tile ] 
prefix_empty ts = Empty : ts
So why would we do this? Because we need to take ScoreTracker into account. Here Haskell provides a function called "liftM", which takes a normal function and "lifts" it into a monad. So:
prefix_empty_st :: ScoreTracker [ Tile ] -> ScoreTracker [ Tile ]
prefix_empty_st = liftM prefix_empty
will give us a function with the type ScoreTracker [ Tile ] -> ScoreTracker [ Tile ], which is what we want. (Technically, that's not true; it gives us Monad m => m [ Tile ] -> m [ Tile ]. But that's just a generic version of what we want, which works with ScoreTracker, Maybe, or lots of other monads).

So now we have this:

slide' ( t : Empty : ts ) = prefix_empty_st $ slide' ( t : ts )

Which doesn't use score or noscore -- it just builds up the list, still in a monadic context, preserving whatever score changes might be applied by the function invocations it makes. And actually since we're not going to use the prefix functions elsewhere, they don't really earn their keep, and we can just write:

slide' ( t : Empty : ts ) = liftM ( Empty : ) $ slide' ( t : ts )

Note the partial application of (:) by binding it to only one parameter before we pass it to liftM -- we're creating a new version of (:) that only takes one argument instead of two.

Jeff went on to identify a second bug, basically caused by the same problem in a collide' function also calling slide instead of slide'. A quick fix is to make that collide' function look like the slide' function we just fixed. But then, why not define one in terms of the other?

collide' ( t : Empty : ts ) | movable t = slide' ( t : Empty : ts )

Let's go back a bit and reconsider -- when I was using a special value for Edge, the logic for slide and collide was considerably simpler (although it did not work right). Here it is today:

slide' :: [ Tile ] -> ScoreTracker [ Tile ]
slide' ( Ice_Block : ts ) | ( null ts ) || ( blocking $ head ts ) =
    noscore ( Ice_Block : ts )
slide' ( t : Empty : ts ) = liftM ( Empty : ) $ slide' ( t : ts )
slide' ( t : ts ) | ( null ts ) || ( blocking $ head ts ) =
    collide' ( t : ts )

collide' :: [ Tile ] -> ScoreTracker [ Tile ]
collide' [] = noscore []
collide' ( t : ts ) | fixed t = noscore ( t : ts )
collide' ( Bomb : Mountain : ts) = noscore ( [ Empty, Empty ] ++ ts )
collide' ( Heart : House : ts ) = score ( [ Empty, House ] ++ ts )
collide' ( Ice_Block : ts ) | ( null ts ) || ( blocking $ head ts ) =
    noscore ( Empty : ts )
collide' ( t : ts ) | ( movable t ) && ( ( null ts ) ||
    ( blocking $ head ts ) ) = noscore ( t : ts )
collide' ( t : Empty : ts ) | movable t =
    slide' ( t : Empty : ts )

Erm. I'd no longer call that elegant, beautiful code. For one thing, I have to wrap it brutally to fit into my Blogger text window. That's not just annoying when dealing with Blogger -- it suggests that the lines are too long for easy reading even if they aren't wrapped. And here's what Jeff's version looks like today -- he's implemented his own way to structure the code with guards:

slide :: [ Tile ] -> ScoreTracker [ Tile ]
slide [] = noscore []
slide ( t1 : t2 : ts )
  | t1 == Ice_Block && blocking t2 = noscore ( t1 : t2 : ts )
  | blocking t2 = collide ( t1 : t2 : ts )
  | otherwise = do
                  ts' <- slide ( t1 : ts )
                  return ( Empty : ts' )
slide ( t : ts )
  | t == Ice_Block = noscore ( t : ts )
  | otherwise = collide ( t : ts )

collide :: [ Tile ] -> ScoreTracker [ Tile ]
collide [] = noscore []
collide ( t1 : t2 : ts )
  | ( t1, t2 ) == ( Bomb, Mountain ) = noscore ( Empty : Empty : ts )
  | ( t1, t2 ) == ( Heart, House ) = score ( Empty : House : ts )
  | t1 == Ice_Block && blocking t2 = noscore ( Empty : t2 : ts )
  | movable t1 && blocking t2 = noscore ( t1 : t2 : ts )
  | movable t1 = do
                   ts' <- slide ( t1 : ts )
                   return ( Empty : ts' )
  | otherwise = noscore ( t1 : t2 : ts )
collide ( t : ts )
  | t == Ice_Block = noscore ( Empty : ts )
  | otherwise = noscore ( t : ts )

And I like that -- using the separate functions for both slide and collide only to handle the structurally different versions -- empty list, list with at least two items, list with at least one item -- and the guards to handle when we differ by value. It is, I think, more readable than mine. I was a little freaked out by the use of do and <- in the middle of a function outside of main, but I'll think on that some more. I have not quite satisfied myself that it is perfectly correct, but then, I haven't really convinced myself that mine is correct either. So I have more to do on that front!

11 July 2013

The Polar Game in Haskell, Day 5 1/2: Refactoring with a Monad

The job search has eaten my brain for the last few days -- have I mentioned yet that I need a job? Oh, yes, I believe I may have -- but I'm taking some time to press on with my Haskell larnin', especially since I've been getting great, helpful feedback.

The first thing I did was make some minor fixes to the list implementation, as suggested by Jeff. It's working now and my version looks like this:

next_board_list :: BoardList -> Pos -> Dir ->
    ( Bool, BoardList )
next_board_list board pos dir =
    let ( penguin_moved, updated_view_list ) =
        step_list $ view_list board pos dir
    in ( penguin_moved, update_board_from_view_list 
         board pos dir updated_view_list )

apply_view_list_to_row :: [ Tile ] -> Int -> Bool -> [ Tile ] -> [Tile]
apply_view_list_to_row orig pos True update =
    take ( pos + 1 ) orig ++ update
apply_view_list_to_row orig pos False update =
    ( reverse update ) ++ ( drop pos orig )

apply_view_list_to_rows :: BoardList -> Int -> Int -> Bool -> [ Tile ]
    -> BoardList
apply_view_list_to_rows orig row pos is_forward update =
    take row orig ++
    nest ( apply_view_list_to_row ( orig !! row ) pos
           is_forward update ) ++
    drop ( row + 1 ) orig
    where nest xs = [xs]

update_board_from_view_list :: BoardList -> Pos -> Dir -> [ Tile ]
    -> BoardList
update_board_from_view_list board pos dir updated_view_list
    | is_eastwest = apply_view_list_to_rows board
                        ( posY pos ) ( posX pos )
                        is_forward updated_view_list
    | otherwise = transpose ( apply_view_list_to_rows ( transpose board )
                         ( posX pos ) ( posY pos ) 
                         is_forward updated_view_list )
    where is_forward = elem dir [ East, South ]
          is_eastwest = elem dir [ East, West ]

This code is on GitHub here.

Now, it turns out that Jeff did more than suggest a refactoring -- he actually did something I haven't quite gotten my head around yet, which is to refactor my code to use a monad for managing some of this task. He forked my code in his own GitHub repo here and sent me some notes to share on my blog. Here's part of what he said:

The way I got my head wrapped around monads was to think of them as "important stuff to do, but not the point". You need to do some housekeeping that's important, but it's not the reason you're writing this function. The classic example is division. You're writing a math library, and you need to implement division. Division by zero is something you need to deal with sanely, but it's not the point; you're writing the function because you want to divide by things that aren't zero. So, to handle the zero case, you return a Maybe instead of a simple number. Only now you can't just add numbers together with division, because you're dealing with Maybes, not numbers. So you end up implementing addition with Maybes, except that makes no sense, as adding never fails, and people using your math library get annoyed because now *they* have to deal with division-by-zero errors even when they're not dividing, and it's a mess. Except -- Maybe is a monad. So you skip all that mess, implement division with a Maybe, everything else without, and use the cool monad and functor features of the language to bridge the gaps. The same pattern exists with scorekeeping. A lot of the functions in your code need to keep track of the score and occasionally award points, but scores aren't "the point" of, say, collide. And when you start thinking about all the places you need to worry about scores, you start seeing scorekeeping infect all kinds of weird places in your code. I think you even mentioned having to "uglify" your code with scorekeeping in your blog post.

Yes, yes, yes -- mainly the chain of function invocations that handle generating the next board, down to the collide calls. Because it's only at the point where a heart disappears that we can decrement the heart count. Without state, I can't make this a global state. In a purely function form, I have to "thread" the indication that the heart count should be decreased through the whole chain of function signatures, which now all have to return an extra thing.

So, minimize the ugly with monads. Just do what you need to do to pass around the score, and deal with it when it's appropriate. (In my implementation, that was in next_world). The Writer monad is perfect for the job. It uses a monoid, which is a fancy ways of saying "something that knows how to grow". Lists are monoids, because you can append to them. Numbers are monoids, because you can add and multiply them. And so on. What the Writer monad does is take care of the adding part. You just return the thing you're working with, and the monad tacks it on using the monoid. Specifically, with scorekeeping, you just note how many points each individual action takes, and the monad does the adding together. When you finally deal with the score in next_world, you get all the accumulated points in one tidy variable.

OK, cool... let's see what he came up with!

import Control.Monad.Writer


-- Keep track of the score with a writer monad
type ScoreTracker = Writer ( Sum Int )

OK, let me pause there and see if I can make sense of that. Learn You a Haskell says

Whereas Maybe is for values with an added context of failure and the list is for non-deterministic values, the Writer monad is for values that have another value attached that acts as a sort of log value. Writer allows us to do computations while making sure that all the log values are combined into one log value that then gets attached to the result.

OK, I think I get that -- in Learn You it is used for implementing logging, not scoring of a game, but it seems like it could be generalizable. The example given does this just kind of thing I was mentioning -- makes a simple function return a tuple to pass both the actual interesting return value and the log string, or in our case I think we want a score. Learn You continues:

When we were exploring the Maybe monad, we made a function applyMaybe, which took a Maybe a value and a function of type a -> Maybe b and fed that Maybe a value into the function, even though the function takes a normal a instead of a Maybe a. It did this by minding the context that comes with Maybe a values, which is that they are values with possible failure. But inside the a -> Maybe b function, we were able to treat that value as just a normal value, because applyMaybe (which later became >>=) took care of checking if it was a Nothing or a Just value. In the same vein, let's make a function that takes a value with an attached log, that is, an (a,String) value and a function of type a -> (b,String) and feeds that value into the function. We'll call it applyLog. But because an (a,String) value doesn't carry with it a context of possible failure, but rather a context of an additional log value, applyLog is going to make sure that the log of the original value isn't lost, but is joined together with the log of the value that results from the function.

Oooh, again, that sounds very promising. So I'm convinced that Writer is the right abstraction here. The values that Writer gets are Sum and Int -- Sum is our monoid, Int is a type we're going to use to accumulate the updated score. (To go along with the Polar game logic, I think there really should ultimately be two scores -- one should be the heart count for a given board, which decrements, and gets tested against zero to indicate board completion, and the other should be a level, which increments as the player moves through the levels, but never mind that for now).

Jeff then came up with:

noscore :: a -> ScoreTracker a
noscore x = writer (x, Sum 0)

score :: a -> ScoreTracker a
score x = writer (x, Sum 1)

Two functions, noscore and score. I think these are both monadic return -- injecting a value, passing it to the next step while applying the sum operation. So let's see how he uses it. here's my slide function:

slide :: [ Tile ] -> [ Tile ]
slide ( Ice_Block : ts ) | ( null ts ) || ( blocking $ head ts ) = 
    ( Ice_Block : ts )
slide ( t : Empty : ts ) =
    ( Empty : ( slide ( t : ts ) ) )
slide ( t : ts ) | ( null ts ) || ( blocking $ head ts ) =
    collide ( t : ts )

I'm not going to take Jeff's current version, because he's restructured it a bit using guards, which obscures just the differences due to the use of the ScoreTracker, but here's a version that does the same thing. We don't have to explictly construct the return tuples:

slide' :: [ Tile ] -> ScoreTracker [ Tile ]
slide' ( Ice_Block : ts ) | ( null ts ) || ( blocking $ head ts ) =
    noscore ( Ice_Block : ts )
slide' ( t : Empty : ts ) =
    noscore ( Empty : ( slide ( t : ts ) ) )
slide' ( t : ts ) | ( null ts ) || ( blocking $ head ts ) =
    collide ( t : ts )

And this doesn't actually compile. Note that collide doesn't handle the monad -- the compiler warns us as Jeff described:

    Couldn't match expected type `ScoreTracker [Tile]'
                with actual type `[Tile]'
    In the return type of a call of `collide'
    In the expression: collide (t : ts)
    In an equation for slide':
        slide' (t : ts)
          | (null ts) || (blocking $ head ts) = collide (t : ts)

That seems pretty clear -- so I have to fix it up the same way:

collide' :: [ Tile ] -> ScoreTracker [ Tile ]
collide' [] = noscore []
collide' ( t : ts ) | fixed t = 
    noscore ( t : ts )
collide' ( Bomb : Mountain : ts) = 
    noscore ( [ Empty, Empty ] ++ ts )
collide' ( Heart : House : ts ) = score ( [ Empty, House ] ++ ts )
collide' ( Ice_Block : ts ) | ( null ts ) || ( blocking $ head ts ) = 
    noscore ( Empty : ts )
collide' ( t : ts ) | ( movable t ) && ( ( null ts ) ||
    ( blocking $ head ts ) ) = noscore ( t : ts )
collide' ( t : Empty : ts ) | movable t = 
    noscore ( Empty : ( slide( t : ts ) ) )

And slide' should call collide' instead of collide, of course. So once this is compiled and loaded into GHCI, we can play with it and compare it to the original collide:

*Main> :t collide'
collide' :: [Tile] -> ScoreTracker [Tile]
*Main> :t collide
collide :: [Tile] -> [Tile]
*Main> collide [ Bomb, Mountain ]
*Main> collide [ Heart, House ]
*Main> collide' [ Heart, House ]

    No instance for (Show (ScoreTracker [Tile]))
      arising from a use of `print'
    Possible fix:
      add an instance declaration for (Show (ScoreTracker [Tile]))
    In a stmt of an interactive GHCi command: print it

Er, yeah. The result is not printable, but can we see its type?

*Main> :t ( collide' [ Heart, House ] )
( collide' [ Heart, House ] ) :: ScoreTracker [Tile]

In fact, we can. So there might be an easy way to make the monadic type printable -- deriving ( Show ) doesn't work -- but first, how do we extract the values? Well, we get back the return value of the whole chain from runWriter:

*Main> runWriter $ collide' [Heart, House]
([Empty,House],Sum {getSum = 1})

What's the type? It's just a tuple:

*Main> :t ( runWriter $ collide' [Heart, House] )
( runWriter $ collide' [Heart, House] ) :: ([Tile], Sum Int)
*Main> fst $ runWriter $ collide' [Heart, House]
*Main> snd $ runWriter $ collide' [Heart, House]
Sum {getSum = 1}

Anyway, I think my mind is blown enough for today. I'm going to stop there. Jeff has made some other modifications to my code here and there -- modifications that improve the clarity -- but I'll have to get back to those. I'm off to read the monad tutorials again, and maybe understand them better this time!

02 July 2013

The Polar Game in Haskell, Day 5: Array v. List

So, a little more progress in learning me a Haskell: I've managed to implement the board using an immutable array. There's good news and bad news here. If you're an old hand at functional programming, you probably know all this and more, but I needed to do a little thinking on purely functional data structures. I have not really been satisfied with the amount of code necessary to manage my 2-D board in a list. I spent some time doodling some possible alternative implementation before concluding that purely functional data structures -- in which nodes are never mutated -- are hard. Anything I might be accustomed to doing with double or multiply-linked lists is pretty much a washout, since you can't ever share structure. In fact, I think one data structure I came up with might not be constructible at all without being able to mutate links between nodes. So I'm starting to understand why the tutorials all advise me to stick with lists.

Nevertheless, this is a small problem, and efficiency is not my biggest concern, at least not in the learning phase. I wanted to figure out how to use an immutable array. The tutorials have not been very satisfying. They seem to assume that anything this trivial is too trivial to demonstrate. But here's what I did.

First, the type of an array in Haskell encodes the number of dimensions and the node type, but not the size. You set that when you call the constructor. Here's a 2-D array type for my board:

type BoardArray = Array ( Int, Int ) Tile

I specified some bounds:

max_row :: Int
max_row = 3

max_col :: Int
max_col = 23

And I should point out one of the fundamental problems with using arrays: it's very easy to kill your program by exceeding the array bounds. There is a similar problem with head, but when writing functions with pattern-matching and guards there are pretty accepted conventions for dealing with empty lists. I suppose one could use guard patterns on all array accesses, but it starts to seem a little silly.

The next thing is that a given array works with some auxiliary types. The // operator takes an array and a list of tuples and builds a new array with updated content. The type of that list of tuples is this:

type TileAssocList = [ ( ( Int, Int ), Tile ) ]

For accessing multiple items in an array, the range method builds lists of indexing tuples. The syntax to range requires tuples of tuples, with the parentheses piling up, so I wrapped it up in a function:

make_2d_range :: Int -> Int -> Int -> Int -> [ ( Int, Int ) ]
make_2d_range y0 x0 y1 x1 = range ( ( y0, x0 ), ( y1, x1 ) )

So how does that work? It just iterates coordinates, permuting from higher indices to lower, like so:

*Main> make_range 0 0 0 1

*Main> make_range 0 0 1 3

For this problem domain, I need to know how reversed ranges work. For example, when the penguin is facing West, I want to build a range and a list of tiles in reverse index order. Can range do that for me?

*Main> make_range 0 23 0 0

Ah... no. I guess that would have been too easy. So I'll have to account for those cases specially. Here's a function to get the penguin's view out of a 2-D array of tiles, in the form of a tile association list I can use to create a freshly created "modified" array (it's not really modified, but a new one is created with the updates from that list applied):

view_array :: BoardArray -> Pos -> Dir -> TileAssocList
view_array board pos dir =
    let row = ( posY pos )
        col = ( posX pos )
        coord_list = case dir of
            East  -> if ( col == max_col )
                     then []
                     else make_2d_range row ( col + 1 ) row max_col
            South -> if ( row == max_row )
                     then []
                     else make_2d_range ( row + 1 ) col max_row col
            West ->  if ( col == 0 )
                     then []
                     else make_2d_range row 0 row ( col - 1 )
            North -> if ( row == 0 )
                     then []
                     else make_2d_range 0 col ( row - 1 ) col
        tile_assoc = zip coord_list ( map ( (!) board )
                                           coord_list )
    in case dir of
        East -> tile_assoc
        South -> tile_assoc
        West -> reverse tile_assoc
        North -> reverse tile_assoc

That's not so bad. The key to this function is the ! operator -- this gets a tuple and an array and returns an element -- and I zip the elements up with their coordinate tuples. Note that a lot of the bulk of this function is handling the edge cases, because we don't want to apply an out-of-range coordinate tuple to !. There may still be a shorter, clearer implementation possible. By comparison, here's a list-of-lists version factored a bit using currying to make it as self-documenting as I could get it -- note the use of id to let me return a general function as orient. I'm sure it doesn't impress FP whizzes, but I'm kinda proud of it -- I feel like I'm starting to use Haskell a little more idiomatically:

view_list :: BoardList -> Pos -> Dir -> [Tile]
view_list board pos dir =
    let row = ( posY pos )
        col = ( posX pos )
        transposed = elem dir [ South, North ]
        reversed = elem dir [ West, North ]
        orient | reversed = reverse
               | otherwise = id
        trim = case dir of
            East -> drop ( col + 1 )
            South -> drop ( row + 1 )
            West -> take col
            North -> take row
        extract | transposed = ( transpose board ) !! col
                | otherwise = board !! row  
    in orient $ trim $ extract

Testing view_list:

*Main> view_list init_board_list (Pos 0 0) East

*Main> view_array init_board_array (Pos 0 0) East

Now we can write step. Here's the list version I've presented before:

step_list :: [Tile] -> ( Bool, [Tile] )
step_list [] = ( False, [] )
step_list ts = if walkable (head ts) then ( True, ts )
                                     else ( False, collide ts )

The array version is a little more complicated, because I want to strip the list I pass to collide down to just a list of tiles, in order to retain that clean logic for dealing with just a list of tiles. So I unzip my coordinate tuples from my tiles, get a potentially updated tile list, and zip it back together. That complicates it a bit, like so:

step_array :: TileAssocList -> ( Bool, TileAssocList )
step_array [] = ( False, [] )
step_array tile_assoc = if ( walkable $ head tile_list )
                        then ( True, tile_assoc )
                        else ( False, zip coord_list
                               ( collide tile_list ) )
    where ( coord_list, tile_list ) = unzip tile_assoc

I'm going to have to uglify my nice collide method a bit because I need to return at least one additional value -- indicating whether collide consumed a heart, so that we can keep score of the game.

Next up, you can see the array and list solutions start to diverge hugely. It's hard to merge the list-based board back together with the potentially updated tile list to create the next immutable list-based board. My original method was pretty hideous. With Jeff's refactoring it's still a lot of code. (Note: I don't have this completely working yet; I'm getting a run-time error about bad patterns I haven't quite figured out yet):

next_board_list :: BoardList -> Pos -> Dir -> ( Bool, BoardList )
next_board_list board pos dir =
    let ( penguin_could_move, updated_view_list ) = 
        step_list $ view_list board pos dir
    in ( penguin_could_move, update_board_from_view_list 
         board pos dir updated_view_list )

apply_view_list_to_row :: [Tile] -> Int -> Bool -> [Tile] -> [Tile]
apply_view_list_to_row orig pos True update =
    take ( pos + 1 ) orig ++ ( init update )
apply_view_to_row orig pos False update =
    ( reverse ( init update ) ) ++ ( drop pos orig )

apply_view_list_to_rows :: BoardList -> Int -> Int -> 
    Bool -> [Tile] -> BoardList
apply_view_list_to_rows orig row pos is_forward update =
    take row orig ++
    nest ( apply_view_to_row ( orig !! row ) pos is_forward update ) ++
    drop ( row + 1 ) orig

update_board_from_view_list :: BoardList -> Pos -> Dir -> 
    [Tile] -> BoardList
update_board_from_view_list board pos dir updated_view_list
    | is_eastwest = apply_view_list_to_rows board
                        ( posY pos ) ( posX pos )
                        is_forward updated_view_list
    | otherwise = transpose ( apply_view_list_to_rows ( transpose board )
                              ( posX pos ) ( posY pos ) 
                              is_forward updated_view_list )
    where is_forward = elem dir [ East, South ]
          is_eastwest = elem dir [ East, West ]

By comparison, the array is much more suited to create an updated version of itself, given a list of elements to update. This is handled by the // function, in this simple function to create the next board in array form, called from step_array:

next_board_array :: BoardArray -> Pos -> Dir -> ( Bool, BoardArray )
next_board_array board pos dir =
    let ( penguin_could_move, updated_view ) =
        step_array $ view_array board pos dir
    in ( penguin_could_move, board // updated_view )

I like that -- it looks like we're working with the data structure rather than against it, although the overhead to manage the ranges and lists still feels to me more complicated than it should be. That complexity carries over elsewhere: for example, pretty-printing the array requires that range logic again. In fact I wind up just wrapping up and re-using the logic to pretty-print the list, so you can see how much additional code I needed:

pretty_tiles :: [Tile] -> String
pretty_tiles [] = "\n"
pretty_tiles (t:ts) = case t of
                 Empty     -> "___"
                 Mountain  -> "mt "
                 House     -> "ho "
                 Ice_Block -> "ic "
                 Heart     -> "he "
                 Bomb      -> "bo "
                 Tree      -> "tr "
             ++ pretty_tiles ts

pretty_board_list :: BoardList -> String
pretty_board_list [] = ""
pretty_board_list (ts:tss) = pretty_tiles ts ++ pretty_board_list tss

split_tile_list :: [ Tile ] -> [ [ Tile ] ]
split_tile_list [] = []
split_tile_list ts = [ take tiles_in_row ts ] ++
                     ( split_tile_list $ ( drop tiles_in_row ) ts )
    where tiles_in_row = max_col + 1

pretty_board_array :: BoardArray -> String 
pretty_board_array board = pretty_board_list split_tiles
    where full_range = make_2d_range 0 0 max_row max_col
          all_tiles = map ( (!) board ) full_range
          split_tiles = split_tile_list all_tiles

As an aside, it seems like there ought to be at least one standard list split function, but it looks like folks don't really agree on how it should work

So there it is -- the array is kind of a mixed blessing here. I haven't done any large-scale profiling on it, to determine if the need to generate a whole new array each pass is a big loss, compared to the potential structure-sharing in the list implementation. It simplifies some of the code dramatically, while adding a layer of dealing with ranges and lists of tuples everywhere -- as soon as we want to pull items out of the array, or merge them back in to a new array, we're dealing with lists again. Still, given the ugliness of the list merge code, it seems like the more natural choice for this kind of small game board data structure.