20 August 2013

Arduino, Day 2: the Most Minimal Scripting Language, or, Reifying Frozen Functions for Fun

Planet Haskell readers might want to skip this one.

Recently I've been thinking about the possibilities offered by embedded interpreters. This is becoming a common design pattern in commercial software -- games written in C++ embedding Lua, for example, or Python for graphical user interfaces, or occasionally Scheme, or even the JVM. However, adapting an existing full-blown scripting language won't necessarily fly on a small system. What if you have a DSP, with nothing resembling a *nix-like operating system -- no standard C library, or almost none, no POSIX-like APIs, etc.

Well, there are smaller languages. I've done a little research recently and come across some very small, cut-down implementations of Scheme or other Lisp dialects, or even a tiny BASIC, and languages like Forth can be very small.

But what if we have a really tiny chip? What if the SRAM budget we had to implement our embedded language was, say, not 2 MiB, or even 2 KiB, but 200 bytes?

The Arduino Uno R3 uses an ATmega328 microprocessor. It's considered an 8-bit chip. Calling chips 8-bit, 16-bit, 32-bit, 64-bit, etc. can be a little confusing these days, because a lot of chips can operate on several different data sizes, but this chip has 8-bit registers, so we'll consider it to be primarily an 8-bit part. It has 32 KiB of onboard flash memory to hold your program (it is persistent across power cycles). 32 KiB can hold a moderately complex compiled program. But as for RAM -- the working memory for computation in progress and run-time state -- it has only 2 KiB, a mere 2048 bytes. That's less RAM than the first computer I owned, which was a Radio Shack TRS-80 Model 1, with 4 KiB, although I did work with some smaller computers -- for example, a KIM-1. And presumably we don't want to use all our SRAM to implement our small scripting language itself; the scripts need to have some functions to call.

A microcontroller like this is designed to run simple programs. It's designed to be "bomb-proof" -- hard to fry with stray excess voltage. It has a low pin count -- miniscule, compared to the processors in my desktop and laptop machines -- and it has a number of built-in peripherals designed for digital I/O. It's a pretty cool chip -- these Arduinos have taken off among electronics hobbyists and are part of the whole "maker" movement because they exist in a sort of power per dollar sweet spot. If you fry the chip itself, you can replace it for a couple of dollars; if you fry the whole board, you're only out a few more.

What they aren't, though, is very well-suited for the modern programming model that assumes a very capable operating system, dynamic linking, dynamic allocation using malloc or new, and container objects created using class libraries like the STL (don't get me wrong, the STL is impressively efficient, but it just isn't designed to work around a very tiny memory model). So the Arduino's GCC toolchain doesn't even attempt to provide, say, <vector>.

So what would an embedded scripting language for the Uno R3 look like? Well, for one thing, the Arduino doesn't come with a file system to speak of. You can buy a "shield" of some time that provides a controller and a slot for a memory card, but this isn't included with the basic bard. So you can't count on a user's ability to place a script in a text file and update just that script in order to change the program's behavior, although I might do some experiments along those lines. Without something like that, you have to use the toolchain -- compiling your program and downloading it with avrdude. You can't count on files, but you have strings -- C-style strings, in the form of arrays of bytes. So you could implement a small BASIC or Scheme interpreter that executed a program contained in a C string. I will do some experiments along those lines too, if I can, especially if I can force the strings to live in the 32 KiB flash, which I think is possible, rather than the 2 KiB SRAM.

But what if you want something even simpler? What if pretty much any sort of interpreter looked like it was going to be too heavyweight for your purposes, using too much SRAM -- too much space for tables, and too much stack? Is there something even simpler you can do?

There is. You can write a "script" that consists of a series of objects, using some tricks I'll demonstrate. This is very definitely a work in progress; it has some rather extreme design compromises. In particular, it isn't at all friendly to the "script" author. If there is a typo, the compiler can't provide a very novice-friendly error message. It seems a little sadistic to inflict this sort of hair-shirt discipline on hobbyists, but let's consider it a thought experiment, exploring a a couple of implementation options.

I'm going to build my "scripting language" up in reverse; instead of showing you the syntax of the "scripting language" first, I'll show you the constructs I'm using to implement it, we'll and arrive at the syntax last. But first I need to explain some of the less common things I'm doing with the implementation.

Let's say I want to easily differentiate a set of overloaded functions, each of which is specialized on a single parameter type. (I won't explain why quite yet, but it will make sense later). What's the best way to do that? How about with a set of typedef'ed types, or enum types to distinguish them?

C++ and C are weakly typed, at least in places. Although the C++ class system can enforce strong typing, when working with POD (plain old data) types and particularly the typedef and enum keywords, typing isn't strongly enforced. What do I mean by that? Well, typedef and enum allow you to write code that looks superficially like it is strongly typed:

typedef int special_int;
void handle( int a );
void handle( special_int a );

But on my compiler, if I provide the functions to match these prototypes, and call them:

int handle_param_1 = 0;
special_int handle_param_2 = 0;
handle( handle_param_1 );
handle( handle_param_2 );

The compiler complains that I'm redefining handle. The compiler won't (and can't) really make use of it to provide type safety, because it's not really a distinct type, but a type alias -- that is, really just a nickname, more for documentation purposes than anything else; the compiler doesn't really see the alias as a distinct type at all.

In the case of enums, using enum can make your code more self-documenting, and it appears that I can reliably overload functions using specific enum types, which the compiler keeps distinct:

typedef enum { red, green, blue } color;
typedef enum { salty, sweet, sour } flavor;
void handle( color a );
void handle( flavor a );

But if there is no overloaded function with a parameter that exactly matches the enum type, C++ will happily promote the enum type to an int, or apply a standard conversion to turn it into a float -- so type-safety is potentially compromised again here. If you forget to provide an overloaded handle method that accepts your enum type, but there exists one that takes a single float parameter, the compiler will call that one, without a whisper of warning. Types don't get much weaker than that! (All right, yes they do, but let's not get into a sideways rant about PHP or Perl).

The very latest versions of C++ do provide a new "enum class" feature that gives one more control over enumerated types and allows the more powerful class type system to kick in and keep things straight, but it isn't widely used yet, and I'm not sure the compiler I have available for Arduino supports it. So, at least for today, we'll leave it out.

There is a tweak that makes this quite easy, though. In C++, a struct is actually a class whose members are all public by default. And it's possible to create an empty struct, with no data members. This gives me something I'll call it a type tag (I could call it a typeType in honor of the old AppleEvent manager's descriptor type, but let's not), and I'll call an instance of it a type token. They will let me reliably overload functions, since it uses C++ class types, designed for greater type safety and strictness than C's "plain old data" types.

Let's briefly review structs, in case you need a review: in C, structs are in their own namespace, but they can be typedef'ed into the common namespace:

struct s_tag { int m1, float m2 };

You can instantiate a struct in C like this:

struct s_tag s1;

But you can't say:

s_tag s1;

Unless you've used the typedef trick:

typedef struct s_tag s_type;

s_type s2;

These are used together so frequently that the C syntax supports wrapping the type definition and typedef up together:

typedef struct s_tag { int m1; float m2 } s_type;

So what is the point of that s_tag? Well, it is mostly vestigial, but it has one important use; it is the only way you can declare a struct that is self-referential. This is imperative when declaring a tree or list of struct types, if you are going to take advantage of type-checking, instead of mashing everything through void pointers and unsafe casting to get it back to the type you need. So,

typdef struct s_tag { int m1; float m2; s_tag *next_p } s_type;

and not:

typedef struct s_tag { int m1; float m2; s_type *next_p } s_type;

because the latter would require a forward reference to an incomplete type, and there's no way to specify that. Of course, it doesn't seem that unreasonable these days to ask a compiler to keep track of incomplete things as it goes and make sense of them in a later pass, but back in the day machines were smaller and slower, and so we have that vestigial struct tag.

And in C++, designed to maintain as much compatibility with C as possible, there are (of course) some subtle complications that can come into play, but that's basically how structs work.

In case you're curious, yes, there's a similar "enum tag" for enums, and you can refer to enum types in the enum namespace. I haven't see this sort of thing much in real-world code. There's yet another namespace for unions, and unions are structs as well in C++ -- we'll take advantage of that later. But moving on, let's define some type tags:

typedef struct {} step_1_tt;
typedef struct {} step_2_tt;
typedef struct {} step_3_tt;

And here are some "type tag" instances:

static steps::step_1_tt step_1_tt_i;
static steps::step_2_tt step_2_tt_i;
static steps::step_3_tt step_3_tt_i;

The empty struct isn't standard C (although I think GCC allows it as an extension), but it is allowed in C++. In standard C there is a similar trick where you can declare a pointers to incomplete (that is, forward-declared) struct types (does that let you use self-reference in structs without using the vestigial tag? I'll have to look into that. There's a lot to know for such a seemingly simple language feature!)

Now, we need to be able to distinguish our tiny scripting language "tokens," and for that we use an enumeration. (We could do this with subtypes, as well, and maybe I'll consider that for later, but for now we'll do it this way). We'll define several types that correspond to functions:

typedef enum
{
    step_type_1,
    step_type_2,
    step_type_3,

} step_e;

Next up, we want to define the functions. This is pretty basic. We could do it with function pointers, of specific function pointer types, and I might explore that later, but for now we'll refer to a hard-coded set of actual functions. Here they are, simple placeholders that print their arguments, for testing:

void step_func_a( signed long );
void step_func_b( unsigned long );
void step_func_c( signed short );

void step_func_a( signed long p1 )
{
    std::cout << "step func a with param" << p1 << "\n";
}

void step_func_b( unsigned long p1 )
{
    std::cout << "step func b with param" << p1 << "\n";
}

void step_func_c( signed short p1 )
{
    std::cout << "step func c with param" << p1 << "\n";
}

So those are the functions we can call from our "scripts." But what about the parameters? We'll use unions. This is unsafe, in the sense that the type system will not keep us safe, and we'll have to use some extra bookkeeping have to make sure we decode parameters the same way they were encoded. Because a union in C++ is also a class, we can provide constructors for our union type, and even overload them, to handle the different types that might be passed in:

union step_param_u
{
    step_param_slong    slong_param;
    step_param_ulong    ulong_param;
    step_param_sshort   sshort_param;
    step_param_ushort   ushort_param;
    step_param_schar    schar_param;
    step_param_uchar    uchar_param;
    // We could add more here, for any parameter types we need
    // to store and reconstitute later

    step_param_u()                   : slong_param( 0 )   {};
    step_param_u( signed long   p1 ) : slong_param ( p1 ) {};
    step_param_u( unsigned long p1 ) : ulong_param ( p1 ) {};
    step_param_u( signed short  p1 ) : sshort_param( p1 ) {};
    step_param_u( signed char   p1 ) : schar_param( p1 )  {};

};

One of those union objects will represent one parameter. Let's wrap that all up with a struct that will embody a "frozen function call" with up to 3 parameters. We could extend that if we need more.

There's a sort of type-system hole in that we don't have a safe, distinguishable way to represent a null parameter -- that is, one that wasn't provided -- and so there's not quite a sensible default constructor for step_param_u. We could use subclasses of our "frozen function call" to represent function calls with no parameters, one parameter, two parameters, three parameters, etc. so that we don't have to represent the idea of an unused parameter at all, but this results in an explosion of types (and I'm not even really taking return values into account at all, at this point; our scripting language uses a completely imperative paradigm). Maybe the number of unique parameter and return value combinations is not that large in practice, but for now let's just get a simple thing working:

struct step_s
{
    step_e step_type;
    step_param_u param_1;
    step_param_u param_2;
    step_param_u param_3;

    step_s( step_1_tt, signed long p1 ) :
        step_type( step_type_1 ),
        param_1( p1 )
        {};
    step_s( step_2_tt, signed long p1 ) :
        step_type( step_type_2 ),
        param_1( p1 )
        {};
    step_s( step_3_tt, signed short p1 ) :
        step_type( step_type_3 ),
        param_1( p1 )
        {};

};

And now for a trick to create our so-called. We turn things that look like function calls into actual constructor calls by adding a parameter. For this quick-and-dirty prototype, I'll use some macros:

#define MAKE_SEQUENCE(p1) step_s const p1[]
#define step_call_type_1(p1) step_s(step_1_tt_i,p1)
#define step_call_type_2(p1) step_s(step_2_tt_i,p1)
#define step_call_type_3(p1) step_s(step_3_tt_i,p1)

Is it raw and wriggling, precious? Make sure you understand what's going on here: these macros turn function-call-like syntax into constructor calls by passing our type tokens to select a matching overloaded constructor. Of course, the compiler is looking at the preprocessed code, which can make error messages harder to understand. I sometimes have to ask the compiler to generate preprocessor output to diagnose a problem, but a beginning Arduino programmer using the IDE won't even have a way to generate the preprocessor output.

And so here is an example of our tiny "scriping language" -- a sequence of steps to take, in reality function calls to make:

sequence(sequence_1) =
{

    step_call_type_1(-50101),
    step_call_type_2(0xDEADBEEF),
    step_call_type_3(-32767)

};

And that's our syntax.

Wait, really? Yes. That's a little script. That's why I call it the "most minimal" scripting language.

That actually turns into an array definition, with an implict (not explicitly declared) size, and an initialization list. Note that the ability to include constructor call expressions in an array initialization list is a newer feature of C++. Older compilers won't be able to handle the syntax at all. To support an older compiler we'd have to do some kind of post-definition assignment, which might require something like calling a variadic function with a list of macro invocations, and that could get really ugly really fast. Er, that is, even uglier than what we're already doing.

So how do we execute that script? Well, we need another bit of macro magic to find the length of a sequence:

// Length of a sequence; see Imperfect C++, the book by Matt Wilson, or his blog post:
// http://blog.imperfectcplusplus.com/2010/06/imperfect-cinventions-dimensionof.html
#define SEQUENCE_LENGTH(seq) (sizeof(seq)/sizeof(0[(seq)]))

And now we have all we need to write a function that runs a sequence. How about this, as the simplest thing that can work:

static void run_sequence( step_s const p1[], int const seq_len )
{
    for ( int seq_idx = 0; seq_idx < seq_len; seq_idx++ )
    {
        p1[seq_idx].invoke();
    }

}

Where invoke is a method of step_s:

void invoke() const
{
    switch( step_type )
    {
        case step_type_1:
            step_func_a( param_1.slong_param);
            break;
        case step_type_2:
            step_func_a( param_1.ulong_param);
            break;
        case step_type_3:
            step_func_a( param_1.sshort_param);
            break;

    }
}

Well, actually, we need this, too, so a particular instance can be sized at compile time:

#define RUN_SEQUENCE(p1) run_sequence(p1,SEQUENCE_LENGTH(p1))

And then I can just execute RUN_SEQUENCE(sequence_1).

Note that invoke assumes that the entire set of functions we might want to invoke from our script is known. This could be extended in some fashion -- breaking it down into a system library and a user library, allowing the user to add macro definitions to create new usable "statements" to use in our scripts. This would involve a more generic way to represent steps, using function signature-specific subclasses, or a predefined set of supported function pointer types. I think that function pointers can be cast to function pointers of different types, and that might get us part of the way there, but I see an explosion happening somewhere, either in the switch statements in invoke or in subclasses. it doesn't seem easy to really capture everything we might need at compile time. A function invocation in C isn't something that supports much in the way of compile-time introspection -- there's no standard facility to look up its arity, its number of parameters, and their types; we aren't working with S-expressions here. Even gruesome hacks involving variable-length argument lists won't let us really work this out for a general case, as far as I know, and I don't think template metaprogramming can entirely remedy this, although there might be some neat tricks to minimize the code we have to write.

Some extensions to our "scripting language" are clearly possible: for example, our language could be extended to include labels, goto, counters, and even conditional branching, fairly easily -- it's just that all of those items would look like function calls and be macro invocations that boiled down to overloaded constructor calls to some single struct or class type, or different struct or class types that have a single base class so that we can treat them uniformly. Essentially, we're implementing a script without ever parsing the text of our scripting language, per se, and that's what keeps it tiny.

The run_sequence function would need a little more complexity. In fact it could run multiple sequences in multiple threads -- there exist solutions for cooperative multi-tasking on Arduino. To my taste the ones I've seen so far are all still too heavyweight. I'm even tempted to implement a preemptive solution, so that a thread that is executing a delay can't delay the other threads. This may be a topic of some ongoing research, aka "playing," as my time allows.

Next time, if I can work something out, I'll consider some template-based ideas and whether they buy us anything useful. As always, I welcome your comments.

14 August 2013

Arduino, Day 1

Warning for Planet Haskell readers: imperative content! (Or, I tried to get GHC working in 2048 bytes of RAM but didn't get very far...)

A friend of mine sent me a RedBoard and asked me to collaborate with him on a development idea. So I'm playing with an Arduino-compatible device for the first time. I've been aware of the Arduino devices, and the maker... erm, what, "movement?" But just never got one. There were various reasons -- one was that after writing embedded code all day, what I've wanted to do with my time off is not necessarily write more embedded code. Another was that they are very small. But I'm always interested in learning something new, or maybe something quite old -- maybe a board designed specifically for hobbyists might help me revive some of my childhood interest in electronics.

So, I downloaded the Arduino IDE and checked that out a bit. There are some things about the way it's presented that drive me a little batty. The language is C++, but Arduino calls it the "Arduino Programming Language" -- it even has its own language reference page. Down at the bottom the fine print says "The Arduino language is based on C/C++." Ummm. What?

That really makes me mad. First, it seems to give the Arduino team credit for creating something that they really haven't. That team deserves plenty of credit -- not least for building a very useful library -- but they did not, repeat, did not, invent a programming language.

Second, it fails to give credit (and blame) for the language to the large number of people who actually designed and implemented C, C++, and the GCC cross-compiler running behind the scenes, with its reduced standard libraries and all. Of course, it's not that the Arduino team was really trying to hide the fact that there's an open-source compiler inside, but calling it the "Arduino Programming Langage" obfuscates this reality, at the very least.

And third, it obfuscates what programmers are actually learning -- specifically, the distinction between a language and a library.

That might keep things simpler for beginners but this is supposed to be a teaching tool, isn't it? I don't think it's a good idea to obfuscate the difference between the core language (for example, bitwise and arithmetic operators), macros (like min), and functions in the standard Arduino libraries. The Arduino documentation muddles this distinction. But it's important -- for one thing, errors in using each of these will result in profoundly different kinds of diagnostic messages or other failure modes. It also obfuscates something important for experts. That something is "which C++ is this?"

C++ has many variations now. Can I use enum classes or other C++11 features? I don't know, and because of the facade that Arduino is a distinct language, it is harder to find out. They even have the gall to list true and false as constants. Sure, they are constants, but that doesn't mean C and C++ have an actual, useful Boolean type. In fact, they can't, for reasons of backwards compatibility. And if there's one thing C and C++ programmers know, and beginners need to learn quickly, it's that logical truth in C and C++ is messy and requires vigilance. I would hate to have to explain to a beginner why testing a masked bit that is not equal to one against true does not give the expected result.

Anyway, all that aside, this is C++ where the IDE does a few hidden things for you when you compile your code. It inserts a standard header, Arduino.h. It links you to a standard main(). I guess that's all helpful. But finally, it generates prototypes for your functions. That implies a parsing stage, via a separate tool that is not a C++ compiler. If that very thought doesn't cause your brow to furrow, you don't know much about C++.

But let's talk about plugging in the Redboard. On my Mac Pro running Mountain Lion, the board was not recognized as a serial device at all. There's some kind of workaround for this but I just switched over to Ubuntu 12.04 on a ThinkPad laptop. The IDE works flawlessly. I tried to follow some directions to see where the code was actually built by engaging a verbose mode for compilation and uploading, but I couldn't get that working. So I decided that the IDE was obfuscating more than helping, and ditched it.

This was fairly easy, with the caveat that there are a bunch of outdated tools out there, and outdated blog posts explaining how to do it. I went down some dead ends and rabbit holes, but the procedure is really not hard. Ultimately, I used sudo apt-get install to install arduino-core and arduino-mk.

There is now a common Arduino.mk makefile in my /usr/share/arduino directory and I can make project folders with makefiles that refer to it. To make this work I had to add a new export to my .bashrc file, export ARDUINO_DIR=/usr/share/arduino (your mileage may vary depending on how your Linux version works, but that's where I define additional environment variables).

The Makefile in my project directory has the following in it:

BOARD_TAG    = uno
ARDUINO_PORT = /dev/serial/by-id/usb-*
include /usr/share/arduino/Arduino.mk

And that's it. Nothing else. Everything else is inherited from the common Arduino.mk. I can throw .cpp and .h files in there and make builds them and make upload uploads them using the amusingly named utility avrdude (the name stands for AVR Downloader/UploaDEr... er, Dude, that's OK, you can just call it AVRDUDE because you're into AVR chips and you wrote it, that's good enough...

If you have trouble with the upload (wait, is this an "upload" or a "download?" I always thought of "down" as being "downstream" from the bigger computer/data store/ocean to the smaller computer/pond -- like from the Internet to your computer -- but I guess you can call it whatever you want) you might take a look at your devices. A little experimentation (listing the contents of /dev before and after unpluging the board) reveals that the RedBoard is showing up on my system as a device under /dev/serial -- in my case, /dev/serial/by-id/usb-FTDI_FT232R_USB_UART_A601EGHT-if00-port0 and /dev/serial/by-path/pci-0000:00:1d.0-usb-0:2:1.0-port0 (your values will no doubt vary). That's why my Makefile reads ARDUINO_PORT = /dev/serial/by-id/usb-* -- so it will catch anything that shows up in there with the usb- prefix. Of course, if your device is showing up elsewhere, or you have more than one device, you might need to tweak this to properly identify your board.

When you look at the basic blink demo program in the Arduino IDE, you see this, the contents of an .ino file (except that I have removed the comments):

int led = 13;

void setup() {                
    pinMode(led, OUTPUT);     
}

void loop() {
    digitalWrite(led, HIGH);
    delay(1000);
    digitalWrite(led, LOW);
    delay(1000);
}

The Makefile knows how to build an .ino file and inserts the necessary header, implementation of main, and generates any necessary prototypes. Here's what the file looks like to the compiler (and if you want to build this code with make as a .cpp file, it needs to look more like this):

#include <Arduino.h>

int led = 13;

void setup() {
    pinMode(led, OUTPUT);
}

void loop() {
    digitalWrite(led, HIGH);
    delay(1000);
    digitalWrite(led, LOW);
    delay(1000);
}

int main(void)
{
    init();

#if defined(USBCON)
    USBDevice.attach();
#endif

    setup();

    for (;;) {
        loop();
        if (serialEventRun) serialEventRun();
    }

return 0;

}

And there it is -- C++, make, and no IDE. Relaxen and watchen Das blinkenlights!

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
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 ()
gui
    = 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 ()
main
  = 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
found.

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 Type:  EXC_BREAKPOINT (SIGTRAP)
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:
 /usr/local/lib/libintl.8.dylib:
            no matching architecture in universal wrapper
 /usr/local/lib/libintl.8.dylib:
            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.

Done.

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 
/Library/LaunchAgents/org.freedesktop.dbus-session.plist'.)
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 
/Library/LaunchAgents/org.freedesktop.dbus-session.plist'.)
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 
/Library/LaunchAgents/org.freedesktop.dbus-session.plist'.)
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 
/Library/LaunchAgents/org.freedesktop.dbus-session.plist'.)
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 
/Library/LaunchAgents/org.freedesktop.dbus-session.plist'.)

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
    Graphics.UI.Gtk.initGUI
    window <- Graphics.UI.Gtk.windowNew
    Graphics.UI.Gtk.widgetShowAll window
    Graphics.UI.Gtk.mainGUI

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-4.5.0.0.a(iconv.o)
     (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-4.5.0.0.a(iconv.o)
     (maybe you meant: _hs_iconv_close)
  "_iconv_open", referenced from:
      _hs_iconv_open in libHSbase-4.5.0.0.a(iconv.o)
     (maybe you meant: _hs_iconv_open)
  "_locale_charset", referenced from:
      _localeEncoding in libHSbase-4.5.0.0.a(PrelIOUtils.o)
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:

arctic-slide.hs:52:49:
    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 ]
[Empty,Empty]
*Main> collide [ Heart, House ]
[Empty,House]
*Main> collide' [ Heart, House ]

:23:1:
    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]
[Empty,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
[(0,0),(0,1)]

*Main> make_range 0 0 1 3
[(0,0),(0,1),(0,2),(0,3),(1,0),(1,1),(1,2),(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
[Empty,Empty,Empty,Empty,Empty,Empty,Empty,Empty,Empty,Empty,Empty,Empty,
Empty,Empty,Tree,Empty,Empty,Empty,Empty,Empty,Ice_Block,Empty,Empty]

*Main> view_array init_board_array (Pos 0 0) East
[((0,1),Empty),((0,2),Empty),((0,3),Empty),((0,4),Empty),
((0,5),Empty),((0,6),Empty),((0,7),Empty),((0,8),Empty),
((0,9),Empty),((0,10),Empty),((0,11),Empty),((0,12),Empty),
((0,13),Empty),((0,14),Empty),((0,15),Tree),((0,16),Empty),
((0,17),Empty),((0,18),Empty),((0,19),Empty),((0,20),Empty),
((0,21),Ice_Block),((0,22),Empty),((0,23),Empty)]

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.

29 June 2013

The Polar Game in Haskell, Day 4 1/2: Folding a Penguin

So, just a quick update today. While I was cooking bacon this morning I looked at comments and tried to implement an idea I had last night. Roland suggested I could get rid of Edge. I had already been asking myself this. Using a special flag value for the edge-of-board case came from the Objective-C version where I wanted to avoid reading tiles outside the bounds of the board array. When using lists there is a built-in termination condition, so Edge is gone completely.

Roland also suggested a simplified next_ppos, like so:

next_ppos :: Pos -> Dir -> Pos
next_ppos pos dir = Pos ( posY pos + fst step ) ( posX pos + snd step )
    where step = delta dir
          delta East = ( 0, 1 )
          delta South = ( 1, 0 )
          delta West = ( 0, -1 )
          delta North = ( -1, 0 )

So that's in there now. Thanks, Roland!

The next thing I wanted to do is get rid of that ugly test code with all the nested calls to next_world. I was re-reading Learn You a Haskell and it occurred to me that this sort of thing -- distilling a list -- is what folds are for. And then, a minute later, that I don't actually want to fold the worlds down to one final world -- I want to capture all the intermediate worlds as we process a list of moves. And that's what a scan is for. So we're conducting surveillance on the penguin as he goes about his business. GHCI tells me that the type of scanl is (a -> b -> a) -> a -> [b] -> [a]. So I'm calling it with a function that takes a World and a Dir and returns a World. That's the (a -> b -> a) part. Then it gets an initial World, that's the a, and a list of elements of type Dir, that's the [b], and returns a list of elements of type World, that's [a].

moves_to_dirs :: [(Dir, Int)] -> [Dir]
moves_to_dirs [] = []
moves_to_dirs (m:ms) = replicate ( snd m ) ( fst m ) ++ moves_to_dirs ms

moves_board_1 = [(East,21),(South,2), (East,3),(North,2),(West,2)]

move_sequence :: [(Dir,Int)] -> [World]
move_sequence repeats = scanl next_world init_world steps
    where steps = moves_to_dirs repeats

main :: IO ()
main = do
    mapM_ putStrLn pretty_worlds
    where worlds = move_sequence moves_board_1

And that gives me the whole shebang, ending in:

penguin @: Pos {posY = 0, posX = 22}, facing: West, hearts: 3
tr __________________________________________tr _______________ic ______
tr ___bo ___mt ___he ic he ___________________________tr ______tr ______
tr _____________________________________________he _________mt ho ______
tr tr ____________tr ___________________________________________________

penguin @: Pos {posY = 0, posX = 21}, facing: West, hearts: 3
tr __________________________________________tr ic _____________________
tr ___bo ___mt ___he ic he ___________________________tr ______tr ______
tr _____________________________________________he _________mt ho ______
tr tr ____________tr ___________________________________________________

Oh, if you just want to see the final result, foldl will work here. Their types are identical, except that foldl returns a single a (in this case, a World) instead of a list of elements of type World. So a function to make use of that just returns a single World, but everything else is the same. Like so:

move_sequence' :: [(Dir,Int)] -> World
move_sequence' repeats = foldl next_world init_world steps
    where steps = moves_to_dirs repeats

And then I can display both:

main :: IO ()
main = do
    mapM_ putStrLn pretty_worlds 
    putStrLn pretty_final_world
    where worlds = move_sequence moves_board_1
          final_world = move_sequence' moves_board_1
          pretty_worlds = map pretty_world worlds

I like it -- examples of fold and scan that are a little more complex than the usual textbook examples. Personally I'd rather read more of those and less about how we can implement some simple math operation that can be trivially implemented in a dozen other, more readable ways.

Oh, and it's not thoroughly tested or finished by any means, but if you'd like to play with this code, it's on github now: https://github.com/paulrpotts/arctic-slide-haskell. Comments are welcome as always.

28 June 2013

The Polar Game in Haskell, Day 4

OK, things are getting meaty: I've made some minor modifications to World:

data World = World { wBoard :: Board, wPenguinPos :: Pos,
                     wPenguinDir :: Dir, wHeartCount :: Int }
                     deriving (Show)

This extracts the sequence of tiles in front of the penguin, for various directions, from a nested list representation of the board:

view :: Board -> Pos -> Dir -> [Tile]
view board pos East = ( drop ( posX pos + 1 ) $
    board !! ( posY pos ) ) ++ [Edge]
view board pos South = ( drop ( posY pos + 1 ) $
    ( transpose board ) !! ( posX pos ) ) ++ [Edge]
view board pos West = ( reverse $ take ( posX pos ) $
    board !! ( posY pos ) ) ++ [Edge]
view board pos North = ( reverse $ take ( posY pos ) $
    ( transpose board ) !! ( posX pos ) ) ++ [Edge]

I have fleshed out slide and collide after some testing; I haven't tested all my known cases yet. Maybe tomorrow. Here is how I create the initial world:

init_world :: World
init_world = ( World init_board ( Pos 0 0 ) South 3 )

South because in the south-facing representation, the penguin's face is visible (although of course I don't have a GUI yet).

A little utility function for clarity:

nest :: [a] -> [[a]]
nest xs = [xs]

And now, deep breath, the logic to build the next board out of the current board combined with a replaced list of tiles that may have been changed due to object interaction. It gets pretty ugly here when we're undoing the appending of Edge with init, and undoing the reversing that view has done when looking North and West, and working with the transposed board for North and South. There are some extra line breaks in there that are not in the working code. I have an issue with my let clauses not compiling correctly if I break the lines. I'm sure there's a prettier workaround, and I will look that up, but after going down a rabbit hole of Haskell syntax, I have timed out for today and right now I'm just happy it runs:

next_board :: Board -> Pos -> Dir -> ( Bool, Board )
next_board board pos East =
    let ( penguin_could_move, updated_view ) =
        step $ view board pos East
    in (
        penguin_could_move,
        take ( posY pos ) board ++
        nest (
            ( take ( posX pos + 1 )
                ( board !! ( posY pos ) ) ) ++
            ( init updated_view ) ) ++
        drop ( posY pos + 1 ) board )
next_board board pos South =
    let ( penguin_could_move, updated_view ) =
        step $ view board pos South
    in (
        penguin_could_move,
        transpose (
            take ( posX pos ) ( transpose board ) ++
            nest (
                ( take ( posY pos + 1 )
                    ( ( transpose board ) !! ( posX pos ) ) ) ++
                ( init updated_view ) ) ++
        drop ( posX pos + 1 ) ( transpose board ) ) )
next_board board pos West =
    let ( penguin_could_move, updated_view ) =
        step $ view board pos West
    in (
        penguin_could_move,
        take ( posY pos ) board ++
        nest (
            ( reverse ( init updated_view ) ) ++
            ( drop ( posX pos )
                ( board !! ( posY pos ) ) ) ) ++
        drop ( posY pos + 1 ) board )
next_board board pos North =
    let ( penguin_could_move, updated_view ) =
        step $ view board pos North
    in (
        penguin_could_move,
            transpose (
            take ( posX pos ) ( transpose board ) ++
            nest (
                ( reverse ( init updated_view ) ) ++
                ( drop ( posY pos )
                    ( ( transpose board ) !! ( posX pos ) ) ) ) ++
            drop ( posX pos + 1 ) ( transpose board ) ) )

That... seems like way too much code, and I would like to kill it in favor of using a real array type -- soon. The tutorials were pretty insistent that I try to use lists. I'm pretty sure this is not what they meant. I will say that I was really impressed, writing this, how much of it worked the first time, as soon as I got it past the compiler. But that doesn't necessarily mean this is the best possible design for this code.

Anyway, updating penguin pos:

next_ppos :: Pos -> Dir -> Pos
next_ppos pos East = ( Pos ( posY pos ) ( posX pos + 1 ) )
next_ppos pos South = ( Pos ( posY pos + 1 ) ( posX pos ) )
next_ppos pos West = ( Pos ( posY pos ) ( posX pos - 1 ) )
next_ppos pos North = ( Pos ( posY pos - 1 ) ( posX pos ) )

And, updating the world. I had a similar problem with the line-broken let clause here:

next_world :: World -> Dir-> World
next_world old_world move_dir =
    let ( can_move, board ) = next_board ( wBoard old_world )
        ( wPenguinPos old_world ) ( wPenguinDir old_world )
    in
        if ( move_dir /= wPenguinDir old_world )
        then ( World ( wBoard old_world ) ( wPenguinPos old_world )
                   move_dir ( wHeartCount old_world ) )
        else ( World board
                   ( next_ppos ( wPenguinPos old_world )
                               ( wPenguinDir old_world ) )
                   ( wPenguinDir old_world )
                   ( wHeartCount old_world ) )

Now, some pretty-printing, since it gets pretty tedious to visualize the board from reading the dumped-out list in GHCI:

pretty_tiles :: [Tile] -> String
pretty_tiles [] = "\n"
pretty_tiles (t:ts) = case t of
                 Empty     -> "___ "
                 Mountain  -> "mtn "
                 House     -> "hou "
                 Ice_Block -> "ice "
                 Heart     -> "hea "
                 Bomb      -> "bom "
                 Tree      -> "tre "
                 Edge      -> "### "
             ++ pretty_tiles ts

pretty_board :: Board -> String
pretty_board [] = ""
pretty_board (ts:tss) = pretty_tiles ts ++ pretty_board tss

pretty_world :: World -> String
pretty_world world =
    "penguin @: " ++ show ( wPenguinPos world ) ++
    ", facing: "  ++ show ( wPenguinDir world ) ++
    ", hearts: "  ++ show ( wHeartCount world ) ++
    "\n" ++ pretty_board ( wBoard world )

And here's where the rubber meets the road -- or, rather, fails to. I need state, at least simulated state. I messed with state monads for a while but I'm not quite ready. I will tackle that another day. I messed with trying to capture a list in a closure and append a series of successive worlds to it but while that would work fine in Scheme, Lisp, or Dylan I realized that in Haskell I was just fighting the entire language design. So I gave in and did this stupid thing for now, just so I could see my world updating and start to validate that all the tile interactions on the board work:

main :: IO ()
main = do
    putStrLn "ArcticSlide start"
    let world0 = init_world
    putStrLn $ pretty_world world0

    -- 21 East
    let world5  = next_world ( next_world ( next_world ( next_world (
        next_world world0  East ) East ) East ) East ) East
    let world10 = next_world ( next_world ( next_world ( next_world (
        next_world world5  East ) East ) East ) East ) East
    let world15 = next_world ( next_world ( next_world ( next_world (
        next_world world10 East ) East ) East ) East ) East
    let world20 = next_world ( next_world ( next_world ( next_world (
        next_world world15 East ) East ) East ) East ) East
    let world21 = next_world world20 East
    putStrLn $ pretty_world world21
    -- 2 South
    let world23 = next_world ( next_world world21 South ) South
    putStrLn $ pretty_world world23
    -- 3 East
    let world26 = next_world ( next_world (
        next_world world23 East ) East ) East
    putStrLn $ pretty_world world26
    -- 2 North
    let world28 = next_world ( next_world world26 North ) North
    putStrLn $ pretty_world world28
    -- 2 West
    let world30 = next_world ( next_world world28 West ) West
    putStrLn $ pretty_world world30

That is far from what I'd like to be doing eventually with managing game moves, and I still haven't put in any handling for the heart count, but it works:

ArcticSlide start
penguin @: Pos {posY = 0, posX = 0}, facing: South, hearts: 3
tr __________________________________________tr _______________ic ______
tr ___bo ___mt ___he ic he ___________________________tr ______tr ______
tr _____________________________________________he _________mt ho ______
tr tr ____________tr ___________________________________________________

...

penguin @: Pos {posY = 0, posX = 22}, facing: North, hearts: 3
tr __________________________________________tr _______________ic ______
tr ___bo ___mt ___he ic he ___________________________tr ______tr ______
tr _____________________________________________he _________mt ho ______
tr tr ____________tr ___________________________________________________

penguin @: Pos {posY = 0, posX = 21}, facing: West, hearts: 3
tr __________________________________________tr ic _____________________
tr ___bo ___mt ___he ic he ___________________________tr ______tr ______
tr _____________________________________________he _________mt ho ______
tr tr ____________tr ___________________________________________________

Aaaand... the penguin has pushed the ice block in the upper right to the west, and it has slid west and become blocked by the tree. That's... good, right? My brain is a little fried. All that to update a game board. I need a break, and maybe a stiff drink. I'm going to have to fortify myself before I successfully tackle the state monad. But I am determined!