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!

27 June 2013

The Polar Game in Haskell, Day 3

More phone interviews, more coding. On my laptop, amidst a gaggle of fighting children, during a thunderstorm, with our basement flooding, with the kind assistance of some friendly commentors, a little more progress. Let's change Pos

data Pos = Pos { posY :: Int, posX :: Int }
    deriving (Show, Eq)

And define a game world:

data World = World { board :: Board, penguinPos :: Pos,
                          penguinDir :: Dir,
                          heartCount :: Int } deriving (Show)

It was painful, took an embarrassingly long time, and this can't possibly be how I want to keep it indefinitely, but I finished slice which treats a list of lists of tiles like a 2-dimensional array and gives us what the penguin sees before him, looking in a given direction:

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

Let's just leave that as it is for now and use it, with the intent of replacing it with a real array of some sort later on. I still have to figure out how to merge a modified penguin track with an unmodified board to create the next state of the entire board... that's not going to be pretty, but it's doable.

So, one of the things I really love about Haskell is that once you get these pieces, they really do start come together nicely. Let's go ahead and define the first board. I could make it from the strings or a run-length encoding or something, but for now let's just bite the bullet and build the list the hard way:

get_initial_board :: [[Tile]]
get_initial_board = [[Tree,Empty,Empty,Empty,Empty,Empty,
                      Empty,Empty,Empty,Empty,Empty,Empty,
                      Empty,Empty,Empty,Tree,Empty,Empty,
                      Empty,Empty,Empty,Ice_Block,Empty,Empty],
                     [Tree,Empty,Bomb,Empty,Mountain,Empty,
                      Heart,Ice_Block,Heart,Empty,Empty,Empty,
                      Empty,Empty,Empty,Empty,Empty,Empty,
                      Tree,Empty,Empty,Tree,Empty,Empty],
                     [Tree,Empty,Empty,Empty,Empty,Empty,
                      Empty,Empty,Empty,Empty,Empty,Empty,
                      Empty,Empty,Empty,Empty,Heart,Empty,
                      Empty,Empty,Mountain,House,Empty,Empty],
                     [Tree,Tree,Empty,Empty,Empty,Empty,
                      Tree,Empty,Empty,Empty,Empty,Empty,
                      Empty,Empty,Empty,Empty,Empty,Empty,
                      Empty,Empty,Empty,Empty,Empty,Empty]]

penguin_view :: Board -> Pos -> Dir -> [Tile]
penguin_view board pos dir = drop 1 $ slice board pos dir

So now we can actually start doing stuff with this. Here's what's in front of the penguin when he looks at the board from different points, in different directions:

*Main> penguin_view get_initial_board (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,Edge]

*Main> penguin_view get_initial_board (Pos 0 0) South
[Tree,Tree,Tree,Edge]

*Main> penguin_view get_initial_board (Pos 0 0) West
[Edge]

*Main> penguin_view get_initial_board (Pos 0 0) North
[Edge]

*Main> penguin_view get_initial_board (Pos 3 21) North
[House,Tree,Ice_Block,Edge]

Fun! Tomorrow, if I can manage it... an updated world.

26 June 2013

The Polar Game in Haskell, Day 2

Another short day since I had several phone interviews. Thanks to the folks who left comments!

I got a little further today; I feel like I'm starting to understand Haskell's data handling a little bit better. It's a cliché but I think the hard part is un-learning, and understanding what something like this doesn't do. So here's where it stands now -- not finished by any means, but coming along, with painful slowness as I continue to learn:

data Dir = North | East | South | West
    deriving (Show, Eq)

data Pos y x = Pos Int Int
    deriving (Show, Eq)

-- N.B.: capitalization of initial letters in posY, posX is
-- semantically important!
posY ( Pos y x ) = y
posX ( Pos y x ) = x

data Tile = Empty | Tree | Mountain | House | Ice_Block |
    Bomb | Heart | Edge deriving (Show, Eq)

-- Different types of tiles have different properties in
-- different interaction contexts: 

-- The penguin can walk through empty tiles or trees (forest)
walkable :: Tile -> Bool
walkable t = ( t == Empty ) || ( t == Tree )

-- But everything except empty tiles will block sliding objects
blocking :: Tile -> Bool
blocking t = ( t /= Empty )

-- A subset of tiles are movable (and will slide until blocked)
movable :: Tile -> Bool
movable t = ( t == Bomb ) || ( t == Heart ) || ( t == Ice_Block )

-- A subset of tiles aren't movable; note that this set
-- overlaps blocking and that Tree is both walkable and fixed
fixed :: Tile -> Bool
fixed t = ( t == House ) || ( t == Mountain ) || ( t == Edge )

That all should be fairly non-controversial, I think. The predicate approach to classifying tiles in different contexts may actually make more sense in Haskell, given that I can then use these predicates as guards. The replacement for a simple struct, Pos, still feels awkward -- I haven't really dug into whether it could be improved with record syntax, or some other technique. For now it's there because it works.

All the beginner tutorials say "don't use arrays, don't use arrays, don't use arrays!" At least not until I reach the stage where I need to optimize the implementation. So I'll try that. Let's try a list, and I'll extract "slices" from it, lists starting at a given Pos going in one of four different directions. Eventually I want the slice function to terminate the slices with Edge tiles that aren't actually stored in the list. So... I have to think about this some more, but here's a single case, sort of taken care of:

type Board = [[Tile]]

slice :: Board -> Pos y x -> Dir -> [Tile]
slice board pos East = drop ( posX pos )
    $ head $ drop ( posY pos ) board
slice _ _ _ = error "slice: not handled yet!"

I don't have slide finished, but here's a version of collide that works, at least a little:

collide :: [Tile] -> [Tile]
collide (t:(Empty:ts)) | movable t =
    [Empty] ++ collide (t:ts)
collide (Bomb:(Mountain:ts)) = [Empty, Empty] ++ ts
collide (Heart:House:ts) = [Empty, House] ++ ts
collide (_) = error "collide: unexpected case!"

The nested pattern (Bomb:(Mountain:ts)) was sort of a flash of inspiration -- but it appears that maybe both this version and the (Heart:House:ts) version work the same -- I think -- so perhaps it's kind of pointless. It seemed to go along with the "destructure it the way you would structure it" idea, although I would normally not build a list out of cons cells unless it was irregular in some way.

Here's the penguin step function, returning True if the penguin can move onto the tile at the head of the list:

step :: [Tile] -> ( Bool, [Tile] )
step [] = error "step: empty list!"
step ts = if walkable (head ts) then ( True, ts )
                                else ( False, collide ts )

And there's a move, which "absorbs" the case where the penguin is turned to face a different direction. It's not really done; the idea is that it will give back the board, basically generating a new world. For now we kind of punt on the question of how to rebuild the board out of the existing board and the modified "slice" -- and so the I just return a list as the first element of the tuple. In the first case where the penguin hasn't moved, that doesn't actually make sense, but it satisfies GHC for now (wow, she's kind of a harsh mistress, but you've got to love those thigh-high black leather boots!)

move :: Board -> Pos y x -> Dir -> Dir ->
    ( [Tile], Pos y x, Dir, Dir )
move board pos move_dir penguin_dir =
    if move_dir /= penguin_dir
    then ( head board, pos, move_dir, move_dir )
    else ( collide $ slice board (Pos 1 0) penguin_dir,
        pos, penguin_dir, penguin_dir )

Boy, that's tuple-icious... not sure I like it, but it's a start. So:

*Main> walkable Tree
True
*Main> :t Pos
Pos :: Int -> Int -> Pos y x
*Main> let slice = [Heart, House]
*Main> collide slice
[Empty,House]
*Main> let slice = [Bomb, Empty, Mountain]
*Main> collide slice
[Empty,House]
*Main> let board = [[Empty, Tree, Empty, Edge],
    [Bomb, Empty, Mountain, Edge]]
*Main> move board (Pos 1 0) West East
([Empty,Tree,Empty,Edge],Pos 1 0,West,West)
*Main> move board (Pos 1 0) East East
([Empty,Empty,Empty,Edge],Pos 1 0,East,East)

More tomorrow if I can manage it! Oh, and it's here, such as it is: https://github.com/paulrpotts/arctic-slide-haskell

25 June 2013

The Polar Game in Haskell, Day 1

So if you've been following recent posts, you know I've been messing with the logic for a simple sliding-tile game. In my last post I took some designs refined via a side trip into Dylan and brought them back into Objective-C, making them a little more idiomatic by pruning my tile classes that didn't hold their weight, and compensating for Objective-C's very limited method dispatch options.

But in addition to learning Objective-C, and Apple's APIs for writing an app, I'm also trying to further my knowledge of Haskell, which is somewhere just beyond "utter newbie." So I'm going to try to implement the game logic in Haskell, too. Since the game is decidedly stateful, there is a certain impedance mismatch here, at least with respect to the early chapters in most of the tutorials and guides. But I'm told that Haskell also makes a great imperative programming language, so let's give it a shot. And along the way I can try to mold my understanding of stateful versus imperative a little more.

For day one, which was a shorter-than-usual day, I did not get into the state monad or how to model mutation of a 2-D array yet. I wanted to consider whether I could model the tile classes the way I could in Dylan, and do something useful in them. It occurred to me that each move of the penguin, and all the subsequent actions including possibly pushing an object, possibly a collision, possibly an object sliding frictionlessly as long as it can and then another collision, actually takes place in a 1-dimensional vector, not a 2-dimensional array. So it might be interesting to handle a penguin move by extracting a vector (in the form of a list) from the array, and replacing it with an updated list.

I haven't worked that all out yet but here is the bare beginning of my experimentation. There's a way to represent tiles:

data Tile = Empty | Tree | Mountain | House | Ice_Block | 
    Bomb | Heart | Edge
    deriving (Show)

Part of the confusion of learning Haskell is that, semantically, this isn't quite the equivalent of a set of enumerations, or of a set of class declarations. From what I can tell, this is more like a list of singleton factories -- constructors, where I've also derived them from Show, sort of the equivalent of mixing in a base class. But this is all an approximation, and Haskell is quite different than the other languages I'm most familiar with.

My next thought was that I wanted to be able to declare "base classes" so that, for example, I could have a Walkable class that comprised Empty and Tree. In Dylan I would do this by using classes, but there is different way: declaring a type-union of singletons. I think that this Haskell solution is more like the type-union. I looked in vain for an explicit type union. Instead I found class (which, in Haskell, does not correspond to a class in the sense that I'm used to, of a template for a run-time object that consists of data members and methods to operate on it, but a typeclass, something I clearly need to study more):

class Walkable a where
    walkable :: a -> Bool

And then this: which boils down to, I think, a function to determine whether a Tile is an instance of a Walkable typeclass:

instance Walkable Tile where
    walkable Empty = True
    walkable Tree = True
    walkable _ = False

Now I can write something like this (just a vague thought-in-progress at the moment):

slide :: [Tile] -> [Tile]
slide [] = error "slide empty list!"
slide (t) = error "single item list!"
slide (Empty:ts) = ts ++ slide ts

collide :: [Tile] -> [Tile]
collide [] = error "traverse empty list!"          
collide [Edge] = [Edge]
collide (Empty:ts) = ts
collide (Bomb:Mountain:ts) = [Empty, Empty] ++ ts          
collide (Heart:House:ts) = [Empty, House] ++ ts

step :: [Tile] -> Bool
step [] = error "step: empty list!"
step (t:_) = if walkable t then True else False

Then after sticking in a dummy main I can load this into GHCI and interact with it a little:

*Main> :t Tree
Tree :: Tile
*Main> step [Mountain, Empty, Empty, Tree, Edge]
False
*Main> step [Tree, Empty, Empty, Tree, Edge]
True
*Main> collide [Heart, Mountain]
*** Exception: arctic-slide.hs:(22,1)-(26,47): Non-exhaustive patterns in function collide
(Um, yeah, OK, I have work to do there)
*Main> collide [Heart, House]
[Empty,House]
*Main> slide [Empty, Empty, Empty, Empty, Mountain]
*** Exception: single item list!

Anyway, that's not exactly what I want to do -- really, I want the functions to actually return a new list of the same length, so I'll have to build it up as I recurse down the list -- maybe in the List monad? But it's a start on the whole basic concept of matching on the "types" of my tiles in a "vector," such as it is. That whole bit with walkable -- which I admit I don't quite understand yet -- seems like far too much conditional logic when I really just want to pattern-match on a type union of Tile. In other words, I want to write something like this (not valid Haskell):

union Walkable = Empty | Tree

step (Walkable:_) = True

That's a small example, but I have several other type union classes I need to use to categorize the tiles, so I have an incentive to make that as clear and simple as possible. It seems like I'm still fighting with Haskell's idioms here. Clearly, as they say, more research is needed...

24 June 2013

Objective-C, Day 6 (Back from Dylan-land)

I've been a little sick -- maybe something in our water, because our tap water started tasting like hose water -- but it seems to be clearing up. There's nothing like having flu-like symptoms to celebrate the first couple of days of summer! But I'm more-or-less back on my feet, although still a little queasy. Yesterday the weather station closest to our home in Saginaw hit 93, "feels like 100" with the humidity. I know that's nothing compared to some of the folks out west, but it came on us pretty fast, and I'd happily trade 100 in the low-humidity desert for 90 in Saginaw. I've got the A/C unit set up in the home office, since we finally need it, and I'm pressing on with my re-engineering of the old Mac Polar game.

The Dylan implementation I discussed last time helped focus my thinking about, if not the optimal, at least a fairly clear model for implementing game piece behavior. It also clarified what I should do with game objects in Objective-C, and that is "nothing." The "model" class still deserves to live, but the tile pieces just don't derive any benefit from being classes. The two main reasons are (1) Objective-C doesn't really support static methods in the sense that C++ does, and (2) Objective-C's dispatch mechanism isn't sophisticated enough to help us significantly save on "code to find code." So the tiles will be represented by plain old data, and we'll dispatch on their "types" with plain old logic.

The Dylan code has a small infrastructure of helper functions for accessing, filling, and logging the board state. I won't include all of it, because most of what it does is pretty clear from the function name, but there are functions like this:

define method getTileAtPos( model :: <model>, pos :: <pos-or-false> ) =>
    ( tile :: <tile> )
    if ( pos )
        getTileAtXY( model, pos.y-idx, pos.x-idx );
    else
        $the-edge;
    end if;
end;

define function getAdjacentPos( pos :: <pos>, dir :: <dir> )
    => ( pos-or-false :: <pos-or-false> )
    let y-offset :: <integer> = 0;
    let x-offset :: <integer> = 0;
    if ( dir == #"east" )
        x-offset := 1;
    elseif ( dir == #"south" )
        y-offset := 1;
    elseif ( dir == #"west" )
        x-offset := -1;
    elseif ( dir == #"north" )
        y-offset := -1;
    end if;
    let new-y-idx :: <integer> = pos.y-idx + y-offset;
    let new-x-idx :: <integer> = pos.x-idx + x-offset;
    if ( ( ( new-y-idx >= 0 ) & ( new-y-idx < $board-dim-y ) ) & 
         ( ( new-x-idx >= 0 ) & ( new-x-idx < $board-dim-x ) ) )
        make( <pos>, y-idx: new-y-idx, x-idx: new-x-idx );
    else
        #f
    end if;
end;

define method penguinPush( model :: <model> )
    => ( result :: <boolean> )
    let target-pos :: <pos-or-false> = 
        getAdjacentPos( model.penguin-pos, model.penguin-dir );
    let target-tile = getTileAtPos( model, target-pos );
    pushTile( model, model.penguin-dir, target-pos, target-tile );
end;

define method penguinMove( model :: <model>, dir :: <dir> )
    if ( model.penguin-dir ~= dir )
        model.penguin-dir := dir;
        format-out( "Penguin changed dir to %S\n", dir );
        force-output( *standard-output* );
    else
        if ( penguinPush( model ) )
            format-out ( "Penguin moved to %d, %d\n",
                model.penguin-pos.y-idx, model.penguin-pos.x-idx );
            force-output( *standard-output* );
        end if;
        if ( model.heart-count == 0 )
            format-out( "Heart count reached zero, level cleared!\n" );
            force-output( *standard-output* );
        end if;
    end if;
end;

define method penguinMoveTimes( model :: <model>, dir :: <dir>,
    times :: <integer> )
    for ( count from 1 to times )
        penguinMove( model, dir );
    end for;
end;

define method describe-tile( tile :: <tile> ) => ( str :: <string> )
    case
        ( tile == $the-empty     ) => "___ ";
        ( tile == $the-tree      ) => "tre ";
        ( tile == $the-mountain  ) => "mtn ";
        ( tile == $the-house     ) => "hou ";
        ( tile == $the-ice-block ) => "ice ";
        ( tile == $the-heart     ) => "hea ";
        ( tile == $the-bomb      ) => "bom ";
        otherwise                  => "??? ";
    end case;
end method;

define method describe-board( model :: <model> )
    for ( y-idx from 0 below $board-dim-y )
        for ( x-idx from 0 below $board-dim-x )
            format-out( "%S", 
                describe-tile( model.board[ y-idx, x-idx ]  ) );
        end for;
        format-out( "\n" );
    end for;
    force-output( *standard-output* );
end;

In Objective-C, I'm going to get rid of the singletons and tile classes altogether. They will live on in the comments, to clarify what the pseudo-object-dispatch is doing, and vestigially in the code. The board will have the same internal representation as the raw strings of data taken from the original Polar game resources. I'll keep my three main methods from the Dylan code -- pushing a tile, colliding, and sliding -- but these will be single Objective-C methods rather than multi-methods. The tiles are just chars:

#define POLAR_DATA_LEN_Y 4               // 4x24 grid
#define POLAR_DATA_LEN_X 24
#define POLAR_DATA_NUM_LEVELS 6          // In the original game

typedef char tile_t;

enum {
    polar_tile_empty = '0',
    polar_tile_tree,
    polar_tile_mountain,
    polar_tile_house,
    polar_tile_ice_block,
    polar_tile_heart,
    polar_tile_bomb,
    polar_tile_last = polar_tile_bomb
};

/*
    Not part of the level data; an extra flag value representing
    edge of board
*/
#define polar_tile_edge 'X'

typedef const char polar_level_array_t[POLAR_DATA_NUM_LEVELS]
                                      [POLAR_DATA_LEN_Y]
                                      [POLAR_DATA_LEN_X];

typedef char polar_board_array_t[POLAR_DATA_LEN_Y]
                                [POLAR_DATA_LEN_X];

extern polar_level_array_t polar_levels;

Why use #define for array indices and our tile pieces instead of const int and const char? Because using a const integral variable (yeah... a "const variable...") to dimension an array, or represent a case value for a switch statement, is still not standard C everywhere, although it is a common extension to allow the compiler to treat it as so in contexts like this. Enum works fine with characters. Oddly, I have a build issue when using enum values to define the array boundaries. I haven't figured out quite what that is all about -- I think it may be a Clang bug. But I'll worry about that later.

In the implementation file:

polar_level_array_t polar_levels =
{
    {
        "100000000000000100000400"
        "106020545000000000100100"
        "100000000000000050002300"
        "110000100000000000000000"
    },
    // Etc., for the other five levels
}

The model class gets one as a member:

@interface ArcticSlideModel : NSObject
{
    polar_level_array_t board;
    pos_t penguinPos;
    dir_e penguinDir;
    int heartCount;
}

We'll work ourselves down from the external API to the associated implementation:

// The external API
- (void)penguinMoveDue:(dir_e)dir;
- (void)penguinMoveNTimes:(int)n
                      due:(dir_e)dir;

penguinMoveNTimes:due: calls penguinMoveDue: which calls penguinPushDue:. In Dylan:

define method penguinPush( model :: <model> )
    => ( result :: <boolean> )
    let target-pos :: <pos-or-false> = 
        getAdjacentPos( model.penguin-pos, model.penguin-dir );
    let target-tile = getTileAtPos( model, target-pos );
    pushTile( model, model.penguin-dir, target-pos, target-tile );
end;

That's not strictly translatable to C, since we're taking advantage of a type-union to retrieve the position or #f with getAdjacentPos. This usage extends to the lower levels of the implementation, though, so for now we're going to continue to allow getAdjacentPos to return position values that are invalid, and explicitly check for them so we don't read or write at non-existent array indices.

pos_t getAdjacentPos( pos_t original_pos, dir_e dir )
{
    pos_t updated_pos = original_pos;
    int y_offset = 0;
    int x_offset = 0;
    switch ( dir )
    {
        case dir_east:
            x_offset = 1;
            break;
        case dir_south:
            y_offset = 1;
            break;
        case dir_west:
            x_offset = -1;
            break;
        case dir_north:
            y_offset = -1;
            break;
        default:
            NSLog( @"getAdjacentPos: invalid dir %d", dir );
    }
    updated_pos.y_idx += y_offset;
    updated_pos.x_idx += x_offset;;
    return updated_pos;
}

We rely on posValid to explicitly check for invalid tile cases:

BOOL posValid( pos_t pos )
{
    return ( ( ( pos.y_idx >= 0 ) &&
               ( pos.y_idx < POLAR_DATA_LEN_Y  ) ) &&
             ( ( pos.x_idx >= 0 ) &&
               ( pos.x_idx < POLAR_DATA_LEN_X ) ) );
}

That should be pretty non-controversial. Note that BOOL in Objective-C is not a real type; it's just a #define and a typedef based on char_t. So don't get a false sense of security -- it has the same problems that fake bool types always have, and always will have, in straight C.

Anyway, we can now implement our pushTile function. Here is the Dylan:

define generic pushTile( model :: <model>, dir :: <dir>,
    pos :: <pos-or-false>, target-tile :: <tile> );

// Handle walkable (empty or tree tile). The penguin
// is allowed to move onto this tile (indicated by
// returning #t).
define method pushTile( model :: <model>, dir :: <dir>,
    target-pos :: <pos>, target-tile :: <walkable> )
    => ( result :: <boolean> )
    model.penguin-pos := target-pos;
    #t;
end;

// Handle movable (bomb, heart, ice block) -- call
// collide which specializes in various combinations.
define method pushTile( model :: <model>, dir :: <dir>,
    target-pos :: <pos>, target-tile :: <movable> )
    => ( result :: <boolean> )
    let next-pos :: <pos-or-false>  = 
        getAdjacentPos( target-pos, dir );
    let next-tile = getTileAtPos ( model, next-pos );
    collide( model, dir, target-pos, target-tile,
        next-pos, next-tile );
    #f;
end;

// Handle fixed (house, mountain, edge) -- do nothing.
// The GUI might play a "fail" beep.
define method pushTile( model :: <model>, dir :: <dir>,
    target-pos :: <pos-or-false>, target-tile :: <fixed> )
    => ( result :: <boolean> )
    #f;
end;

Doing all our own dispatch logic, here is a single method in Objective-C:

- (BOOL)pushTile:(tile_t)target_tile
             due:(dir_e)dir
              at:(pos_t)target_pos
{
    switch ( target_tile )
    {
        /*
            Handle the "walkable" cases. The penguin is allowed to move
            onto these tiles, indicated by returning YES
        */
        case polar_tile_empty: /* FALL THROUGH */
        case polar_tile_tree:
            NSLog( @"pushTile: walkable\n" );
            self->penguinPos = target_pos;
            return YES;

        /*
            Handle "movable" cases. Call collide which specializes in
            various combinations.
        */
        case polar_tile_bomb:      /* FALL THROUGH */
        case polar_tile_heart:     /* FALL THROUGH */
        case polar_tile_ice_block:
            NSLog( @"pushTile: movable\n" );
            {
                pos_t next_pos = getAdjacentPos( target_pos, dir );
                /*
                    Note that next-pos can be invalid, which results
                    in the special "edge" tile value.
                */
                tile_t next_tile = [ self getTileAtPos:next_pos ];
                [ self collideTile:target_tile atPos:target_pos
                    due:dir withTile:next_tile
                    atSecondPos:next_pos ];
            }
            return NO;

        /*
            Handle "fixed" cases. Do nothing; the GUI might play
            a "fail" beep.
        */
        case polar_tile_mountain:   /* FALL THROUGH */
        case polar_tile_house:
            NSLog( @"pushTile: fixed\n" );
            return NO;

        default:
            NSLog( @"pushTile: unexpected tile value %d\n",
                   target_tile );
            return NO;
    }
}

And as in the Dylan version, for interesting interactions this method defers to another method:

- (void)collideTile:(tile_t)first_tile
              atPos:(pos_t)first_pos
                due:(dir_e)dir
           withTile:(tile_t)second_tile
        atSecondPos:(pos_t)second_pos
{
    BOOL empty = ( second_tile == polar_tile_empty );
    /* Blocking includes the special edge tile value */
    BOOL blocking = ( second_tile != polar_tile_empty );
    BOOL mountain = ( second_tile == polar_tile_mountain );
    BOOL house = ( second_tile == polar_tile_house );

    BOOL ice_block = ( first_tile == polar_tile_ice_block );
    BOOL bomb = ( first_tile == polar_tile_bomb );
    BOOL heart = ( first_tile == polar_tile_heart );
    BOOL movable = ( ice_block || bomb || heart );

    if ( bomb && mountain )
    {
        /*
            When a bomb meets a mountain, both bomb and mountain blow up
        */
        NSLog( @"collideTile: bomb / mountain\n" );
        [ self setTile:polar_tile_empty AtPos:first_pos ];
        [ self setTile:polar_tile_empty AtPos:second_pos ];
    }
    else if ( heart && house )
    {
        /*
            When a bomb heart meets a house, we are closer to winning
        */
        NSLog( @"collideTile: heart / house\n" );
        [ self setTile:polar_tile_empty AtPos:first_pos ];
        [ self decrementHeartCount ];
    }
    else if ( ice_block && blocking )
    {
        /*
            When an ice block is pushed directly against any
            blocking tile (including the board edge), it is destroyed.
        */
        NSLog( @"collideTile: ice block / blocking\n" );
        [ self setTile:polar_tile_empty AtPos:first_pos ];
    }
    else if ( movable )
    {
        if ( empty )
        {
            /*
                A movable tile pushed onto an empty tile will slide
            */
            NSLog( @"collideTile: movable / empty: start slide\n" );
            [ self slideTile:first_tile atPos:first_pos due:dir
                   toTile:second_tile atSecondPos:second_pos ];
        }
        else if ( blocking )
        {
            /*
                When a generic movable piece meets any other
                blocking pieces not handled by a special case
                above, nothig happens; it stops. Maybe play
                a "fail" beep.
            */
            NSLog( @"collideTile: movable / blocking\n" );
        }
    }
}

This could have been written with a bunch of ugly, redundant-looking switch statements, but the duplicated cases and defaults just don't seem as clear to me as making flags that precisely describe the nature of the "double dispatch" going on. In this program, having to spell out the logic (using code to find code) is not really onerous. But the problem comes, of course, in code where we keep having to add special cases. I could refactor this method to call some smaller methods but that doesn't seem like a real win. In the Dylan implementation if I wanted to add another special interaction, it might only require adding another generic function. That's assuming my whole class hierarchy didn't change.

Finally, the slide method:

- (void)slideTile:(tile_t)first_tile
            atPos:(pos_t)first_pos
              due:(dir_e)dir
           toTile:(tile_t)second_tile
      atSecondPos:(pos_t)second_pos
{
    BOOL empty = ( second_tile == polar_tile_empty );
    /* Blocking includes the special edge tile value */
    BOOL blocking = ( second_tile != polar_tile_empty );
    
    BOOL ice_block = ( first_tile == polar_tile_ice_block );
    BOOL movable = ( ice_block ||
                     first_tile == polar_tile_bomb ||
                     first_tile == polar_tile_heart );

    if ( ice_block && blocking )
    {
        // A specific movable tile, ice-block, meets a
        // blocking tile; don't call collide since the behavior
        // of a sliding ice block is different than a pushed ice
        // block. It just stops and doesn't break.
        NSLog( @"slideTile: ice block / blocking\n" );       
    }
    else if ( movable && empty )
    {
        // A movable tile interacting with an empty tile --
        // move forward on the board and call slide again.
        NSLog( @"slideTile: movable / empty\n" );
        pos_t third_pos = getAdjacentPos( second_pos, dir );
        tile_t third_tile = [ self getTileAtPos:third_pos ];
        [ self setTile:polar_tile_empty AtPos:first_pos ];
        [ self setTile:first_tile AtPos:second_pos ];
        [ self slideTile:first_tile atPos:second_pos due:dir
                  toTile:third_tile atSecondPos:third_pos ];
    }
    else if ( movable && blocking )
    {
        // A movable tile meets a blocking tile: call collide to
        // handle heart/house, bomb/mountain, edge of world, etc.
        NSLog( @"slideTile: movable / blocking\n" );
        [ self collideTile:first_tile atPos:first_pos due:dir
                  withTile:second_tile atSecondPos:second_pos ];
    }
}

That's the bulk of it. Here's an excerpt from the log as it finishes up the first level:

ArcticSlide[2279:c07] penguinPush: tile at 2, 5 pushed
ArcticSlide[2279:c07] pushTile: walkable
ArcticSlide[2279:c07] Penguin moved to: 2, 5
ArcticSlide[2279:c07] Penguin direction changed to EAST
ArcticSlide[2279:c07] Penguin moving EAST
ArcticSlide[2279:c07] penguinPush: tile at 2, 6 pushed
ArcticSlide[2279:c07] pushTile: movable
ArcticSlide[2279:c07] collideTile: movable / empty: start slide
ArcticSlide[2279:c07] slideTile: movable / empty
ArcticSlide[2279:c07] collideTile: heart / house
ArcticSlide[2279:c07] Heart count reached zero, level cleared!
ArcticSlide[2279:c07] ArcticSlideModel board state:
tre__________________________________________treice_____________________
tre_________mtn_______________________________________tre______tre______
tre____________________________________________________________hou______
tretre____________treice________________________________________________

I'll put in logic to play the remaining levels soon, as additional test cases.

Note that I kept the recursive call to slideTile. It's not an idiom commonly used in C and Objective-C. We only recurse when the moving tile traverses more than one empty tile, and so never more than 23 times. I like to write algorithms recursively when possible while sketching out code. If direct recursion like that is verboten, it can be removed. I don't think my compiler is optimizing it out. But the termination logic now starts to look redundant:

else if ( movable && empty )
    {
        while ( NO == blocking )
        {
            pos_t third_pos = getAdjacentPos( second_pos, dir );
            tile_t third_tile = [ self getTileAtPos:third_pos ];
            [ self setTile:polar_tile_empty AtPos:first_pos ];
            [ self setTile:first_tile AtPos:second_pos ];
            first_pos = second_pos;
            second_pos = third_pos;
            second_tile = third_tile;
            blocking = ( third_tile != polar_tile_empty );
        }
        if ( ice_block )
        {
            NSLog( @"slideTile: ice block / blocking\n" );
        }
        else
        {
            [ self collideTile:first_tile atPos:first_pos due:dir
                      withTile:second_tile atSecondPos:second_pos ];
        }
    }

And if I don't want to call back into methods in my own call chain at all -- that is, if I have to give up calling collideTile, well, I could do that but it would involve putting copying of the logic from collideTile into this method, and by that point this method will be badly breaking the "DRY" (Don't Repeat Yourself) axiom, so it might be clearer to turn collideTile and slideTile into one method.

Anyway, the heat is building up in my office and it is about dinnertime. I think it's time to move on to some user interface, so the app can actually be played on an untethered iOS device. I also am still struggling a bit to get going on a Haskell implementation. I know it can be done -- people describe Haskell as a good imperative language too, for modeling state as safely as possible -- but let's just say that the chapters and examples I'm reading haven't quite "gelled" in my brain. I still feel like someone studying a foreign language who can read it and understand it when spoken, but not speak it yet -- especially the Monadic dialects. But I'm still working on that.

UPDATE: I have put the source on GitHub, such as it is -- for now, ignore the license text; I need to pick an actual license. See: https://github.com/paulrpotts/arctic-slide-ios

20 June 2013

Dispatch for the Polar Game in Dylan

So with some assistance from the folks on the Dylan Hackers mailing list I got enough clues to press on and get my Dylan implementation of the Polar game working, at least up through the end of the first board. I haven't verified that every possible tile interaction works yet, but it's a start. This seems like a silly problem, but it interests me because of several problems. Dispatch (or simulated dispatch) is "double dispatch," based on the types of two different objects interacting. The breakdown of how to categorize the classes of objects isn't 100% clear -- there is some overlap that I can't seem to eliminate, and the compiler has to decide what methods constitute the most specific match. And finally, the logic does not seem easily fixed in either classes representing the tiles, or a single class representing the board.

If I wrote it in C, the tile classes pretty much wouldn't exist; they'd exist only as flag enumerations in an array of tiles, and the code would consist mostly of switch or if-else logic that did the "double dispatch" in a fixed, predictable order, without relying on the compiler very much. Objective-C, again mostly C with a thin layer for representing classes, doesn't really give these classes enough features to make them worthwhile, so I will probably just keep the board (the model in the model/view/controller) and treat the tiles like I would in plain old C. But in Dylan they have an interesting life in terms of how they can be used to organize the code -- using generic functions -- so that I'm doing less writing of "code to find code" -- that is, code to look at run-time identity of objects and "manually" dispatch on it.

Here are the tile classes:

define abstract class <tile> ( <object> ) end;
define abstract class <blocking> ( <tile> ) end;
define abstract class <walkable> ( <tile> ) end;
define abstract class <movable> ( <blocking> ) end;
define abstract class <fixed> ( <blocking> ) end;
define class <bomb> ( <movable> ) end;
define class <heart> ( <movable> ) end;
define class <ice-block> ( <movable> ) end;
define class <house> ( <fixed> ) end;
define class <mountain> ( <fixed> ) end;
define class <edge> ( <fixed> ) end;
define class <tree> ( <blocking>, <walkable> ) end;
define class <empty> ( <walkable> ) end;

Oy, is that a pain to replace all the angle brackets with HTML entities... there must be a better way in Blogger! Anyway, these tile classes have no state -- in Dylan, no slots -- and are used in my program solely for their types. Edge does not actually appear on the board, but is used internally when the penguin or another moving object attempts to interact with the edge of the board. We treat this just like another blocking object, as if the board was surrounded by immovable, inert objects.

Diagramatically, like so:

There did not seem to be one absolute best way to represent these classes. I want to organize their abstract base classes by behavior, but their behavior does not break down with complete consistency -- for example, tiles with trees are "blocking" with respect to sliding objects, except for the penguin. The ice block is "blocking" except for the case where the penguin pushes it and it is not adjacent to an empty tile -- then it is crushed. Bombs and hearts seem to have the same interactions with mountains and houses whether they traverse an empty tile by sliding first across one or more empty tiles, while ice blocks behave differently -- if they slide first and then collide with a blocking object, they are not destroyed, they just stop. So the groupings of the concrete classes isn't going to be able to coherently divide up all their possible behaviors.

The scheme I settled on for object interactions involves three layers, in the form of three generic functions. The first represents interactions of the player's "avatar," the penguin, with tiles:

define generic pushTile( model :: <model>, dir :: <dir>,
    pos :: <pos-or-false>, target-tile :: <tile> );

define method pushTile( model :: <model>, dir :: <dir>,
    target-pos :: <pos>, target-tile :: <walkable> )
    => ( result :: <boolean> )
    model.penguin-pos := target-pos;
    #t;
end;

define method pushTile( model :: <model>, dir :: <dir>,
    target-pos :: <pos>, target-tile :: <movable> )
    => ( result :: <boolean> )
    let next-pos :: <pos-or-false>  = 
        getAdjacentPos( target-pos, dir );
    let next-tile = getTileAtPos ( model, next-pos );
    collide( model, dir, target-pos, target-tile,
        next-pos, next-tile );
    #f;
end;

define method pushTile( model :: <model>, dir :: <dir>,
    target-pos :: <pos-or-false>, target-tile :: <fixed> )
    => ( result :: <boolean> )
    #f;
end;

Dylan doesn't strictly require that I define the generic function before defining methods for it; if I just start writing methods with the same name, it will assume that I mean them to be associated with a generic function. But defining the generic function first has a benefit -- the compiler will tell me whether my methods make sense, in that their parameters are all strictly the same type or a more specific subclass of the types mentioned in the define generic statement. Note that <pos-or-false> is a type union of a simple <pos> class with singleton( #f ). The generic uses that type union, but one of the methods are more specific: they require an actual <pos> instance and will not accept #f.

The first method handles the case where the penguin is pushing a <walkable> tile, and returns false to indicate that the penguin position can be updated. The pos must not be #f. The second method handles pushing any <movable> tiles. And the third handles the <fixed> tiles. Between the three methods, you might notice that they cover all the leaf classes (all the instantiable classes) in the graph above, in 3 separate groups with no overlapping. You could shade in the leaf nodes covered by the three different methods with three different colors, going from the abstract classes mentioned downward, and all the leaves would all be colored and none would be colored more than once:

So on the tile parameter, the coverage of the concrete classes is complete and the dispatch algorithm should not have any difficulty. Combined with the position parameter, though, the situation is slightly trickier. At runtime, a caller could call pushTile with #f for pos and <empty>; or <bomb> for tile and the dispatcher would, correctly, throw up its hands at this point and say that there was no applicable method. I could have defined a more general method to handle this case, but I didn't -- there shouldn't ever be an empty or bomb tile without a corresponding valid position, since they are real tiles on the board, and I want the runtime to help me catch that case if it ever happens. Similarly, I could have defined a method that handled <blocking> or <tile> as part of this generic function but the whole point is that I don't know what to do with those more general classes here.

So, you may notice that the middle pushTile method calls collide with a second tile and position, adjacent to the first in a specified direction. That generic function looks like this:

define generic collide( model :: <model>, dir :: <dir>,
    tile-1-pos :: <pos>, tile-1 :: <movable>,
    tile-2-pos :: <pos-or-false>, tile-2 :: <blocking-or-empty> );

define method collide( model :: <model>, dir :: <dir>,
    movable-pos :: <pos>, movable-tile :: <movable>,
    next-pos :: <pos>, next-tile :: <empty> )
    slide ( model, dir, movable-pos, movable-tile,
            next-pos, next-tile );
end;

define method collide( model :: <model>, dir :: <dir>,
    ice-block-pos :: <pos>, ice-block-tile :: <ice-block>,
    icebreaking-pos :: <pos-or-false>,
    ice-breaking-tile :: <blocking> )
    setTileAtPos( model, ice-block-pos, $the-empty );
end;

define method collide( model :: <model>, dir :: <dir>,
    heart-pos :: <pos>, heart-tile :: <heart>,
    house-pos :: <pos>, house-tile :: <house> )
    setTileAtPos( model, heart-pos, $the-empty );
    decrementHeartCount( model );
end;

define method collide( model :: <model>, dir :: <dir>,
    bomb-pos :: <pos>, bomb-tile :: <bomb>,
    mountain-pos :: <pos>, mountain-tile :: <mountain> )
    setTileAtPos( model, bomb-pos, $the-empty );
    setTileAtPos( model, mountain-pos, $the-empty );
end;

define method collide( model :: <model>, dir :: <dir>,
    movable-pos :: <pos>, movable-tile :: <movable>,
    blocking-pos :: <pos-or-false>, blocking-tile :: <blocking> )
end;

You might notice that before long you hit yet another method call you haven't seen before -- slide. This is, as you might guess, yet another generic function. (Doesn't this program every get around to doing anything? In fact it does, but this is the often-paradoxical-seeming logic of object-oriented design -- individual methods that seem too small and simple to get anything done can actually get a lot done together, especially when aided by a smart dispatcher that eliminates most of the need to write "code to find code."

The type-union <blocking-or-empty> allows us to specify, for our generic function, as tight a class as possible out of two otherwise disjoint sections of our class diagram. We don't have to loosen the type specification needlessly by using <tile>, which would allow <walkable> as a valid class for this parameter. Meanwhile, we can loosen tile-2-pos so that we make our intention to allow #f explicit here.

The methods break down as follows. The first one handles any movable tile that is moving onto an empty tile, by calling a slide method to be defined later. The second one is a special case to handle the crushable <ice-block> class -- if it is pushed into the world edge, or any other object, it is destroyed (replaced with $the-empty class instance). The third and fourth methods handle specific interactions between hearts and houses, and bombs and mountains. And finally, to handle the case where the penguin pushes a heart against a mountain, or a bomb against the edge of the world, we have a less specific method that dispatches on <movable> and <blocking>. This prevents the runtime from generating an error in this case, but also gives us a place where we could generate some kind of feedback to the user, like a special sound to indicate failure.

The breakdown of instantiable tile classes here is much more complex, especially given that we are dispatching on two class parameters drawn from the same hierarchy. We could try coloring them by using two copies of the diagram:

Err, that's pretty, but is it helpful? I'm using colors and borders to indicate that classes are handled by specific methods, but the main thing I hope I'm illustrating is that, unlike with the first generic function, in this one there is significant overlap between the classes handled by the different methods. This is where the dispatch mechanism really has to shine. There is an ordering that makes sense from my point of view, and that is one in which the most specific matching method will be called. However, as you can see, quantifying "most specific" may be slightly complex when dispatching on more than one class parameter, throwing in type-unions for fun. Fortunately this code is now working, but while I was developing it I became familiar with a warning message in Open Dylan that says something like "the method dispatch handling this set of classes is determined by arbitrary and capricious rules" -- indicating that the dispatch logic is still considered a work in progress. I was concerned that the current version of the Open Dylan compiler wasn't quite solid enough to make this work, but it does seem to work. The backup plan was to dispatch entirely on type-unions made up of different sets of singletons, but that is longer and obscures what is meant by the abstract classes.

I won't go to the trouble to do the same diagram on my slide method, but that code looks like this:

define generic slide( model :: <model>, dir :: <dir>,
    movable-pos :: <pos>, movable-tile :: <movable>,
    next-pos :: <pos-or-false>, next-tile :: <blocking-or-empty> );

define method slide( model :: <model>, dir :: <dir>,
    movable-pos :: <pos>, movable-tile :: <movable>,
    next-pos :: <pos>, next-tile :: <empty> )
    let next-next-pos :: <pos-or-false> =
        getAdjacentPos( next-pos, dir );
    let next-next-tile = getTileAtPos( model, next-next-pos );
    setTileAtPos( model, next-pos, movable-tile );
    setTileAtPos( model, movable-pos, $the-empty );
    slide( model, dir, next-pos, movable-tile ),
           next-next-pos, next-next-tile );
end;

define method slide( model :: <model>, dir :: <dir>,
    movable-pos :: <pos>, movable-tile :: <movable>,
    next-pos :: <pos-or-false>, next-tile :: <blocking> )
    collide( model, dir, movable-pos, movable-tile,
              next-pos, next-tile );
end;

define method slide( model :: <model>, dir :: <dir>,
    ice-block-pos :: <pos>, ice-block-tile :: <ice-block>,
    next-pos :: <pos-or-false>, next-tile :: <blocking> )
end;

Aaaand that's pretty much the whole of the logic for handling interaction between the penguin and the various tiles. Note that we call ourselves recursively. It looks kind of like we have no termination condition! Except note that the method isn't calling itself, it's doing the same method dispatch that found it in the first place. When we come to a termination condition for our recursions, we'll actually call a different method of the same generic function -- most likely the third one, where a sliding object encounters a blocking object. That condition can include hitting the edge of the board. And fortunately -- we already have logic for that, mostly -- in our collide generic function! So sliding hearts and bombs are handled just the same as if they were pushed instead of ending a slide.

There's a slightly tricky part where we want to bind up the next tile beyond the two tiles we were dispatched on, then perform two set operations to move the currently sliding tile, then dispatch on the starting tile at its moved position. To figure that out I had to draw some bits of the game board with circles and arrows (but not a paragraph on the back of each one to be used as evidence against me). (If you don't get that reference, either you're too young or I'm too old!)

This is not the whole program, obviously, but these are the key methods for encoding the collisions between tiles. If you'd like to play with the whole program, you might come and join the Dylan Hackers mailing list, or leave me a note. If there is interest I'll publish it, here or elsewhere. I am now curious as to how a similar set of overlapping dispatches -- via pattern matching, perhaps? -- might look in Haskell. I might try to write that next. If you've got an idea about the clearest and most idiomatic way to do it, I welcome your comments.

UPDATE: the code, such as it is, is on GitHub. Ignore the license for now; I have to decide on an actual license. See: https://github.com/paulrpotts/arctic-slide-dylan

16 June 2013

Objective-Dylan, or Perhaps Subjective-C?

Yesterday my wife took the kids with her on an overnight trip to Ann Arbor so I've had a bit of extra quiet time. How am I making use of this bounty? Getting on with some minor home repairs? Cleaning my office from top to bottom? Er, no... porting the game logic I've written so far in Objective-C back to Dylan, so that I can do some more thinking about it.

So after a phone job interview yesterday (which went well, I thought -- I'm optimistic about this possibility!) I started working on this task, and then about twelve hours later, around 2 a.m., I had the basic setup and population of the game board working. It's embarrassing to admit how long it took. I started on my Mac, and when I began encountering constant runtime errors switched over to my Ubuntu box, thinking that the Mac version of Open Dylan might just be broken (it isn't; I got the identical behavior on the Linux build). I finally figured out workarounds -- it's funny how taking a break clears my head far better than pressing on ever does -- then read a little Gene Wolfe (I'm working my way through In Green's Jungles, one of his books I've repeatedly tried and failed to finish), and fell asleep with no children in the bed to kick or otherwise interfere with a good night's sleep. I'm back up this morning, had a bath, and I'm drinking a large coffee with soy creamer and stevia and trying to hold off on a lunch break until I have some more done. It's about 10 a.m. and I'm expecting my family back in about six hours, so the race is on!

This has taken far longer than I hoped; I lost quite a bit of time stumbling across things in Open Dylan that still seem just plain broken. I had to start working on a smaller and smaller program to figure out exactly what was broken. These things I've flagged in comments, as places where, basically, I wish Dylan worked a certain way, and it doesn't. I may just be asking for something that doesn't quite match the original spec or isn't quite possible, but I'll share those with the Dylan Hackers team and see if it seems like I can help with them. The biggest thing that was broken, though, was me -- my brain, that is -- since it's been a long time since I've worked with Dylan's type-union and singleton pseudo-classes and I had forgotten the details. The compiler was not a big help with this, since it is such a dynamic language and leaves an awful lot of things to the runtime to figure out, which it does by throwing an error message that may or may not help much. The documentation is a bit scanty, but it does contain everything you need to know, if you re-read and squint at the scanty examples that are out there hard enough.

The good news is that the port is working and I'd like to share it. Dylan is still up there with Scheme (and now Haskell) as one of my favorite languages for designing programs -- yes, even though Dylan is quite old as languages go. I like to see what it can do especially with generic functions and its sophisticated model for object-oriented dispatch. I've been a little stymied as to how to express the design best in Objective-C. If it was a complicated game design, I wouldn't feel bad about having a program that looked complex. But it's really an elegantly simple game, and so I feel like the implementation should reflect that. My Objective-C implementation has been feeling more and more bloated and pointlessly complex, although it works, so my thought was to get it down to a simple implementation that takes full advantage of Dylan's object-oriented programming features, largely borrowed from CLOS, and then port that back to Objective-C, adding whatever minimalist support is needed to fake up some of the features that Dylan gives me that Objective-C doesn't have. This might be by way of also writing a Haskell or Scala implementation later, for yet more learning and language comparison, although really what I should focus on is getting the iOS GUI up and working so that I have something to show people.

Anyway, I've got a Dylan program that plays the Polar game, using singletons to represent tile types, and methods dispatched on singletons to handle specific kinds of collisions. The classes -- which are empty, pretty much used only for their usefulness as types, for driving dispatch -- are like so:

In Dylan you can create some instances, and create something called a type-union, which is something that is a type, I think, but not a class. You can use it to define a slot type or a parameter type. But you can't make one:

define constant $the-bomb = make();
define constant $the-empty = make();
define constant $the-heart = make();
define constant $the-house = make();
define constant $the-ice-block = make();
define constant $the-mountain = make();
define constant $the-tree = make();

define constant  = type-union(
    singleton( $the-bomb ), singleton( $the-empty ),
    singleton( $the-heart ), singleton( $the-house ),
    singleton( $the-ice-block ), singleton( $the-mountain ),
    singleton( $the-tree ), singleton( #f ) );

And eventually dispatch on singletons -- meaning that a given method will be called with it is called with references to the exact objects that you specify:

define method collide( model :: <model>, dir :: <dir>,
    heart-pos :: <pos>, heart-tile == $the-heart,
    house-pos :: <pos>, house-tile == $the-house )
    format-out( "collide: $the-heart / $the-house\n" );
    setTileAtPos( model, heart-pos, $the-empty );
    model.decrementHeartCount();
end;

That gives you an idea of how some of the code in the Dylan program is organized. I have it mostly working, however, I'm not going to present the full code quite yet because I have a crashing bug, and I haven't yet been able to figure out if it is a dumb mistake on my part or a compiler or runtime bug in Open Dylan. I've also asked the Dylan hackers to take a look at my design and see what they think -- if they can find, as I put it, "a simpler design struggling to get out." Which is always the challenge, when trying to write not just functional, but model code, isn't it?

07 June 2013

Objective-C, Day 5

(Warning: non-FP content). (I've been including this for the benefit of any "Planet X" aggregators who are including my feed, where X is a functional language like Haskell. I'm assuming you've got that by now and either don't care or are unsubscribing/ignoring this series if it bothers you. I expect to get back to more functional language code at some point, maybe even implementing the same problem. But I dabble in different languages and sometimes the digressions go on for a while...)

So, today's topic is dispatch. I'm starting to design and implement the logic for pieces interacting on the board. The key in object-oriented designs is always to determine who (which object) manages which state. The design I've come up with is a sort of hybrid design, where position on the board is not actually a property of the board tiles. Instead, there's a board which keeps track of them. The instances of, say, a tree on the board don't have any unique state, so I'm not instantiating different objects for each one; they all point to a singleton (which I should properly enforce with a singleton factory method at some point).

There are trade-offs. On paper, my design involved adding a "push" method to the classes for tile pieces. In a language like Dylan, this "push" method would be a generic function, and dispatch on multiple parameter types, so that I could write some very short methods and use the method dispatcher, instead of explicit if-then or switch logic to find the right bit of code at run-time according to the types of the interacting objects (either their literal types or an enum, or some such). I could even do this in C++ because it has method overloading based on the parameters -- as long as this is based on their static type known at compile-time. Which... isn't true in this case. I miss Dylan's generic function dispatch! Objective-C is a underpowered in this respect even compared to C++. For example, I'd like to be able to write methods like this for the bomb class (this is pseudocode):

bomb::push(mountain)
{
    // blow up the mountain
}

bomb::push(empty)
{
    // slide the bomb onto the tile
}

But I can't. I can't just use the class construct to organize methods to call without an instance -- there doesn't seem to be the equivalent of C++ static methods. There also is no equivalent of a pure virtual function; I can't declare the need for a push() method in the common base class of the tile pieces and have the compiler demand that I implement in any subclasses to make them instantiable. The closest I can come, I think, is to create a method that generates an error if it itself is called instead of being overridden in a subclass. That seems to lack semantic clarity. So maybe I could do this, with double dispatch, but it doesn't seem worth the trouble for a small number of collision behaviors, when the behavior isn't simply supported by the language. I keep telling myself "thin layer on top of C... thin layer on top of C..."

So last night I had my Mac running upstairs in the office, and I used my iPad downstairs to connect to it via VNC, and write some code, running it on the iPad simulator, which I then viewed and controlled with a real iPad (mad scientist laugh). It needs a little tweaking this morning but here's more-or-less what I came up with. Note that I have started using some different naming conventions for file-scope and local variables. I'm not sure they are very standard Objective-C but they are closer to what I've grown comfortable with over the years in C and C++.

typedef struct {
    int x_idx;
    int y_idx;
} pos_t;

typedef enum {
    dir_east,
    dir_west,
    dir_south,
    dir_north
} dir_e;

// A straight C function to return a pos_t updated with a dir_e;
// the result may be out of bounds
pos_t getUpdatedPos( pos_t original_pos, dir_e dir );
BOOL posValid( pos_t pos );

static const int board_width = 24, board_height = 4;
// The short board design is part of what makes it so
// easy to get sliding objects stuck against the edges
// of the world or in corners where you can't get the
// penguin avatar around to the other side to push them.
// We could consider a bigger board later and maybe
// implement the original puzzles surrounded by water,
// or something like that.

// Equivalent of C++ class forward declaration
@class ArcticSlideTile;
@class ArcticSlideBomb;
@class ArcticSlideEmpty;
@class ArcticSlideHeart;
@class ArcticSlideHouse;
@class ArcticSlideIceBlock;
@class ArcticSlideMountain;
@class ArcticSlideTree;

@interface ArcticSlideModel : NSObject
{
    ArcticSlideTile* board[board_height][board_width];
}

- (id)init;
- (id)initWithLevelIndex:(int)level_idx;
- (NSString*) description;
- (ArcticSlideTile*)getTileFromPosition:(pos_t)pos
                            inDirection:(dir_e)dir;
- (void)setTileAtPosition:(pos_t)pos
                       to:(ArcticSlideTile*)type;

@end

@interface ArcticSlideTile : NSObject

- (BOOL)pushFromPosition:(pos_t)pos inDirection:(dir_e)dir;

@end


@interface ArcticSlideBomb : ArcticSlideTile
// Bombs can be pushed and will slide until they hit an
// object and stop. If the object is a mountain, both bomb
// and mountain are destroyed. If another object hits a bomb
// it stops (I think -- I'm not sure it is possible to set 
// up a board such that you can slide something into a bomb).

// push is called when the penguin pushes against a tile.
// It returns YES if the penguin can move onto the tile with
// this action. This is only ever the case for a tree or empty
// tile.
- (BOOL)pushFromPosition:(pos_t)pos inDirection:(dir_e)dir;
- (NSString*) description;
@end

@interface ArcticSlideEmpty : ArcticSlideTile
// The penguin can always step onto an empty tile
- (BOOL)pushFromPosition:(pos_t)pos inDirection:(dir_e)dir;
- (BOOL)slideFromPosition:(pos_t)pos inDirection:(dir_e)dir;
- (NSString*) description;
@end

@interface ArcticSlideHeart : ArcticSlideTile
// When a heart hits a house the heart disappears (getting
// all the hearts into the house is how you win the game).
// Otherwise they cannot be destroyed, and slide like other
// slidable items.
- (BOOL)pushFromPosition:(pos_t)pos inDirection:(dir_e)dir;
- (NSString*) description;
@end

@interface ArcticSlideHouse : ArcticSlideTile
// Houses cannot be pushed and stop other objects except
// hearts. When a heart hits a house the heart disappears
// (getting the hearts into the house is how you win the game).
// So the model should keep track of the number of hearts
// on the board and trigger a "win the level" behavior when
// the last heart is removed.
- (BOOL)pushFromPosition:(pos_t)pos inDirection:(dir_e)dir;
- (NSString*) description;
@end

@interface ArcticSlideIceBlock : ArcticSlideTile
// Ice blocks can be pushed and will slide until they hit
// an object and stop. If they are pushed directly against
// an object they will be crushed (there should be an animation)
// and disappear.
- (BOOL)pushFromPosition:(pos_t)pos inDirection:(dir_e)dir;
- (NSString*) description;
@end

@interface ArcticSlideMountain : ArcticSlideTile
// Mountains cannot be moved and are destroyed by bombs.
- (BOOL)pushFromPosition:(pos_t)pos inDirection:(dir_e)dir;
- (NSString*) description;
@end

@interface ArcticSlideTree : ArcticSlideTile
// Trees cannot be pushed or destroyed and stop all sliding
// objects, but the penguin avatar character can walk through
// them.
- (BOOL)pushFromPosition:(pos_t)pos inDirection:(dir_e)dir;
- (NSString*) description;
@end

Here's part of the implementation. It seems way too wordy; I need to rethink the amount of code required for each step. At the least, some refactoring seems to be in order. As I mentioned earlier, I'm not sure the tile classes are really earning their keep. I got rid of the singleton instantiation machinery but now there are order of initialization dependencies. I'll need to do further thinking as I consider what communication needs to happen between the "model" part and "controller" part -- how to interact with the GUI, how to indicate that tiles need to be redrawn, or animated transitions should play, or sound effects should play, or that the score is changed, and what to do when a level is completed. There is lots more to think about for such a simple little game! And of course I haven't really even begun to implement the "view" parts.

static ArcticSlideEmpty* empty_p;
static ArcticSlideTree* tree_p;
static ArcticSlideMountain* mountain_p;
static ArcticSlideHouse* house_p;
static ArcticSlideIceBlock* ice_block_p;
static ArcticSlideHeart* heart_p;
static ArcticSlideBomb* bomb_p;

static ArcticSlideModel* model_p;

pos_t getUpdatedPos( pos_t original_pos, dir_e dir )
{
    pos_t updated_pos = original_pos;
    int x_offset = 0;
    int y_offset = 0;
    if ( dir_east == dir )
    {
        x_offset = 1;
        y_offset = 0;
    }
    else if ( dir_west == dir )
    {
        x_offset = -1;
        y_offset = 0;
    }
    else if ( dir_north == dir )
    {
        x_offset = 0;
        y_offset = -1;
    }
    else if ( dir_south == dir )
    {
        x_offset = 0;
        y_offset = +1;
    }
    updated_pos.x_idx += x_offset;;
    updated_pos.y_idx += y_offset;
    return updated_pos;
}

BOOL posValid( pos_t pos )
{
    return ( ( ( pos.x_idx >= 0 ) ||
               ( pos.x_idx < board_width  ) ) ||
             ( ( pos.y_idx >= 0 ) ||
               ( pos.y_idx < board_height ) ) );
}

@implementation ArcticSlideTile

- (BOOL)pushFromPosition:(pos_t)pos inDirection:(dir_e)dir
{
    // Should be implemented in subclass
    return NO;
}

@end

@implementation ArcticSlideBomb

- (BOOL)pushFromPosition:(pos_t)pos inDirection:(dir_e)dir
{
    // Penguin has pushed bomb in the given direction.
    // Get our own position:
    pos_t bomb_pos = getUpdatedPos( pos, dir );
    // What are we being pushed into?
    ArcticSlideTile *target_tile_p =
    [model_p getTileFromPosition:bomb_pos
                     inDirection:dir];
    
    if ( nil == target_tile_p )
    {
        // Edge of the world. TODO:
        // queue a "boop" sound effect
    }
    else if ( mountain_p == target_tile_p )
    {
        // bomb pushed into mountain
        // TODO: queue animation of bomb moving onto
        // mountain, animate explosion
        // remove bomb and mountain
        pos_t new_bomb_pos = getUpdatedPos( bomb_pos, dir );
        [model_p setTileAtPosition:new_bomb_pos
                                to:empty_p];
        new_bomb_pos = getUpdatedPos( new_bomb_pos, dir );
        [model_p setTileAtPosition:new_bomb_pos
                                to:empty_p];
    }
    else if ( empty_p == target_tile_p )
    {
        // TODO: queue bomb moving into space
        pos_t new_bomb_pos = getUpdatedPos( bomb_pos, dir );
        // Set bomb at new position
        [model_p setTileAtPosition:new_bomb_pos
                                to:bomb_p];
        // Remove bomb from old position
        [model_p setTileAtPosition:bomb_pos
                                to:empty_p];

        // Bombs will continue to slide until stopped
        ArcticSlideTile *target_tile_p =
        [model_p getTileFromPosition:new_bomb_pos
                         inDirection:dir];

        while ( empty_p == target_tile_p )
        {
            // TODO: animate bomb moving into space
            pos_t new_bomb_pos = getUpdatedPos( bomb_pos, dir );
            // set bomb at new position
            [model_p setTileAtPosition:new_bomb_pos
                                    to:bomb_p];
            // remove bomb from old position
            [model_p setTileAtPosition:bomb_pos
                                    to:empty_p];
        }

        if ( mountain_p == target_tile_p )
        {
            // bomb pushed into mountain
            // TODO: queue animation of bomb moving
            // onto mountain, animate explosion
            // remove bomb and mountain
            [model_p setTileAtPosition:new_bomb_pos
                                    to:empty_p];
            new_bomb_pos = getUpdatedPos( new_bomb_pos, dir );
            [model_p setTileAtPosition:new_bomb_pos
                                    to:empty_p];
        }
    }
    // The penguin cannot actually move in this turn
    return NO;
}

- (NSString*) description
{
    return @"Bomb  ";
}

@end

@implementation ArcticSlideEmpty
- (BOOL)pushFromPosition:(pos_t)pos inDirection:(dir_e)dir
{
    // If the penguin pushes onto an empty tile, he can always
    // move there
    return YES;
}

- (NSString*) description
{
    return @"      ";
}
@end

I'm leaving out unfinished tile classes for clarity, but here is the model implementation:

@implementation ArcticSlideModel

- (id)init
{
    // Initialize the global tile objects. I messed around
    // with singleton factory methods for creating a single
    // instance of each of these and accessing it everywhere
    // but the resulting code was too wordy to justify this.

    empty_p = [[ArcticSlideEmpty alloc] init];
    tree_p = [[ArcticSlideTree alloc] init];
    mountain_p = [[ArcticSlideMountain alloc] init];
    house_p = [[ArcticSlideHouse alloc] init];
    ice_block_p = [[ArcticSlideIceBlock alloc] init];
    heart_p = [[ArcticSlideHeart alloc] init];
    bomb_p = [[ArcticSlideBomb alloc] init];

    self = [super init];

    for ( unsigned int idx_y = 0;
         idx_y < board_height; idx_y++ )
    {
        for ( unsigned int idx_x = 0;
             idx_x < board_width; idx_x++ )
        {
            board[idx_y][idx_x] = empty_p;
        }
    }

    return self;
}

- (id)initWithLevelIndex:(int)level_idx
{
    self = [self init];

    // Lookup table to decode the original Polar resource
    // data as strings
    ArcticSlideTile *
        polar_data_tile_map[POLAR_DATA_NUM_TILE_VALS] =
    {
        empty_p, tree_p, mountain_p, house_p, ice_block_p,
        heart_p, bomb_p
    };

    if ( level_idx > ( num_polar_levels - 1) )
    {
        NSLog(@"initWithLevelIndex: bad level_idx %d!\n",
              level_idx);
    }
    else
    {
        unsigned int level_data_idx = 0;
        for ( unsigned int idx_y = 0;
             idx_y < board_height; idx_y++ )
        {
            for ( unsigned int idx_x = 0;
                 idx_x < board_width; idx_x++ )
            {
                int polar_data_tile_val =
                    polar_levels[level_idx]
                                [level_data_idx] - '0';
                if ( ( polar_data_tile_val < 0 ) ||
                     ( polar_data_tile_val > 
                       polar_data_max_tile_val ) )
                {
                    NSLog(@"tile value %d out of range!\n",
                          polar_data_tile_val );
                    self = nil;
                }
                else
                {
                    board[idx_y][idx_x] =
                        polar_data_tile_map[polar_data_tile_val];
                    level_data_idx++;
                }
            }
        }
    }

    return self;

}

- (ArcticSlideTile*)getTileFromPosition:(pos_t)pos 
                            inDirection:(dir_e)dir
{
    pos_t updated_pos = getUpdatedPos(pos, dir);
    if ( posValid( updated_pos ) )
    {
        return board[updated_pos.y_idx]
                    [updated_pos.x_idx];
    }
    else
    {
        return nil;
    }
}

- (NSString*)description
{
    NSMutableString *desc_str =[[NSMutableString alloc]init];
    
    [desc_str appendString:@"ArcticSlideModel board state:\n"];
    for ( unsigned int idx_y = 0;
         idx_y < board_height; idx_y++ )
    {
        for ( unsigned int idx_x = 0;
             idx_x < board_width; idx_x++ )
        {
            [desc_str appendString:[board[idx_y][idx_x] 
                                    description]];
        }
        [desc_str appendString:@"\n"];
    }
    return desc_str;
}

- (void)setTileAtPosition:(pos_t)pos to:(ArcticSlideTile*)type
{
    board[pos.y_idx][pos.x_idx] = type;
}

@end

It's not much yet, and it doesn't have any kind of user interface outside of NSLog, but my code will successfully respond to moving the penguin through trees, through open space, and pushing a bomb, which then moves into an open space, continues to slide until it comes up against a mountain, and destroys the mountain. I'm driving this with a test method like this:

NSLog(@"%@\n", model_p);
// Penguin starts at 0,0, on a tree tile
pos_t penguin_pos = { 0, 0 };

// Walk the penguin south onto another tree tile
ArcticSlideTile* tile_p =
[model_p getTileFromPosition:penguin_pos 
                 inDirection:dir_south];
NSLog(@"Penguin is facing: %@\n", tile_p);
BOOL allowed = [tile_p pushFromPosition:penguin_pos
                            inDirection:dir_south];
NSLog(@"Penguin allowed: %s\n", ( allowed ? "YES" : "NO" ) );
tile_p = [model_p getTileFromPosition:penguin_pos
                              inDirection:dir_south];
penguin_pos = getUpdatedPos(penguin_pos, dir_south);
NSLog(@"Penguin is facing: %@\n", tile_p);
    
// Walk the penguin east onto an empty space
tile_p = [model_p getTileFromPosition:penguin_pos
                              inDirection:dir_east];
NSLog(@"Penguin is facing: %@\n", tile_p);
allowed = [tile_p pushFromPosition:penguin_pos
                       inDirection:dir_east];
NSLog(@"Penguin allowed: %s\n", ( allowed ? "YES" : "NO" ) );
tile_p = [model_p getTileFromPosition:penguin_pos
                          inDirection:dir_east];
penguin_pos = getUpdatedPos(penguin_pos, dir_east);

// Try walking into a bomb, which should slide
// and blow up a mountain
tile_p = [model_p getTileFromPosition:penguin_pos
                          inDirection:dir_east];
NSLog(@"Penguin is facing: %@\n", tile_p);
allowed = [tile_p pushFromPosition:penguin_pos
                           inDirection:dir_east];
NSLog(@"Penguin allowed: %s\n", ( allowed ? "YES" : "NO" ) );

NSLog(@"%@\n", model_p);

I'll think on this whole model of updates some more. Maybe it can be even simpler. And I have to consider how the penguin state will be managed, including its orientation (in the original, the penguin can face in the cardinal directions). Should I preserve that in a touch-driven game user interface?

06 June 2013

Objective-C, Day 4

(Warning: more non-FP content)

It's time to get the board representation filled out with a real board. I've only got a couple of hours left before I have to pack up my computer to leave my Undisclosed Location, but let's see if I can get a little more done. Let's review what level 1 looks like:

Level layouts are taken from the original Macintosh Polar game created by Go Endo. These were originally MacOS resources of type 'STGE.' Let's see if we can decode them. Using ResEdit, the raw data for 'STGE' resource ID -16000 looks like:

0x0000 0x0000 0x0003 0x0001
0x0000 0x0000 0x0000 0x0000
0x0000 0x0000 0x0000 0x0000
0x0000 0x0000 0x0000 0x0000
0x0000 0x0000 0x0001 0x0000
0x0000 0x0000 0x0000 0x0000
0x0004 0x0000 0x0000 0x0001
0x0000 0x0006 0x0000 0x0002
0x0000 0x0005 0x0004 0x0005
0x0000 0x0000 0x0000 0x0000
0x0000 0x0000 0x0000 0x0000
0x0000 0x0001 0x0000 0x0000
0x0001 0x0000 0x0000 0x0001
0x0000 0x0000 0x0000 0x0000
0x0000 0x0000 0x0000 0x0000
0x0000 0x0000 0x0000 0x0000
0x0000 0x0000 0x0000 0x0005
0x0000 0x0000 0x0000 0x0002
0x0003 0x0000 0x0000 0x0001
0x0001 0x0000 0x0000 0x0000
0x0000 0x0001 0x0000 0x0000
0x0000 0x0000 0x0000 0x0000
0x0000 0x0000 0x0000 0x0000
0x0000 0x0000 0x0000 0x0000
0x0000 0x0000 0x0000

There are 99 16-bit values. My best guess is that this corresponds to the 24x4 grid (96 board positions) plus 3 extras for some kind of of header of footer data (maybe the total number of hearts is indicated, for example). There are 7 unique values, so it seems extremely likely that they correspond almost exactly to our eight different tile types, with zero representing a blank space. But the counts of each type don't _quite_ match up. The first board has 8 trees, 1 bomb, 2 hearts, 2 ice blocks, 2 mountains, 3 hearts, 1 house, and 1 penguin (there is always 1 penguin), while this 'STGE' resource has: 9 ones, 2 twos, 2 threes, 2 fours, 3 fives, and 1 six. The counts are very close, so this has to represent level 1, and the the 5 almost certainly represents a heart, but I'm not clearly seeing the layout. The first vertical column goes penguin, tree, tree, tree. I don't quite see a pattern that looks like that, but resources -1599 and -15996 give me a hint that the "extra" data is at the front: they contain 0x0007 and 0x0008 as their third values. Those don't appear anywhere else so they probably don't indicate tiles. So let's try rearranging resource -16000 without the first 6 bytes, remove redundant zeroes for clarity, and looking at the values aligned by groups of 24 instead of 4:

1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 4 0 0
1 0 6 0 2 0 5 4 5 0 0 0 0 0 0 0 0 0 1 0 0 1 0 0
1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 5 0 0 0 2 3 0 0
1 1 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

There's the board. The left column is actually all trees -- when the board first appears, the penguin is hiding a tree. There are actually nine trees. So the encoding looks like so: empty space = 0, tree = 1, mountain = 2, home = 3, ice block = 4, heart = 5, and bomb = 6. The penguin doesn't have a value, but his starting position is probably represented by the first two values, (0,0), most likely encoded as row index, column index to correspond to row-major indexing, and there are 3 hearts to count down as the game is solved.

Can we validate this with the second board? Yes, it looks like there's a 4 indicating 4 hearts. In all the boards I've seen so far (the first four), the penguin is in the upper left. The fifth resource has 0, 1 for its first two values, so I'm guessing I can confirm the encoding of the penguin's position if and when I get to that stage.

And now to come up with a quick way to populate the board in my code. As I'm still a complete n00b in Objective-C, and on the general principle that there's no real need to make this any more clever or less obvious than it has to be, let's just use a string with the data from the resource. Let's add an init method to the interface for the model class:

- (id)initWithLevelIndex:(int)level_idx;

And here is some data, and an initializer method:

static const int num_polar_levels = 1;
static const int polar_data_len = 96;
static const int polar_data_num_tile_vals = 7; // 0-6 inclusive
static const int polar_data_max_tile_val = 6;
static const NSString *polar_levels[num_polar_levels] =
{
    @"100000000000000100000400" \
    @"106020545000000000100100" \
    @"100000000000000050002300" \
    @"110000100000000000000000"
};

- (id)initWithLevelIndex:(int)level_idx
{
    // Call our own basic initializer. This will 
    // result in redundant setting of board values,
    // but maybe I will clean that up later.
    self = [self init];

    // A simple lookup table to decode the original
    // Polar resource data as strings
    ArcticSlideTile 
        *polar_data_tile_map[polar_data_num_tile_vals] = {
        empty, tree, mountain, house,
        ice_block, heart, bomb };

    if ( level_idx > ( num_polar_levels - 1) )
    {
        NSLog( @"initWithLevelLayout: level %d out of range!\n",
               level_idx );
        self = nil;
    }
    else
    {
        const NSString* level_str = polar_levels[level_idx];
        unsigned int level_data_idx = 0;
        for ( unsigned int idx_y = 0;
             idx_y < board_height; idx_y++ )
        {
            for ( unsigned int idx_x = 0;
                 idx_x < board_width; idx_x++ )
            {
                NSRange range = NSMakeRange(level_data_idx, 1);
                const NSString * item_str =
                    [level_str substringWithRange: range];
                int polar_data_tile_val = [item_str intValue];
                if ( polar_data_tile_val >
                    polar_data_max_tile_val )
                {
                    NSLog(@"tile val %d out of range!\n",
                        polar_data_tile_val );
                    self = nil;
                }
                else
                {
                    board[idx_y][idx_x] =
                        polar_data_tile_map[polar_data_tile_val];
                    level_data_idx++;
                }
            }
        }
    }
    return self;
}

Hmmm, that seems overly complicated. There probably is a better, more idiomatic Objective-C way to use NSStrings for that, but I'm tempted to just write it with a basic C string. Using NSString objects in this context didn't even really help me catch bugs or avoid crashes, since I had forgotten to initialize a heart object and the result was hitting a nil object pointer at runtime and crashing, pretty much the same result as dereferencing a null pointer in straight C except with a better error logged. I'm a little disconcerted by Objective-C's inability to allocate objects on the stack, but that comes down to the aforementioned "thin veneer" over C. I don't really care about the overhead in using method dispatch in this simple piece of code operating on such a small amount of data, but I do care about simplicity. Just to compare, here's a more straightforward C implementation of that inner loop:

static const char *polar_levels[num_polar_levels] =
{
    "100000000000000100000400"
    "106020545000000000100100"
    "100000000000000050002300"
    "110000100000000000000000"
};

int polar_data_tile_val = level_str_p[level_data_idx] - '0';
if ( ( polar_data_tile_val < 0 ) || 
     ( polar_data_tile_val > 
       polar_data_max_tile_val ) )
{
    NSLog(@"polar data tile value %d out of range!\n",
          polar_data_tile_val );
    self = nil
}

Maybe the lesson here is "use Objective-C objects only when objects are a win."

I'm going to continue with this project, developing the code to handle the interactions of objects on the playing field and eventually the user interface. However, now that my week away from home is done, I might not be able to make progress very quickly. Stay tuned -- I'll post what I can, when I can. As always, if you have any comments or questions, I'm happy to have feedback.