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 deriving (Show, Enum)
  21
  22 data ChunkData = ChunkData
  23     { chunkType         :: ChunkType
  24     } deriving (Show)
  25
  26 -- vec accessors
  27 simGet Simulation{simSpace=s,simW=w} x y = s ! (y*w+x)
  28 simSet sim@Simulation{simSpace=s,simW=w,simH=h} c x y = sim { simSpace = (s // [(y*w+x,c)]) }
  29 simGetChunkType sim x y = chunkType $ simGet sim x y
  30
  31 initSimSpace x y = Simulation
  32     { simSpace = V.replicate (y*x) ChunkData { chunkType=Air }
  33     , simW = x
  34     , simH = y
  35     }
  36
  37 testSim = let a = simSet (initSimSpace 10 10) (ChunkData Water) 5 5
  38           in simSet a (ChunkData Wall) 5 6
  39
  40 physStep sim@Simulation{simW=w,simH=h} = _physStep [(x, y) | x <- [0..w-1], y <- [0..h-1]] sim sim
  41 -- _physStep grid acc sim@Simulation{simSpace=s,simW=w,simH=h} | trace ("" ++ show h) False = undefined
  42 _physStep grid acc sim@Simulation{simSpace=s,simW=w,simH=h} =
  43     if null grid then acc
  44     else _physStep (tail grid) next sim
  45     where x = fst $ head grid
  46           y = snd $ head grid
  47           valid = validDirects x y w h
  48           next = case simGetChunkType sim x y of
  49               Water -> updateWaterChunk x y valid acc
  50               _ -> acc
  51           -- spawn = simSet next (ChunkData Water) 5 0
  52
  53 -- takes in list of valid chunks, as well as the sim to modify
  54 -- updateWaterChunk x y valid sim | trace ("x:" ++ show x ++ " y:" ++ show y ++ " " ++ show valid) False = undefined
  55 updateWaterChunk x y valid sim =
  56     -- if the chunk below is free, fall straight down
  57     if elem (0,1) valid && fromEnum (simGetChunkType sim x (y+1)) == fromEnum Air
  58         then
  59             let moved = simSet sim ChunkData { chunkType=Air } x y
  60             in simSet moved ChunkData { chunkType=Water } x (y+1)
  61     else if elem (-1,1) valid && fromEnum (simGetChunkType sim (x-1) (y+1)) == fromEnum Air
  62         then
  63             let moved = simSet sim ChunkData { chunkType=Air } x y
  64             in simSet moved ChunkData { chunkType=Water } (x-1) (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,0) valid && fromEnum (simGetChunkType sim (x-1) y) == fromEnum Air
  70         then
  71             let moved = simSet sim ChunkData { chunkType=Air } x y
  72             in simSet moved ChunkData { chunkType=Water } (x-1) y
  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     -- stay put
  78     else sim
  79
  80 -- gets chunks around a given chunk that are inside grid
  81 -- validDirects x y w h | trace ("w:"++ show w ++ "h:" ++ show h) False = undefined
  82 validDirects x y w h = filter
  83     (\q -> 0 <= (fst q)+x && (fst q)+x < w && 0 <= (snd q)+y && (snd q)+y < h)
  84     [(a,b) | a <- [-1..1], b <- [-1..1], not (a==0 && b==0)]
  85
  86 simToString :: Simulation -> [Char]
  87 simToString sim@Simulation{simW=w} =
  88     let simStr = V.toList $ V.map chunkToChar $ simSpace sim
  89     in insert w '\n' simStr
  90
  91 -- from https://stackoverflow.com/questions/12659562/insert-specific-element-y-after-every-n-elements-in-a-list
  92 insert :: Int -> a -> [a] -> [a]
  93 insert n y xs = countdown n xs where
  94    countdown 0 xs = y:countdown n xs
  95    countdown _ [] = []
  96    countdown m (x:xs) = x:countdown (m-1) xs
  97
  98 -- stringToSim :: [String] -> Simulation
  99 stringToSim strings =
 100     _stringToSim st grid (initSimSpace w h)
 101     where stripped = strings
 102           w = maximum $ [(length s) | s <- stripped]
 103           h = length stripped
 104           grid = [(a,b) | a <- [0..(length stripped)-1], b <- [0..(length $ stripped !! a)-1]]
 105           st = concat stripped
 106
 107 _stringToSim st grid acc =
 108     if null grid || null st then acc
 109     else _stringToSim (tail st) (tail grid) next
 110     where y = fst $ head grid -- not exactly sure why y and x got switched here
 111           x = snd $ head grid
 112           next = simSet acc (charToChunk $ head st) x y
 113
 114 -- maps each chunktype to an ascii character
 115 chunkToChar :: ChunkData -> Char
 116 chunkToChar c =
 117     case chunkType c of
 118         Water -> '~'
 119         Air -> ' '
 120         Wall -> '#'
 121         _ -> '?'
 122
 123 -- this is redundant, fix this somehow
 124 charToChunk :: Char -> ChunkData
 125 charToChunk c =
 126     ChunkData { chunkType=ctype }
 127     where ctype = if c=='~' then Water
 128                   else if c=='#' then Wall
 129                   else Air
 130