Taking a look at LambdaHack – a Haskell roguelike – Part 2

(Part one of this series)
(Note: LambdaHack version 0.1.20090606 is distributed under GPLv2, and pieces of the code base are copied into this blog entry without modification.)

Upon first viewing, this seems like a mess of graphs that don’t really make a whole lot of sense. It’s best to start off with the individual analysis of modules, beginning with Main.

Main analysis

And here is the corresponding code:

18
19
main :: IO ()
main = startup start

LambdaHack.hs:18

What the picture doesn’t show is that startup comes from Display.Curses. [The curses display code will be used throughout the dissection instead of vtk or gtk]

22
23
24
25
26
27
28
29
30
31
32
33
34
startup :: (Session -> IO ()) -> IO ()
startup k =
  do
    C.start
    C.startColor
    cursSet CursorInvisible
    nr <- colorPairs
    let s = [ ((f,b), C.Style (toFColor f) (toBColor b))
            | f <- Nothing : L.map Just [minBound..maxBound],
              b <- Nothing : L.map Just [minBound..maxBound] ]
    let (ks, vs) = unzip (tail s)  -- drop the Nothing/Nothing combo
    ws <- C.convertStyles (take (nr - 1) vs)
    k (Session C.stdScr (M.fromList (zip ks ws)))

Display/Curses.hs:22

Essentially this function initializes the display system, which is ncurses in this example.

After the initialization is done, Display.Curses.startup executes a function that takes a Session as parameter and returns IO (); this is the signature of the Main.start function in the Main module.

22
23
24
25
26
27
28
29
30
31
32
33
34
start :: Session -> IO ()
start session =
    do
      -- check if we have a savegame
      x <- doesFileExist savefile
      restored <- if x then do
                              displayBlankConfirm session "Restoring save game"
                              restoreGame
                       else return $ Right "Welcome to LambdaHack!"  -- new game
      case restored of
        Right msg        -> generate session msg
        Left (lvl,state) -> handle session lvl state (perception_ state lvl)
                                   "Welcome back to LambdaHack."

LambdaHack.hs:22

This function either restores a saved game from a file or generates a new one. Both Main.start and Main.generate end up calling Turn.handle.

Here’s the generated graph for the Turn module.

Turn analysis

This graph is definitely meatier and gives a great idea as to how turns are handled in this game. The handle function appears to be a core loop in LambdaHack. Here is how the function is declared:

140
141
142
143
handle :: Session -> Level -> State -> Perception -> String -> IO ()
handle session (lvl@(Level nm sz ms smap lmap lmeta))
               (state@(State { splayer = player@(Monster { mhp = php, mdir  pdir, mloc = ploc, mitems = pinv, mtime = ptime }), stime = time, sassocs = assocs, sdiscoveries = discs }))
               per oldmsg =

Turn.hs:140

Yeowch! There is a lot going on here.

Here’s the core of the Turn.handle function, omitting the inner function declarations:

144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
    -- check for player death
    if php <= 0
      then do
             displayCurrent (addMsg oldmsg ("You die ..." ++ more))
             getConfirm session
             shutdown session
      else -- check if the player can make another move yet
           if ptime > time then
             do
               -- do not make intermediate redraws while running
               maybe (displayLevel session lvl per state "") (const $ return ()) pdir
               handleMonsters session lvl state per oldmsg
           -- NOTE: It's important to call handleMonsters here, not loop,
           -- because loop does all sorts of calculations that are only
           -- really necessary after the player has moved.
      else do
             displayCurrent oldmsg
             let h = nextEvent session >>= h'
                 h' e =
                       handleDirection e (move h) $
                         handleDirection (L.map toLower e) run $
                         handleModifier e h $
                         case e of
                           "o"       -> openclose True h
                           "c"       -> openclose False h
                           "s"       -> search h

                           "less"    -> lvlchange Up h
                           "greater" -> lvlchange Down h

                           -- items
                           "comma"   -> pickup h
                           "d"       -> drop h
                           "i"       -> inventory h
                           "q"       -> drink h

                           -- saving or ending the game
                           "S"       -> saveGame lvl mstate >> shutdown session
                           "Q"       -> shutdown session
                           "Escape"  -> displayCurrent "Press Q to quit." >> h

                           -- wait
                           "space"   -> loop session nlvl nstate ""
                           "period"  -> loop session nlvl nstate ""

                           -- look
                           "colon"   -> lookAround h

                           -- display modes
                           "V"       -> handle session nlvl (toggleVision state) per oldmsg
                           "R"       -> handle session nlvl (toggleSmell state) per oldmsg
                           "O"       -> handle session nlvl (toggleOmniscient state) per oldmsg
                           "T"       -> handle session nlvl (toggleTerrain state) per oldmsg

                           -- meta information
                           "M"       -> displayCurrent' "" (unlines (shistory mstate) ++ more) >>= \ b ->
                                        if b then getOptionalConfirm session
                                                    (const (displayCurrent "" >> h)) h'
                                             else displayCurrent "" >> h
                           "I"       -> displayCurrent lmeta >> h
                           "v"       -> displayCurrent version >> h

                           s   -> displayCurrent ("unknown command (" ++ s ++ ")") >> h
             maybe h continueRun pdir

Turn.hs:144

This function checks to see if the player died, or if it’s possible to move. It also uses Display.Curses.nextEvent (line 161) to get the current input from the keyboard and acts upon it.

The displayCurrent function is defined local to Turn.handle as below:

218
219
  displayCurrent :: String -> IO ()
  displayCurrent  = displayLevel session nlvl per state

Turn.hs:218

This references Display2.displayLevel which then calls Display2.displayOverlay with an extra empty string.

96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
displayOverlay :: Session -> Level -> Perception -> State -> Message -> String -> IO Bool
displayOverlay session (lvl@(Level nm sz@(sy,sx) ms smap nlmap lmeta))
                     per
                     (state@(State { splayer = player@(Monster { mhp  php, mdir = pdir, mloc = ploc }), stime = time, sassocs = assocs }))
                     msg overlay =
    let
      reachable = preachable per
      visible   = pvisible per
      sSml    = ssensory state == Smell
      sVis    = ssensory state == Vision
      sOmn    = sdisplay state == Omniscient
      sTer    = case sdisplay state of Terrain n -> n; _ -> 0
      lAt     = if sOmn || sTer > 0 then at else rememberAt
      lVision = if sVis
                  then \ vis rea ->
                       if      vis then setBG blue
                       else if rea then setBG magenta
                                   else id
                  else \ vis rea -> id
      (n,over) = stringByLocation (sy+1) overlay -- n is the number of overlay screens
      gold    = maybe 0 (icount . fst) $ findItem (\ i -> iletter i == Just '$') (mitems player)
      disp n msg =
        display ((0,0),sz) session
                 (\ loc -> let tile = nlmap `lAt` loc
                               sml  = ((smap ! loc) - time) `div` 100
                               vis  = S.member loc visible
                               rea  = S.member loc reachable
                               (rv,ra) = case L.find (\ m -> loc == mloc m) (player:ms) of
                                           _ | sTer > 0          -> viewTerrain sTer False (tterrain tile)
                                           Just m | sOmn || vis  -> viewMonster (mtype m)
                                           _ | sSml && sml >= 0  -> viewSmell sml
                                             | otherwise         -> viewTile vis tile assocs
                               vision = lVision vis rea
                           in
                             case over (loc `shift` ((sy+1) * n, 0)) of
                               Just c  ->  (attr, c)
                               _       ->  (ra . vision $ attr, rv))
                msg
                (take 40 (levelName nm ++ repeat ' ') ++
                 take 10 ("$: " ++ show gold ++ repeat ' ') ++
                 take 10 ("HP: " ++ show php ++ repeat ' ') ++
                 take 10 ("T: " ++ show (time `div` 10) ++ repeat ' '))
      msgs = splitMsg sx msg
      perf k []     = perfo k ""
      perf k [xs]   = perfo k xs
      perf k (x:xs) = disp n (x ++ more) >> getConfirm session >>= \ b ->
                      if b then perf k xs else return False
      perfo k xs
        | k < n - 1 = disp k xs >> getConfirm session >>= \ b ->
                      if b then perfo (k+1) xs else return False
        | otherwise = disp k xs >> return True
    in perf 0 msgs

Display2.hs:96

This code prints the status bar and text messages and uses the passed function to print each map location.

Eventually in Display2.displayOverlay the function Display.Curses.display gets called. This is what actually draws the area map.

39
40
41
42
43
44
45
46
47
display :: Area -> Session -> (Loc -> (Display.Curses.Attr, Char)) -> String -> String -> IO ()
display ((y0,x0),(y1,x1)) (Session { win = w, styles = s }) f msg status =
  do
    erase
    mvWAddStr w 0 0 msg
    sequence_ [ let (a,c) = f (y,x) in C.setStyle (findWithDefault C.defaultCursesStyle a s) >> mvWAddStr w (y+1) x [c]
              | x <- [x0..x1], y <- [y0..y1] ]
    mvWAddStr w (y1+2) 0 status
    refresh

Display/Curses.hs:39

You can see how the function uses sequence_ and list comprehensions to write characters to the display.

There you have it. That is the basic flow control for LambdaHack. You seen how the main function is constructed and how it passes control to the display and then Turn.handle which is the main loop for everything else, including player input and display output.

Comments are closed.