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           -- spawn = simSet next (ChunkData Water) 5 0
  56
  57 -- takes in list of valid chunks, as well as the sim to modify
  58 -- updateWaterChunk x y valid sim | trace ("x:" ++ show x ++ " y:" ++ show y ++ " " ++ show valid) False = undefined
  59 updateWaterChunk x y valid sim =
  60     -- if the chunk below is free, fall straight down
  61     if elem (0,1) valid && fromEnum (simGetChunkType sim x (y+1)) == fromEnum Air
  62         then
  63             let moved = simSet sim ChunkData { chunkType=Air } x y
  64             in simSet moved ChunkData { chunkType=Water } x (y+1)
  65     else if elem (-1,1) valid && fromEnum (simGetChunkType sim (x-1) (y+1)) == fromEnum Air
  66         then
  67             let moved = simSet sim ChunkData { chunkType=Air } x y
  68             in simSet moved ChunkData { chunkType=Water } (x-1) (y+1)
  69     else if elem (1,1) valid && fromEnum (simGetChunkType sim (x+1) (y+1)) == fromEnum Air
  70         then
  71             let moved = simSet sim ChunkData { chunkType=Air } x y
  72             in simSet moved ChunkData { chunkType=Water } (x+1) (y+1)
  73     else if elem (-1,0) valid && fromEnum (simGetChunkType sim (x-1) y) == fromEnum Air
  74         then
  75             let moved = simSet sim ChunkData { chunkType=Air } x y
  76             in simSet moved ChunkData { chunkType=Water } (x-1) y
  77     else if elem (1,0) valid && fromEnum (simGetChunkType sim (x+1) y) == fromEnum Air
  78         then
  79             let moved = simSet sim ChunkData { chunkType=Air } x y
  80             in simSet moved ChunkData { chunkType=Water } (x+1) y
  81     -- stay put
  82     else sim
  83
  84 updatePumpChunk x y valid sim =
  85     if elem (0,1) valid && fromEnum (simGetChunkType sim x (y+1)) == fromEnum Air
  86         then simSet sim ChunkData { chunkType=Water } x (y+1)
  87     else if elem (-1,0) valid && fromEnum (simGetChunkType sim (x-1) y) == fromEnum Air
  88         then simSet sim ChunkData { chunkType=Water } (x-1) y
  89     else if elem (1,0) valid && fromEnum (simGetChunkType sim (x+1) y) == fromEnum Air
  90         then simSet sim ChunkData { chunkType=Water } (x+1) y
  91     else sim
  92
  93 updateDrainChunk x y valid sim =
  94     if elem (0,1) valid && fromEnum (simGetChunkType sim x (y+1)) == fromEnum Water
  95         then simSet sim ChunkData { chunkType=Air } x (y+1)
  96     else if elem (0,-1) valid && fromEnum (simGetChunkType sim x (y-1)) == fromEnum Water
  97         then simSet sim ChunkData { chunkType=Air } x (y-1)
  98     else if elem (1,0) valid && fromEnum (simGetChunkType sim (x+1) y) == fromEnum Water
  99         then simSet sim ChunkData { chunkType=Air } (x+1) y
 100     else if elem (-1,0) valid && fromEnum (simGetChunkType sim (x-1) y) == fromEnum Water
 101         then simSet sim ChunkData { chunkType=Air } (x-1) y
 102     else sim
 103
 104 -- gets chunks around a given chunk that are inside grid
 105 -- validDirects x y w h | trace ("w:"++ show w ++ "h:" ++ show h) False = undefined
 106 validDirects x y w h = filter
 107     (\q -> 0 <= (fst q)+x && (fst q)+x < w && 0 <= (snd q)+y && (snd q)+y < h)
 108     [(a,b) | a <- [-1..1], b <- [-1..1], not (a==0 && b==0)]
 109
 110 simToString :: Simulation -> [Char]
 111 simToString sim@Simulation{simW=w} =
 112     let simStr = V.toList $ V.map chunkToChar $ simSpace sim
 113     in insert w '\n' simStr
 114
 115 -- from https://stackoverflow.com/questions/12659562/insert-specific-element-y-after-every-n-elements-in-a-list
 116 insert :: Int -> a -> [a] -> [a]
 117 insert n y xs = countdown n xs where
 118    countdown 0 xs = y:countdown n xs
 119    countdown _ [] = []
 120    countdown m (x:xs) = x:countdown (m-1) xs
 121
 122 -- stringToSim :: [String] -> Simulation
 123 stringToSim strings =
 124     _stringToSim st grid (initSimSpace w h)
 125     where stripped = strings
 126           w = maximum $ [(length s) | s <- stripped]
 127           h = length stripped
 128           grid = [(a,b) | a <- [0..(length stripped)-1], b <- [0..(length $ stripped !! a)-1]]
 129           st = concat stripped
 130
 131 _stringToSim st grid acc =
 132     if null grid || null st then acc
 133     else _stringToSim (tail st) (tail grid) next
 134     where y = fst $ head grid -- not exactly sure why y and x got switched here
 135           x = snd $ head grid
 136           next = simSet acc (charToChunk $ head st) x y
 137
 138 -- maps each chunktype to an ascii character
 139 chunkToChar :: ChunkData -> Char
 140 chunkToChar c =
 141     case chunkType c of
 142         Water -> '~'
 143         Air -> ' '
 144         Wall -> '#'
 145         Pump -> '@'
 146         Drain -> 'O'
 147         _ -> '?'
 148
 149 -- this is redundant, fix this somehow
 150 charToChunk :: Char -> ChunkData
 151 charToChunk c =
 152     ChunkData { chunkType=ctype }
 153     where ctype = if c=='~' then Water
 154                   else if c=='#' then Wall
 155                   else if c=='@' then Pump
 156                   else if c=='O' then Drain
 157                   else Air
 158