initial semi-functional commit, based on http://jamiltron.com/2012/07/Code_Us_Some_Roguelike_in_Haskell.html and http://jamiltron.com/2012/07/Code_Us_Some_Roguelike2.html

Setup.hs

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

some-roguelike.cabal

@@ -0,0 +1,21 @@
+name:                some-roguelike
+version:             0.1.0.0
+synopsis:            Simple project template from stack
+description:         Please see README.md
+homepage:            https://github.com/githubuser/some-roguelike#readme
+license:             BSD3
+license-file:        LICENSE
+author:              Author name here
+maintainer:          example@example.com
+copyright:           2016 Author name here
+category:            Web
+build-type:          Simple
+cabal-version:       >=1.10
+
+executable some-roguelike
+  hs-source-dirs:      src
+  main-is:             Main.hs
+  default-language:    Haskell2010
+  build-depends:       base >= 4.7 && < 5,
+                       ansi-terminal >= 0.6.2.3,
+                       containers

src/Console.hs

@@ -0,0 +1,100 @@
+module Console where
+
+import System.Console.ANSI
+
+import Level
+import Types
+
+
+coordToChar coord (World _ hero lvl _)
+  | hCurrPos hero == coord      = '@'
+  | isAcid        coord lvl     = '~'
+  | isClosedDoor  coord lvl     = '+'
+  | isOpenDoor    coord lvl     = '-'
+  | isDownstairs  coord lvl     = '<'
+  | isGold        coord lvl     = '$'
+  | isPotion      coord lvl     = '!'
+  | isUpstairs    coord lvl     = '>'
+  | isVillain     coord lvl     = 'v'
+  | isWall        coord lvl     = '#'
+  | isWeapon      coord lvl     = ')'
+  | otherwise                   = ' '
+
+
+drawChar '@' = do
+  setSGR [ SetConsoleIntensity BoldIntensity
+         , SetColor Foreground Vivid Blue ]
+  putChar '@'
+drawChar '#' = do
+  setSGR [ SetConsoleIntensity BoldIntensity
+         , SetColor Foreground Vivid Black ]
+  putChar  '#'
+drawChar '!' = do
+  setSGR [ SetConsoleIntensity BoldIntensity
+         , SetColor Foreground Vivid Magenta]
+  putChar '!'
+drawChar '$' = do
+  setSGR [ SetConsoleIntensity BoldIntensity
+         , SetColor Foreground Vivid Yellow ]
+  putChar '$'
+drawChar 'v' = do
+  setSGR [ SetConsoleIntensity BoldIntensity
+         , SetColor Foreground Vivid Red ]
+  putChar 'v'
+drawChar ')' = do
+  setSGR [ SetConsoleIntensity BoldIntensity
+         , SetColor Foreground Vivid Cyan ]
+  putChar ')'
+drawChar '>' = do
+  setSGR [ SetConsoleIntensity BoldIntensity
+         , SetColor Foreground Dull Blue ]
+  putChar '>'
+drawChar '<' = do
+  setSGR [ SetConsoleIntensity BoldIntensity
+         , SetColor Foreground Dull Cyan ]
+  putChar '<'
+drawChar '\n' = do
+  putChar '\n'
+drawChar '+' = do
+  setSGR [ SetConsoleIntensity NormalIntensity
+         , SetColor Foreground Dull Magenta ]
+  putChar '+'
+drawChar '-' = do
+  setSGR [ SetConsoleIntensity NormalIntensity
+         , SetColor Foreground Dull Yellow ]
+  putChar '-'
+drawChar '~' = do
+  setSGR [ SetConsoleIntensity BoldIntensity
+         , SetColor Foreground Vivid Green ]
+  putChar '~'  
+drawChar _ = do
+  setSGR [ SetConsoleIntensity BoldIntensity
+         , SetColor Foreground Vivid Black ]
+  putChar ' '
+
+
+drawCoord world coord = do
+  uncurry (flip setCursorPosition) coord
+  drawChar (coordToChar coord world) 
+  
+  
+drawHero world
+  | newPos == oldPos = return ()
+  | otherwise        = do
+    drawCoord world newPos
+    drawCoord world oldPos
+  where
+    hero   = wHero world
+    newPos = hCurrPos hero
+    oldPos = hOldPos  hero
+  
+
+drawWorld world = do
+  setCursorPosition 0 0
+  mapM_ drawChar (unlines chars)
+  where
+    lvl     = wLevel world
+    (x',y') = lMax lvl
+    chars   = [[coordToChar (x,y) world | x <- [0..x']]
+                                        | y <- [0..y']]
+

src/Level.hs

@@ -0,0 +1,90 @@
+module Level where
+
+import qualified Data.Map  as M
+
+import Types
+
+strsToLevel :: [String] -> Level
+strsToLevel str = foldl populate emptyLevel {lMax=maxXY} asciiMap
+  where
+    asciiMap = concat $ zipWith zip coords str
+    coords   = [[(x, y) | x <- [0..]] | y <- [0..]]
+    maxX     = maximum . map (fst . fst) $ asciiMap
+    maxY     = maximum . map (snd . fst) $ asciiMap
+    maxXY    = (maxX, maxY)
+    populate lvl (coord, tile) =
+      case tile of
+        '#'   -> lvl { lTiles = M.insert coord Wall            t }
+        '>'   -> lvl { lTiles = M.insert coord (St Downstairs) t }
+        '<'   -> lvl { lTiles = M.insert coord (St Upstairs)   t }
+        '+'   -> lvl { lTiles = M.insert coord (Dr Closed)     t }
+        '-'   -> lvl { lTiles = M.insert coord (Dr Open)       t }
+        '~'   -> lvl { lTiles = M.insert coord Acid            t }
+        _     -> lvl
+        where t = lTiles lvl
+
+isAcid coord lvl = case M.lookup coord (lTiles lvl) of
+  Just Acid -> True
+  _         -> False
+
+
+isClosedDoor coord lvl = case M.lookup coord (lTiles lvl) of
+  Just (Dr Closed) -> True
+  _                -> False
+
+
+isOpenDoor coord lvl = case M.lookup coord (lTiles lvl) of
+  Just (Dr Open) -> True
+  _              -> False
+
+
+isWall coord lvl = case M.lookup coord (lTiles lvl) of
+  Just Wall -> True
+  _         -> False
+
+
+isDownstairs coord lvl = case M.lookup coord (lTiles lvl) of
+  Just (St Downstairs) -> True
+  _                    -> False
+
+
+isUpstairs coord lvl = case M.lookup coord (lTiles lvl) of
+  Just (St Upstairs) -> True
+  _                  -> False
+
+
+isGold coord lvl = M.member coord (lGold lvl)
+
+
+isVillain coord lvl = M.member coord (lVillains lvl)
+
+
+isArmor coord lvl = case M.lookup coord (lItems lvl) of
+  Just (Arm _) -> True
+  _            -> False
+
+
+isPotion coord lvl = case M.lookup coord (lItems lvl) of
+  Just (Pot _) -> True
+  _            -> False
+
+
+isWeapon coord lvl = case M.lookup coord (lItems lvl) of
+  Just (Weap _) -> True
+  _             -> False
+
+
+-- default level
+map1   = [ "##############"
+         , "#>           #          ######"
+         , "#            ############    #"
+         , "#            -          +    #"
+         , "#    ~~      ############    #"
+         , "#     ~~     #          #    #"
+         , "#      ~~    #          # <  #"
+         , "##############          ######" ]
+            
+
+level1 = strsToLevel map1
+
+

src/Main.hs

@@ -0,0 +1,84 @@
+module Main where
+
+import Prelude hiding (Either(..))
+import System.Console.ANSI
+import System.IO
+
+import Console
+import Level
+import Types
+
+
+-- operator to add 2 coordinates together
+(|+|) :: Coord -> Coord -> Coord
+(|+|) (x1, y1) (x2, y2) = (x1 + x2, y1 + y2)
+
+dirToCoord Up    = (0, -1)
+dirToCoord Down  = (0,  1)
+dirToCoord Left  = (-1, 0)
+dirToCoord Right = (1,  0)
+
+
+main = do
+  hSetEcho stdin False
+  hSetBuffering stdin  NoBuffering
+  hSetBuffering stdout NoBuffering
+  hideCursor
+  setTitle "Thieflike"
+  clearScreen
+  let world = genesis { wLevel = level1, wLevels = [level1] }
+  drawWorld world
+  gameLoop world
+
+
+-- update the game loop to add in the goodbye message
+gameLoop world = do
+  drawHero world
+  input <- getInput
+  case input of
+    Exit    -> handleExit
+    Dir dir -> handleDir world dir
+
+
+
+-- receive a character and return our Input data structure,
+-- recursing on invalid input
+getInput = do
+  char <- getChar
+  case char of
+    'q' -> return Exit
+    'w' -> return (Dir Up)
+    's' -> return (Dir Down)
+    'a' -> return (Dir Left)
+    'd' -> return (Dir Right)
+    _ -> getInput
+
+
+
+
+
+handleDir w dir
+  | isWall coord lvl ||
+    isClosedDoor coord lvl = gameLoop w { wHero = h { hOldPos = hCurrPos h } }
+  | otherwise              = gameLoop w { wHero = h { hOldPos  = hCurrPos h
+                                                    , hCurrPos = coord } }
+  where
+    h              = wHero w
+    lvl            = wLevel w
+    coord          = (newX, newY)
+    newX           = hConst heroX
+    newY           = hConst heroY
+    (heroX, heroY) = hCurrPos h |+| dirToCoord dir
+    hConst i       = max 0 (min i 80)
+
+
+-- when the user wants to exit we give them a thank you
+-- message and then reshow the cursor
+handleExit = do
+  clearScreen
+  setCursorPosition 0 0
+  showCursor
+  setSGR [ Reset ]
+  putStrLn "Thank you for playing!"
+
+

src/Types.hs

@@ -0,0 +1,116 @@
+module Types where
+
+import qualified Data.Map as M
+
+type Coord = (Int, Int)
+
+-- foul beasts
+data Villain = Villain { vCurrPos :: Coord
+                       , vGold    :: Int
+                       , vHP      :: Int
+                       , vItems   :: [Item]
+                       , vOldPos  :: Coord }
+
+data Item = Arm Armor
+          | Pot Potion
+          | Weap Weapon
+
+
+data Armor = Armor { aDefense :: Int
+                   , aDest    :: String }
+
+
+data Potion = Potion { pAmount :: Int
+                     , pDesc   :: String
+                     , pEffect :: Effect }
+
+
+data Effect = Harm
+            | Heal
+
+
+data Weapon = Weapon { wDamage :: Int
+                     , wDesc   :: String
+                     , wToHit  :: Int }
+
+data Tile = Acid
+          | Dr   Door
+          | St   Stairs
+          | Wall 
+
+
+data Door = Closed
+          | Open
+
+
+data Stairs = Downstairs
+            | Upstairs
+
+data Input = Dir Direction
+           | Exit
+
+
+data Direction = Up
+               | Down
+               | Left
+               | Right
+
+
+data Hero = Hero { hCurrPos :: Coord   
+                 , hGold    :: Int    
+                 , hHP      :: Int    
+                 , hItems   :: [Item] 
+                 , hOldPos  :: Coord  
+                 , hWield   :: Weapon 
+                 , hWears   :: Armor  }
+
+
+data Level = Level { lDepth    :: Int                   
+                   , lGold     :: M.Map Coord Int  
+                   , lItems    :: M.Map Coord Item 
+                   , lMapped   :: M.Map Coord Bool
+                   , lMax      :: Coord            
+                   , lTiles    :: M.Map Coord Tile 
+                   , lVillains :: M.Map Coord Villain } 
+
+
+data World = World { wDepth  :: Int
+                   , wHero   :: Hero     
+                   , wLevel  :: Level    
+                   , wLevels :: [Level] }
+
+-- default values
+
+emptyLevel = Level { lDepth    = 0
+                   , lGold     = M.empty
+                   , lItems    = M.empty
+                   , lMapped   = M.fromList [((1,1), True)]
+                   , lMax      = (1,1)  
+                   , lTiles    = M.empty
+                   , lVillains = M.empty }
+
+
+-- bare fists/no weapon
+fists = Weapon 0 "Bare fists" 0
+
+
+-- no armor
+rags = Armor 0 "Rags"
+
+
+-- a basic world used to start the game
+genesis  = World { wDepth  = 0
+           , wHero   = commoner  
+           , wLevel  = emptyLevel
+           , wLevels = [emptyLevel] }  -- all levels
+
+
+-- a basic hero
+commoner = Hero { hCurrPos = (1,1)
+                , hGold   = 0  
+                , hHP     = 10 
+                , hItems  = [] 
+                , hOldPos = (1,1)
+                , hWield  = fists
+                , hWears  = rags }
+

stack.yaml

@@ -0,0 +1,66 @@
+# This file was automatically generated by 'stack init'
+# 
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# http://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+# 
+# resolver: lts-3.5
+# resolver: nightly-2015-09-21
+# resolver: ghc-7.10.2
+# resolver: ghcjs-0.1.0_ghc-7.10.2
+# resolver:
+#  name: custom-snapshot
+#  location: "./custom-snapshot.yaml"
+resolver: lts-7.1
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+# 
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+# - location:
+#    git: https://github.com/commercialhaskell/stack.git
+#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+#   extra-dep: true
+#  subdirs:
+#  - auto-update
+#  - wai
+# 
+# A package marked 'extra-dep: true' will only be built if demanded by a
+# non-dependency (i.e. a user package), and its test suites and benchmarks
+# will not be run. This is useful for tweaking upstream packages.
+packages:
+- '.'
+# Dependency packages to be pulled from upstream that are not in the resolver
+# (e.g., acme-missiles-0.3)
+extra-deps: []
+
+# Override default flag values for local packages and extra-deps
+flags: {}
+
+# Extra package databases containing global packages
+extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+# 
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=1.1"
+# 
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+# 
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+# 
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor