Sim.hs

   1 module Sim (
   2     Simulation, simSpace,
   3     ChunkType, ChunkData, chunkType,
   4     initSimSpace, testSim, physStep, validDirects,
   5     simToString, stringToSim
   6 ) where
   7
   8 import Debug.Trace
   9 import           Data.Vector ((!), (//))
  10 import qualified Data.Vector as V
  11
  12 data Simulation = Simulation
  13     { simSpace          :: V.Vector ChunkData
  14     , simW              :: Int
  15     , simH              :: Int
  16     } deriving (Show)
  17
  18 data ChunkType = Air
  19     | Water
  20     | Wall
  21     | Pump
  22     | Drain deriving (Show, Enum)
  23
  24 data ChunkData = ChunkData
  25     { chunkType         :: ChunkType
  26     } deriving (Show)
  27
  28 -- vec accessors
  29 simGet Simulation{simSpace=s,simW=w} x y = s ! (y*w+x)
  30 simSet sim@Simulation{simSpace=s,simW=w,simH=h} c x y = sim { simSpace = (s // [(y*w+x,c)]) }
  31 simGetChunkType sim x y = chunkType $ simGet sim x y
  32
  33 initSimSpace x y = Simulation
  34     { simSpace = V.replicate (y*x) ChunkData { chunkType=Air }
  35     , simW = x
  36     , simH = y
  37     }
  38
  39 testSim = let a = simSet (initSimSpace 10 10) (ChunkData Water) 5 5
  40           in simSet a (ChunkData Wall) 5 6
  41
  42 physStep sim@Simulation{simW=w,simH=h} = _physStep [(x, y) | x <- [0..w-1], y <- [0..h-1]] sim sim
  43 -- _physStep grid acc sim@Simulation{simSpace=s,simW=w,simH=h} | trace ("" ++ show h) False = undefined
  44 _physStep grid acc sim@Simulation{simSpace=s,simW=w,simH=h} =
  45     if null grid then acc
  46     else _physStep (tail grid) next sim
  47     where x = fst $ head grid
  48           y = snd $ head grid
  49           valid = validDirects x y w h
  50           next = case simGetChunkType sim x y of
  51               Water -> updateWaterChunk x y valid acc
  52               Pump -> updatePumpChunk x y valid acc
  53               Drain -> updateDrainChunk x y valid acc
  54               _ -> acc
  55
  56 -- template for update functions
  57 updateScaffolder x y valid sim directs cond exec =
  58     if null directs then sim
  59     else if cond (head directs) then exec (head directs)
  60     else updateScaffolder x y valid sim (tail directs) cond exec
  61
  62 updateWaterChunk x y valid sim = updateScaffolder x y valid sim
  63     [(0,1),(-1,1),(1,1),(-1,0),(1,0)]
  64     (\qd ->
  65         elem qd valid &&
  66         fromEnum (simGetChunkType sim ((+) x $ fst qd) ((+) y $ snd qd)) == fromEnum Air
  67     )
  68     (\qd -> simSet
  69         (simSet sim ChunkData { chunkType=Air } x y)
  70         ChunkData { chunkType=Water }
  71         ((+) x $ fst qd)
  72         ((+) y $ snd qd)
  73     )
  74
  75 updatePumpChunk x y valid sim = updateScaffolder x y valid sim
  76     [(0,1),(-1,0),(1,0)]
  77     (\qd ->
  78         elem qd valid &&
  79         fromEnum (simGetChunkType sim ((+) x $ fst qd) ((+) y $ snd qd)) == fromEnum Air
  80     )
  81     (\qd -> simSet sim ChunkData { chunkType=Water } ((+) x $ fst qd) ((+) y $ snd qd))
  82
  83 updateDrainChunk x y valid sim = updateScaffolder x y valid sim
  84     [(0,1),(0,-1),(-1,0),(1,0)]
  85     (\qd ->
  86         elem qd valid &&
  87         fromEnum (simGetChunkType sim ((+) x $ fst qd) ((+) y $ snd qd)) == fromEnum Water
  88     )
  89     (\qd -> simSet sim ChunkData { chunkType=Air } ((+) x $ fst qd) ((+) y $ snd qd))
  90
  91 -- gets chunks around a given chunk that are inside grid
  92 -- validDirects x y w h | trace ("w:"++ show w ++ "h:" ++ show h) False = undefined
  93 validDirects x y w h = filter
  94     (\q -> 0 <= (fst q)+x && (fst q)+x < w && 0 <= (snd q)+y && (snd q)+y < h)
  95     [(a,b) | a <- [-1..1], b <- [-1..1], not (a==0 && b==0)]
  96
  97 simToString :: Simulation -> [Char]
  98 simToString sim@Simulation{simW=w} =
  99     let simStr = V.toList $ V.map chunkToChar $ simSpace sim
 100     in insert w '\n' simStr
 101
 102 -- from https://stackoverflow.com/questions/12659562/insert-specific-element-y-after-every-n-elements-in-a-list
 103 insert :: Int -> a -> [a] -> [a]
 104 insert n y xs = countdown n xs where
 105    countdown 0 xs = y:countdown n xs
 106    countdown _ [] = []
 107    countdown m (x:xs) = x:countdown (m-1) xs
 108
 109 -- stringToSim :: [String] -> Simulation
 110 stringToSim strings =
 111     _stringToSim st grid (initSimSpace w h)
 112     where stripped = strings
 113           w = maximum $ [(length s) | s <- stripped]
 114           h = length stripped
 115           grid = [(a,b) | a <- [0..(length stripped)-1], b <- [0..(length $ stripped !! a)-1]]
 116           st = concat stripped
 117
 118 _stringToSim st grid acc =
 119     if null grid || null st then acc
 120     else _stringToSim (tail st) (tail grid) next
 121     where y = fst $ head grid -- not exactly sure why y and x got switched here
 122           x = snd $ head grid
 123           next = simSet acc (charToChunk $ head st) x y
 124
 125 -- maps each chunktype to an ascii character
 126 chunkToChar :: ChunkData -> Char
 127 chunkToChar c =
 128     case chunkType c of
 129         Water -> '~'
 130         Air -> ' '
 131         Wall -> '#'
 132         Pump -> '@'
 133         Drain -> 'O'
 134         _ -> '?'
 135
 136 -- this is redundant, fix this somehow
 137 charToChunk :: Char -> ChunkData
 138 charToChunk c =
 139     ChunkData { chunkType=ctype }
 140     where ctype = if c=='~' then Water
 141                   else if c=='#' then Wall
 142                   else if c=='@' then Pump
 143                   else if c=='O' then Drain
 144                   else Air
 145