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