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