left4deadrl (empty) → 0.0.1

raw patch · 4 files changed

+510/−0 lines, 4 filesdep +basedep +hscharmdep +randomsetup-changed

Dependencies added: base, hscharm, random, random-shuffle

Files

• LICENSE.md +23/−0
• Setup.hs +2/−0
• left4deadrl.cabal +26/−0
• src/Left4DeadRL.hs +459/−0

@@ -0,0 +1,23 @@+FreeBSD License++Copyright 2011 YelloSoft. All rights reserved.++Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation and/or+other materials provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS "AS IS" AND ANY EXPRESS OR IMPLIED+WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT+SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,26 @@+name:           left4deadrl+version:        0.0.1+category:       Math+synopsis:       Wau codec+description:    A base unary encoder/decoder+license:        BSD3+license-file:   LICENSE.md+author:         Andrew Pennebaker+maintainer:     andrew.pennebaker@gmail.com+build-type:     Simple+cabal-version:  >=1.8++source-repository head+  type:     git+  location: git://github.com/mcandre/left4deadrl.git++executable left4deadrl+  build-depends:+    base           >= 4.3.1.0 && < 5,+    random         >= 1.1 && < 2,+    random-shuffle >= 0.0.4 && < 0.0.5,+    hscharm        >= 0.0.2 && < 0.0.3++  ghc-options: -Wall -fwarn-tabs+  main-is: Left4DeadRL.hs+  hs-source-dirs: src

@@ -0,0 +1,459 @@+{-# LANGUAGE NoImplicitPrelude #-}++-- A Left4Dead Roguelike+--+-- Andrew Pennebaker++module Main where++import qualified System.Random as Random+import qualified System.Random.Shuffle as Shuffle++import Prelude+import Data.Maybe (fromJust)+import Control.Monad (when, replicateM)+import Data.List (sortBy)++import HsCharm++type Pos = (Int, Int)++data Game = Game {+  dungeon :: [[Cell]],+  messages :: [String],+  rogueLoc :: Pos,+  safehouseExitLoc :: Pos,+  safehouseEntranceLoc :: Pos+  }++sqrtInt :: Int -> Int+sqrtInt = floor . (sqrt :: Double -> Double) . fromIntegral++-- Assumes each row is the same length+width :: Game -> Int+width = length . (!! 0) . dungeon++height :: Game -> Int+height = length . dungeon++data Cell = Cell {+  tile :: Tile,+  occupant :: Maybe Monster+  }++data Tile = Tile {+  tileName :: String,++  -- ASCII symbol+  tileSymbol :: String,++  -- From 0.0 (easily traversed) to 1.0 (impassible)+  terrain :: Float+  }++data Monster = Monster {+  monsterName :: String,++  -- ASCII symbol+  monsterSymbol :: String,++  -- Attack points+  ap :: Int,++  -- Health points+  hp :: Int,++  -- How far the monster can see+  horizon :: Int+  }++instance Show Tile where+  show = tileSymbol++instance Show Monster where+  show = monsterSymbol++instance Show Cell where+  show c = case occupant c of+    Nothing -> (show . tile) c+    Just m -> show m++messageSpace :: Int+messageSpace = 3++voicemail :: Game -> [String]+voicemail = take (messageSpace - 1) . messages++space :: Tile+space = Tile {+  tileName = "floor",+  tileSymbol = " ",+  terrain = 0.0+  }++emptyCell :: Cell+emptyCell = Cell {+  tile = space,+  occupant = Nothing+  }++emptySpace :: Cell+emptySpace = emptyCell {+  tile = space+  }++wall :: Tile+wall = Tile {+  tileName = "wall",+  tileSymbol = "#",+  terrain = 1.0+  }++emptyWall :: Cell+emptyWall = emptyCell {+  tile = wall+  }++safehouseExit :: Tile+safehouseExit = Tile {+  tileName = "safehouse exit",+  tileSymbol = "]",+  terrain = 0.0+  }++emptySafehouseExit :: Cell+emptySafehouseExit = emptyCell {+  tile = safehouseExit+  }++safehouseEntrance :: Tile+safehouseEntrance = Tile {+  tileName = "safehouse entrance",+  tileSymbol = "[",+  terrain = 0.0+  }++emptySafehouseEntrance :: Cell+emptySafehouseEntrance = emptyCell {+  tile = safehouseEntrance+  }++defaultRogue :: Monster+defaultRogue = Monster {+  monsterName = "rogue",+  monsterSymbol = "@",+  ap = 1,+  hp = 10,+  horizon = 10+  }++zombie :: Monster+zombie = Monster {+  monsterName = "zombie",+  monsterSymbol = "z",+  ap = 1,+  hp = 1,+  horizon = 5+  }++withinBounds :: Game -> Pos -> Bool+withinBounds g (x, y) = (x >= 0) && (x <= width g - 1) && (y >= 0) && (y <= height g - 1)++-- Assumes x and y are within bounds.+getCell :: Game -> Pos -> Cell+getCell g (x, y) = (dungeon g !! y) !! x++-- Assumes x and y are within bounds.+putCell :: Game -> Pos -> Cell -> Game+putCell g (x, y) c = g { dungeon = rowsBefore ++ [curRow'] ++ rowsAfter }+  where+    rows = dungeon g+    (rowsBefore, curRow:rowsAfter) = splitAt y rows+    (colsBefore, _:colsAfter) = splitAt x curRow+    curRow' = colsBefore ++ [c] ++ colsAfter++moveOccupant :: Game -> Pos -> Pos -> Game+moveOccupant g a b = g''+  where+    aCell = getCell g a+    bCell = getCell g b+    bCell' = bCell { occupant = occupant aCell }+    aCell' = aCell { occupant = Nothing }+    g' = putCell g b bCell'+    g'' = putCell g' a aCell'++move :: Game -> Key -> IO Game+move g k = do+  let (x, y) = rogueLoc g++  let (x', y') = case k of+        KeyUp -> (x, y - 1)+        KeyDown -> (x, y + 1)+        KeyRight -> (x + 1, y)+        KeyLeft -> (x - 1, y)+        _ -> (x, y)++  if withinBounds g (x', y')+    then do+      let b = getCell g (x', y')++      case occupant b of+        -- Monster in the way+        Just _ -> return $ strike g (x, y) (x', y')++        -- Nothing in the way+        _ -> if passable g (x', y')+             then do+               -- Move rogue from cell a to cell b.+               let g' = moveOccupant g (x, y) (x', y')+               return $ g' { rogueLoc = (x', y') }+             else do+               let t = tile b+               return $ g { messages = ("There is a " ++ tileName t ++ " in the way."):voicemail g }+    else+    return $ g { messages = "Edge of the world.":voicemail g }++blotMessages :: Game -> [String] -> IO ()+blotMessages g ms = blotMessages' ms (height g + messageSpace - 1)+  where+    blotMessages' :: [String] -> Int -> IO ()+    blotMessages' [] _ = return ()+    blotMessages' (m:ms') row = do+      moveCursor 0 row+      hCenterString m+      blotMessages' ms' (row - 1)++blotCell :: Game -> Pos -> IO ()+blotCell g (x, y) = do+  let c = getCell g (x, y)++  moveCursor x y+  (blotString . show) c++blotDungeon :: Game -> IO ()+blotDungeon g = do+  let rLoc = rogueLoc g+  let r = fromJust $ occupant $ getCell g rLoc+  let fog = [+        (x, y) |+        x <- [0 .. width g - 1],+        y <- [0 .. height g - 1],+        dist rLoc (x, y) < horizon r || safehouseEntranceLoc g == (x, y)+        ]++  mapM_ (blotCell g) fog++  return ()++win :: Game -> Bool+win g = safehouseEntranceLoc g == rogueLoc g++lose :: Game -> Bool+lose g = case (occupant . getCell g . rogueLoc) g of+  Just r -> ((0 ==) . hp) r+  _ -> True++blotRecap :: Game -> String -> IO ()+blotRecap g s = do+  clearScreen+  vCenterString $ s ++ " Play again (y/n)?"++  k <- getKey++  case k of+    KeyY -> restart+    KeyN -> return ()+    KeyQ -> return ()+    KeyEscape -> return ()+    _ -> blotRecap g s++strike :: Game -> Pos -> Pos -> Game+strike g a b = g'+  where+    aCell = getCell g a+    bCell = getCell g b+    m1 = occupant aCell+    m2 = occupant bCell+    g' = case (m1, m2) of+      (Just m1', Just m2') -> if (hp m2'' <= 0) && (monsterName m2'' /= "rogue")+                              then+                                -- Delete monster.+                                putCell (g { messages = ("Killed a " ++ monsterName m2' ++ "."):voicemail g }) b (bCell { occupant = Nothing })+                              else+                                -- Reinstert monster.+                                placeMonster (g { messages = ("Hit a " ++ monsterName m2'' ++ "."):voicemail g }) b m2''+        where+          m2'' = m2' { hp = hp m2' - ap m1' }+          -- One of the monsters is no longer there.+      _ -> g++passable :: Game -> Pos -> Bool+passable g p = not (occupied c) && (0.0 == terrain (tile c))+  where+    c = getCell g p++dist :: Pos -> Pos -> Int+dist (x1, y1) (x2, y2) = sqrtInt $ dx * dx + dy * dy+  where+    dx = x1 - x2+    dy = y1 - y2++-- Ignore corner adjacencies+neighbors :: Game -> Pos -> [Pos]+neighbors g (x, y) = filter (withinBounds g) [+  (x + 1, y),+  (x - 1, y),+  (x, y + 1),+  (x, y - 1)+  ]++-- For testing purposes+greedyPath :: Game -> Pos -> Pos -> Maybe [Pos]+greedyPath g s e+  | 1 == dist s e = Just [s, e]+  | otherwise = Just [s, b', e]+  where+    b' = case sortBy (\a b -> compare (dist a e) (dist b e)) $ filter (passable g) $ neighbors g s of+      [] -> e+      (x:_) -> x++-- Let each monster respond.+respond :: Game -> [Pos] -> IO Game+respond g [] = return g+respond g (a:as) = do+  let r = rogueLoc g++  case occupant $ getCell g a of+    Just m -> if dist a r == 1 -- Monster is next to rogue.+              then do+                let g' = (strike g a r) { messages = ("You were struck by a " ++ monsterName m ++ "."):voicemail g }+                respond g' as+              else do+                stdGen <- Random.getStdGen+                let creep = head $ Shuffle.shuffle' zombieCreep (length zombieCreep) stdGen++                if creep+                  then case greedyPath g a r of+                    Just (_:p:_) -> do+                      -- Move monster one step along path.+                      let g' = moveOccupant g a p+                      respond g' as+                    -- No path. Monster will sit.+                    _ -> respond (g { messages = ("A " ++ monsterName m ++ " sat down."):voicemail g }) as+                  else respond g as+    -- Monster is no longer there.+    _ -> respond g as++occupied :: Cell -> Bool+occupied c = case occupant c of+  Just _ -> True+  _ -> False++-- The location of every monster that is not a rogue+monsters :: Game -> [Pos]+monsters g = [+  (x, y)+  |+  x <- [0 .. width g - 1],+  y <- [0 .. height g - 1],+  occupied $ getCell g (x, y),+  (x, y) /= rogueLoc g+  ]++loop :: Game -> IO ()+loop g = case (win g, lose g) of+  (True, _) -> blotRecap g "You made it!"+  (_, True) -> blotRecap g "You were overwhelmed."+  _ -> do+    clearScreen++    blotDungeon g+    blotMessages g (reverse $ messages g)++    k <- getKey++    when (k `notElem` [KeyEscape, KeyQ])+      (do+          g' <- if k `elem` [KeyUp, KeyDown, KeyRight, KeyLeft]+                  then move g k+                else return g++          g'' <- respond g' (monsters g')++          loop g'')++generateRow :: Int -> IO [Cell]+generateRow w = replicate w . head . Shuffle.shuffle' (emptyWall : replicate 10 emptySpace) 11 <$> Random.getStdGen++generateSafehouseRow :: Int -> IO [Cell]+generateSafehouseRow w = do+  cells <- replicate (w - 2) . head . Shuffle.shuffle' (emptyWall:replicate 10 emptySpace) 11 <$> Random.getStdGen+  return $ emptySafehouseEntrance:(cells ++ [emptySafehouseExit])++generateDungeon :: Int -> Int -> IO [[Cell]]+generateDungeon w h = do+  as <- replicateM ((h - 1) `div` 2) (generateRow w)+  b <- generateSafehouseRow w+  cs <- replicateM ((h - 1) `div` 2) (generateRow w)++  return $ as ++ (b:cs)++commonZombies :: Game -> Int+commonZombies g = sqrtInt $ width g * height g++zombieCreep :: [Bool]+zombieCreep = [True, False, False, False]++placeMonster :: Game -> Pos -> Monster -> Game+placeMonster g (x, y) r = putCell g (x, y) c'+  where+    c = getCell g (x, y)+    c' = c { occupant = Just r }++placeMonsters :: Game -> [Monster] -> IO Game+placeMonsters g [] = return g+placeMonsters g (m:ms) = do+  x <- Random.getStdRandom $ Random.randomR (0, width g - 1)+  y <- Random.getStdRandom $ Random.randomR (0, height g - 1)++  -- If cell is occupied or impassible, reroll.+  if not (passable g (x, y))+    then placeMonsters g (m:ms)+    else do+      let g' = placeMonster g (x, y) m+      placeMonsters g' ms++newGame :: IO Game+newGame = do+  w <- getWidth+  h <- getHeight++  -- Reserve space for messages+  let (w', h') = (w, h - messageSpace)++  let exitLoc = (w' - 1, h' `div` 2)+  let rLoc = exitLoc+  let entranceLoc = (0, h' `div` 2)++  d <- generateDungeon w' h'++  let g = Game {+        dungeon = d,+        messages = ["Get to the safehouse on the other side."],+        rogueLoc = rLoc,+        safehouseExitLoc = exitLoc,+        safehouseEntranceLoc = entranceLoc+        }++  let g' = placeMonster g rLoc defaultRogue++  placeMonsters g' (replicate (commonZombies g) zombie)++restart :: IO ()+restart = newGame >>= loop++main :: IO ()+main = do+  startCharm+  restart+  endCharm