Tile.hs

{-# LANGUAGE Arrows #-}
module Tile where

import Control.Arrow
import Control.Monad (void)
import FRP.Yampa
import Graphics.UI.SDL (Rect(..), blitSurface, Surface)

data Tile = Tile !Rect Bool
          | AnimatedTile ![Rect] Bool

parallel f = proc xs -> do{ case xs of [] -> returnA -< [] ; (h:ts) -> arr (uncurry (:)) <<< f *** parallel f -< (h, ts) }

curRects :: SF [Tile] [Rect]
curRects = proc ts -> do
        rec
            i <- delay 0.2 0 -< i + 1
        returnA -< map (rects i) ts
    where
        rects _ (Tile r _) = r
        rects i (AnimatedTile rs _) = cycle rs !! i

walkable :: Tile -> Bool
walkable (Tile _ w) = w
walkable (AnimatedTile _ w) = w

drawTiles :: SF [Tile] (Surface -> Surface -> [(Int, Int)] -> IO ())
drawTiles = proc t -> do
        rs <- curRects -< t
        returnA -< \src dst -> sequence_ . zipWith ($) (map (drawTile' src dst) rs)
    where drawTile' sSrc sDst (Rect sx sy w h) (x,y) = void $ blitSurface sSrc (Just $ Rect sx sy w h) sDst (Just $ Rect x y w h)