@@ -29,12 +29,12 @@ data World = World
2929 deriving (Show,Eq)
3030
3131data Level = Level
32− { start :: (Int, Int)
33− , end :: (Int, Int)
34− , geo :: Array (Int, Int) LevelPiece
32+ { levelStart :: (Int, Int)
33+ , levelEnd :: (Int, Int)
34+ , levelGeo :: Array (Int, Int) LevelPiece
3535 -- building the geo image is expensive. Cache it. Though VTY should go through greater lengths
3636 -- to avoid the need to cache images.
37− , geoImage :: Image
37+ , levelGeoImage :: Image
3838 }
3939 deriving (Show,Eq)
4040
@@ -45,13 +45,15 @@ data LevelPiece
4545
4646type Game = RWST Vty () World IO
4747
48+main :: IO ()
4849main = do
4950 vty <- mkVty def
5051 level0 <- mkLevel 1
51− let world0 = World (Dude (fst $ start level0) (snd $ start level0)) level0
52+ let world0 = World (Dude (fst $ levelStart level0) (snd $ levelStart level0)) level0
5253 (_finalWorld, ()) <- execRWST (play >> updateDisplay) vty world0
5354 shutdown vty
5455
56+mkLevel :: Int -> IO Level
5557mkLevel difficulty = do
5658 let size = 80 * difficulty
5759 [levelWidth, levelHeight] <- replicateM 2 $ randomRIO (size,size)
@@ -68,6 +70,8 @@ mkLevel difficulty = do
6870 geo <- foldM (addRoom levelWidth levelHeight) baseGeo (start : end : centers)
6971 return $ Level start end geo (buildGeoImage geo)
7072
73+addRoom :: Int -> Int -> Array (Int, Int) LevelPiece -> (Int, Int)
74+ -> IO (Array (Int, Int) LevelPiece)
7175addRoom levelWidth levelHeight geo (centerX, centerY) = do
7276 size <- randomRIO (5,15)
7377 let xMin = max 1 (centerX - size)
@@ -77,17 +81,21 @@ addRoom levelWidth levelHeight geo (centerX, centerY) = do
7781 let room = [((x,y), EmptySpace) | x <- [xMin..xMax - 1], y <- [yMin..yMax - 1]]
7882 return (geo // room)
7983
84+imageForGeo :: LevelPiece -> Image
8085imageForGeo EmptySpace = char (defAttr `withBackColor` green) ' '
8186imageForGeo Rock = char defAttr 'X'
8287
88+pieceA, dumpA :: Attr
8389pieceA = defAttr `withForeColor` blue `withBackColor` green
8490dumpA = defAttr `withStyle` reverseVideo
8591
92+play :: Game ()
8693play = do
8794 updateDisplay
8895 done <- processEvent
8996 unless done play
9097
98+processEvent :: Game Bool
9199processEvent = do
92100 k <- ask >>= liftIO . nextEvent
93101 if k == EvKey KEsc []
@@ -102,14 +110,14 @@ processEvent = do
102110 _ -> return ()
103111 return False
104112
113+moveDude :: Int -> Int -> Game ()
105114moveDude dx dy = do
106− vty <- ask
107115 world <- get
108116 let Dude x y = dude world
109117 let x' = x + dx
110118 y' = y + dy
111119 -- this is only valid because the level generation assures the border is always Rock
112− case geo (level world) ! (x',y') of
120+ case levelGeo (level world) ! (x',y') of
113121 EmptySpace -> put $ world { dude = Dude x' y' }
114122 _ -> return ()
115123
@@ -122,18 +130,19 @@ updateDisplay = do
122130 let ox = (w `div` 2) - dudeX theDude
123131 oy = (h `div` 2) - dudeY theDude
124132 -- translate the world images to place the dude in the center of the level.
125− world' <- map (translate ox oy) <$> world
133+ world' <- map (translate ox oy) <$> worldImages
126134 let pic = picForLayers $ info : world'
127135 vty <- ask
128136 liftIO $ update vty pic
129137
130−world :: Game [Image]
131−world = do
138+worldImages :: Game [Image]
139+worldImages = do
132140 theDude <- gets dude
133141 theLevel <- gets level
134142 let dudeImage = translate (dudeX theDude) (dudeY theDude) (char pieceA '@')
135− return [dudeImage, geoImage theLevel]
143+ return [dudeImage, levelGeoImage theLevel]
136144
145+buildGeoImage :: Array (Int, Int) LevelPiece -> Image
137146buildGeoImage geo =
138147 let (geoWidth, geoHeight) = snd $ bounds geo
139148 -- seems like a the repeated index operation should be removable. This is not performing random