1{-# LANGUAGE RankNTypes #-} 2 3module World where 4 5import Control.Monad.ST 6import Control.Monad.State.Strict 7import qualified Data.Vector.Mutable as MV 8import Control.Applicative 9import Prelude 10 11import Types 12 13worldWidth :: M Int 14worldWidth = withWorld $ \w -> 15 MV.length <$> MV.read w 0 16 17worldHeight :: M Int 18worldHeight = withWorld (return . MV.length) 19 20mapWorld :: (Pos -> Char -> M (Maybe Char)) -> M () 21mapWorld f = do 22 height <- worldHeight 23 width <- worldWidth 24 -- Avoid changing the caps of the scroll. 25 forM_ [2..height-3] $ \y -> 26 forM_ [0..width-1] $ \x -> do 27 let pos = (x,y) 28 v <- f pos =<< readWorld pos 29 case v of 30 Just c -> writeWorld pos c 31 Nothing -> return () 32 33-- Writes a Char to a position in the world. 34writeWorld :: Pos -> Char -> M () 35writeWorld = writeS withWorld 36 37writeFlipSide :: Pos -> Char -> M () 38writeFlipSide = writeS withFlipSide 39 40-- Reads a Char from a position in the world. 41readWorld :: Pos -> M Char 42readWorld = readS withWorld 43 44-- Checks bounds. 45readWorldSafe :: Pos -> M (Maybe Char) 46readWorldSafe pos@(x,y) = do 47 maxy <- worldHeight 48 maxx <- worldWidth 49 if x >= maxx || y >= maxy || x < 0 || y < 0 50 then return Nothing 51 else Just <$> readWorld pos 52 53readFlipSide :: Pos -> M Char 54readFlipSide = readS withFlipSide 55 56withWorld :: (World -> ST RealWorld a) -> M a 57withWorld = withS . (. world) 58 59withFlipSide :: (World -> ST RealWorld a) -> M a 60withFlipSide = withS . (. flipSide) 61 62withS :: (S -> ST RealWorld a) -> M a 63withS a = lift . a =<< get 64 65writeS :: forall a. ((Vec2 a -> ST RealWorld ()) -> M ()) -> Pos -> a -> M () 66writeS m (x, y) v = m $ \yv -> do 67 xv <- MV.read yv y 68 MV.write xv x v 69 70readS :: forall a. ((Vec2 a -> ST RealWorld a) -> M a) -> Pos -> M a 71readS m (x, y) = m $ \yv -> do 72 xv <- MV.read yv y 73 MV.read xv x 74