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!

3 comments:

Roland said...

Hi Paul,

I like your post about this Plar game.
Some remarks about Edge.
1.) I suggest to factor out " ++ [Edge] from the view function as:
view :: Board -> Pos -> Dir -> [Tile]
view board pos dir = (view' board pos dir) ++ [Edge]
where
view' board pos East = ( drop ( posX pos + 1 ) $ ...
2.) Do you really want to add the Edge tile every time you construct a slice? An alternative would be to have an addEdge function, that adds all the edges to a board after you create it with get_initial_board.
3.) Do you really need the Edge tile? If the penguine sees an empt list of tiles, it's at the edge of his nice small world. You could avoid all the runtime errors like
collide [] = error "traverse empty list!" or
step [] = error "step: empty list!"
If you have no runtime errors, the chances that your program fails are much smaller!

Thanks and regards
Roland

Roland said...

Hi Paul,

next_ppos could be written as:

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 you split the adding from the direction stuff.

Regards
R.

PS: You have to add some blanks in front of the 6 last lines ...

Paul R. Potts said...

Hi Roland,

Yeah, it has occurred to me that if I'm actually using lists where I can detect the end case, there isn't really a need for the Edge tile. I could just delete it entirely. It is a hold-over from the Objective-C version where I use it as a flag to avoid dereferencing array elements past the bounds.

Thanks for the simplification of next_ppos -- that's a good idea.

It also occurred to me as I ate dinner last night that I can use a fold on a list of moves to collect up the updated boards. I don't think in the fully functional mind-set yet. But that should be easy to implement -- I'll do that for next time, which should allow me to get the rest of the boards up and running quickly and validate all the cases.