module Graphics.FreeGame.Base (
Game
,GameAction(..)
,tick
,embedIO
,bracket
,quitGame
,Vec2(..)
,Picture(..)
,transPicture
,drawPicture
,askInput
,getMouseState
,GameParam(..)
,defaultGameParam
,loadPicture
) where
import Control.Monad.Free
import Control.Monad
import Graphics.FreeGame.Data.Color
import Graphics.FreeGame.Data.Bitmap
import Graphics.FreeGame.Input
import Data.Vect
infixr 5 `Translate`
infixr 5 `Rotate`
infixr 5 `Scale`
infixr 5 `Colored`
type Game = Free GameAction
data GameAction a
= Tick a
| EmbedIO (IO a)
| Bracket (Game a)
| DrawPicture Picture a
| AskInput Key (Bool -> a)
| GetMouseState (MouseState -> a)
| QuitGame
instance Functor GameAction where
fmap f (DrawPicture a cont) = DrawPicture 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)
fmap _ QuitGame = QuitGame
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
quitGame :: MonadFree GameAction m => m a
quitGame = wrap QuitGame
drawPicture :: MonadFree GameAction m => Picture -> m ()
drawPicture pic = wrap $ DrawPicture pic (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
= BitmapPicture Bitmap
| Pictures [Picture]
| IOPicture (IO Picture)
| Rotate Float Picture
| Scale Vec2 Picture
| Translate Vec2 Picture
| Colored Color Picture
data GameParam = GameParam {
framePerSecond :: Int
,windowSize :: (Int, Int)
,windowTitle :: String
,windowed :: Bool
,cursorVisible :: Bool
,clearColor :: Color
}
defaultGameParam :: GameParam
defaultGameParam = GameParam 60 (640,480) "free-game" True True white
loadPicture :: MonadFree GameAction m => Bitmap -> m Picture
loadPicture = return . BitmapPicture