scroll-1.20151219: World.hs

{-# LANGUAGE RankNTypes #-}

module World where

import Control.Monad.ST
import Control.Monad.State.Strict
import qualified Data.Vector.Mutable as MV
import Control.Applicative
import Prelude

import Types

worldWidth :: M Int
worldWidth = withWorld $ \w ->
	MV.length <$> MV.read w 0

worldHeight :: M Int
worldHeight = withWorld (return . MV.length)

mapWorld :: (Pos -> Char -> M (Maybe Char)) -> M ()
mapWorld f = do
	height <- worldHeight
	width <- worldWidth
	-- Avoid changing the caps of the scroll.
	forM_ [2..height-3] $ \y ->
		forM_ [0..width-1] $ \x -> do
			let pos = (x,y)
			v <- f pos =<< readWorld pos
			case v of
				Just c -> writeWorld pos c
				Nothing -> return ()

-- Writes a Char to a position in the world.
writeWorld :: Pos -> Char -> M ()
writeWorld = writeS withWorld

writeFlipSide :: Pos -> Char -> M ()
writeFlipSide = writeS withFlipSide

-- Reads a Char from a position in the world.
readWorld :: Pos -> M Char
readWorld = readS withWorld

-- Checks bounds.
readWorldSafe :: Pos -> M (Maybe Char)
readWorldSafe pos@(x,y) = do
	maxy <- worldHeight
	maxx <- worldWidth
	if x >= maxx || y >= maxy || x < 0 || y < 0
		then return Nothing
		else Just <$> readWorld pos

readFlipSide :: Pos -> M Char
readFlipSide = readS withFlipSide

withWorld :: (World -> ST RealWorld a) -> M a
withWorld = withS . (. world)

withFlipSide :: (World -> ST RealWorld a) -> M a
withFlipSide = withS . (. flipSide)

withS :: (S -> ST RealWorld a) -> M a
withS a = lift . a =<< get

writeS :: forall a. ((Vec2 a -> ST RealWorld ()) -> M ()) -> Pos -> a -> M ()
writeS m (x, y) v = m $ \yv -> do
	xv <- MV.read yv y
	MV.write xv x v

readS :: forall a. ((Vec2 a -> ST RealWorld a) -> M a) -> Pos -> M a
readS m (x, y) = m $ \yv -> do
	xv <- MV.read yv y
	MV.read xv x