module Graphics.FreeGame.Base (
Game
,GameAction(..)
,GameParam(..)
,Picture(..)
,transPicture
,defaultGameParam
,tick
,drawPicture
,loadPicture
,askInput
,getMouseState
,embedIO
,bracket
) where
import Control.Monad.Free
import Control.Monad.Trans.Free (FreeT)
import Control.Monad
import Graphics.FreeGame.Bitmap
import Graphics.FreeGame.Input
import Data.Unique
import Data.Vect
type Game = Free GameAction
data GameAction cont
= Tick cont
| EmbedIO (IO cont)
| Bracket (Game cont)
| DrawPicture Picture cont
| LoadPicture Bitmap (Picture -> cont)
| AskInput Key (Bool -> cont)
| GetMouseState (MouseState -> cont)
instance Functor GameAction where
fmap f (DrawPicture a cont) = DrawPicture a (f cont)
fmap f (LoadPicture a cont) = LoadPicture a (f . cont)
fmap f (AskInput a cont) = AskInput a (f . cont)
fmap f (GetMouseState cont) = GetMouseState (f . cont)
fmap f (EmbedIO m) = EmbedIO (fmap f m)
fmap f (Bracket m) = Bracket (fmap f m)
fmap f (Tick cont) = Tick (f cont)
tick :: MonadFree GameAction m => m ()
tick = wrap $ Tick (return ())
embedIO :: MonadFree GameAction m => IO a -> m a
embedIO m = wrap $ EmbedIO $ liftM return m
bracket :: MonadFree GameAction m => Game a -> m a
bracket m = wrap $ Bracket $ liftM return m
drawPicture :: MonadFree GameAction m => Picture -> m ()
drawPicture pic = wrap $ DrawPicture pic (return ())
loadPicture :: MonadFree GameAction m => Bitmap -> m Picture
loadPicture img = wrap $ LoadPicture img return
askInput :: MonadFree GameAction m => Key -> m Bool
askInput key = wrap $ AskInput key return
getMouseState :: MonadFree GameAction m => m MouseState
getMouseState = wrap $ GetMouseState return
transPicture :: (Picture -> Picture) -> GameAction cont -> GameAction cont
transPicture f (DrawPicture p cont) = DrawPicture (f p) cont
transPicture _ x = x
data Picture
= Image Unique
| Pictures [Picture]
| Rotate Float Picture
| Scale Vec2 Picture
| Translate Vec2 Picture
data GameParam = GameParam {
framePerSecond :: Int
,windowSize :: (Int, Int)
,windowTitle :: String
,windowed :: Bool
}
defaultGameParam :: GameParam
defaultGameParam = GameParam 60 (640,480) "free-game" True