module Graphics.FreeGame.Base (
Game
,GameAction(..)
,tick
,embedIO
,bracket
,quitGame
,Vec2(..)
,Color(..)
,Picture(..)
,transPicture
,drawPicture
,getButtonState
,getMousePosition
,getMouseWheel
,GameParam(..)
,defaultGameParam
,getCurrentGameParam
,askInput
,getMouseState
) where
import Control.Monad.Free
import Control.Monad
import Graphics.FreeGame.Data.Color
import Graphics.FreeGame.Data.Bitmap
import Graphics.FreeGame.Input
import Graphics.FreeGame.Internal.Finalizer
import Control.Monad.IO.Class
import Data.Vect
import Data.Void
infixr 5 `Translate`
infixr 5 `Rotate`
infixr 5 `Scale`
infixr 5 `Colored`
type Game = Free GameAction
instance MonadIO Game where
liftIO = embedIO
data GameAction a
= Tick a
| EmbedIO (IO a)
| Bracket (Game a)
| DrawPicture Picture a
| GetButtonState Button (Bool -> a)
| GetMousePosition (Vec2 -> a)
| GetMouseWheel (Int -> a)
| GetGameParam (GameParam -> a)
| QuitGame
deriving Functor
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 Void
quitGame = wrap QuitGame
drawPicture :: MonadFree GameAction m => Picture -> m ()
drawPicture pic = wrap $ DrawPicture pic (return ())
getButtonState :: MonadFree GameAction m => Button -> m Bool
getButtonState key = wrap $ GetButtonState key return
getMouseWheel :: MonadFree GameAction m => m Int
getMouseWheel = wrap $ GetMouseWheel return
getMousePosition :: MonadFree GameAction m => m Vec2
getMousePosition = wrap $ GetMousePosition return
getCurrentGameParam :: MonadFree GameAction m => m GameParam
getCurrentGameParam = wrap $ GetGameParam return
transPicture :: (Picture -> Picture) -> GameAction cont -> GameAction cont
transPicture f (DrawPicture p cont) = DrawPicture (f p) cont
transPicture _ x = x
data Picture
= Bitmap Bitmap
| BitmapPicture Bitmap
| Pictures [Picture]
| PictureWithFinalizer (FinalizerT 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
, windowOrigin :: Vec2
} deriving Show
defaultGameParam :: GameParam
defaultGameParam = GameParam 60 (640,480) "free-game" True True white (Vec2 0 0)
getMouseState :: MonadFree GameAction m => m MouseState
getMouseState = MouseState
`liftM` getMousePosition
`ap` askInput MouseLeft
`ap` askInput MouseMiddle
`ap` askInput MouseRight
`ap` getMouseWheel
askInput :: MonadFree GameAction m => Button -> m Bool
askInput = getButtonState