Rogue: clean up warnings (add type signatures, avoid overlapping names)

This commit is contained in:
Jonathan Daugherty 2014-08-01 15:28:16 -07:00
parent f9757bc01b
commit 668ec34424

View File

@ -29,12 +29,12 @@ data World = World
deriving (Show,Eq) deriving (Show,Eq)
data Level = Level data Level = Level
{ start :: (Int, Int) { levelStart :: (Int, Int)
, end :: (Int, Int) , levelEnd :: (Int, Int)
, geo :: Array (Int, Int) LevelPiece , levelGeo :: Array (Int, Int) LevelPiece
-- building the geo image is expensive. Cache it. Though VTY should go through greater lengths -- building the geo image is expensive. Cache it. Though VTY should go through greater lengths
-- to avoid the need to cache images. -- to avoid the need to cache images.
, geoImage :: Image , levelGeoImage :: Image
} }
deriving (Show,Eq) deriving (Show,Eq)
@ -45,13 +45,15 @@ data LevelPiece
type Game = RWST Vty () World IO type Game = RWST Vty () World IO
main :: IO ()
main = do main = do
vty <- mkVty def vty <- mkVty def
level0 <- mkLevel 1 level0 <- mkLevel 1
let world0 = World (Dude (fst $ start level0) (snd $ start level0)) level0 let world0 = World (Dude (fst $ levelStart level0) (snd $ levelStart level0)) level0
(_finalWorld, ()) <- execRWST (play >> updateDisplay) vty world0 (_finalWorld, ()) <- execRWST (play >> updateDisplay) vty world0
shutdown vty shutdown vty
mkLevel :: Int -> IO Level
mkLevel difficulty = do mkLevel difficulty = do
let size = 80 * difficulty let size = 80 * difficulty
[levelWidth, levelHeight] <- replicateM 2 $ randomRIO (size,size) [levelWidth, levelHeight] <- replicateM 2 $ randomRIO (size,size)
@ -68,6 +70,8 @@ mkLevel difficulty = do
geo <- foldM (addRoom levelWidth levelHeight) baseGeo (start : end : centers) geo <- foldM (addRoom levelWidth levelHeight) baseGeo (start : end : centers)
return $ Level start end geo (buildGeoImage geo) return $ Level start end geo (buildGeoImage geo)
addRoom :: Int -> Int -> Array (Int, Int) LevelPiece -> (Int, Int)
-> IO (Array (Int, Int) LevelPiece)
addRoom levelWidth levelHeight geo (centerX, centerY) = do addRoom levelWidth levelHeight geo (centerX, centerY) = do
size <- randomRIO (5,15) size <- randomRIO (5,15)
let xMin = max 1 (centerX - size) let xMin = max 1 (centerX - size)
@ -77,17 +81,21 @@ addRoom levelWidth levelHeight geo (centerX, centerY) = do
let room = [((x,y), EmptySpace) | x <- [xMin..xMax - 1], y <- [yMin..yMax - 1]] let room = [((x,y), EmptySpace) | x <- [xMin..xMax - 1], y <- [yMin..yMax - 1]]
return (geo // room) return (geo // room)
imageForGeo :: LevelPiece -> Image
imageForGeo EmptySpace = char (defAttr `withBackColor` green) ' ' imageForGeo EmptySpace = char (defAttr `withBackColor` green) ' '
imageForGeo Rock = char defAttr 'X' imageForGeo Rock = char defAttr 'X'
pieceA, dumpA :: Attr
pieceA = defAttr `withForeColor` blue `withBackColor` green pieceA = defAttr `withForeColor` blue `withBackColor` green
dumpA = defAttr `withStyle` reverseVideo dumpA = defAttr `withStyle` reverseVideo
play :: Game ()
play = do play = do
updateDisplay updateDisplay
done <- processEvent done <- processEvent
unless done play unless done play
processEvent :: Game Bool
processEvent = do processEvent = do
k <- ask >>= liftIO . nextEvent k <- ask >>= liftIO . nextEvent
if k == EvKey KEsc [] if k == EvKey KEsc []
@ -102,14 +110,14 @@ processEvent = do
_ -> return () _ -> return ()
return False return False
moveDude :: Int -> Int -> Game ()
moveDude dx dy = do moveDude dx dy = do
vty <- ask
world <- get world <- get
let Dude x y = dude world let Dude x y = dude world
let x' = x + dx let x' = x + dx
y' = y + dy y' = y + dy
-- this is only valid because the level generation assures the border is always Rock -- this is only valid because the level generation assures the border is always Rock
case geo (level world) ! (x',y') of case levelGeo (level world) ! (x',y') of
EmptySpace -> put $ world { dude = Dude x' y' } EmptySpace -> put $ world { dude = Dude x' y' }
_ -> return () _ -> return ()
@ -122,18 +130,19 @@ updateDisplay = do
let ox = (w `div` 2) - dudeX theDude let ox = (w `div` 2) - dudeX theDude
oy = (h `div` 2) - dudeY theDude oy = (h `div` 2) - dudeY theDude
-- translate the world images to place the dude in the center of the level. -- translate the world images to place the dude in the center of the level.
world' <- map (translate ox oy) <$> world world' <- map (translate ox oy) <$> worldImages
let pic = picForLayers $ info : world' let pic = picForLayers $ info : world'
vty <- ask vty <- ask
liftIO $ update vty pic liftIO $ update vty pic
world :: Game [Image] worldImages :: Game [Image]
world = do worldImages = do
theDude <- gets dude theDude <- gets dude
theLevel <- gets level theLevel <- gets level
let dudeImage = translate (dudeX theDude) (dudeY theDude) (char pieceA '@') let dudeImage = translate (dudeX theDude) (dudeY theDude) (char pieceA '@')
return [dudeImage, geoImage theLevel] return [dudeImage, levelGeoImage theLevel]
buildGeoImage :: Array (Int, Int) LevelPiece -> Image
buildGeoImage geo = buildGeoImage geo =
let (geoWidth, geoHeight) = snd $ bounds geo let (geoWidth, geoHeight) = snd $ bounds geo
-- seems like a the repeated index operation should be removable. This is not performing random -- seems like a the repeated index operation should be removable. This is not performing random