module FreeGame.UI (
UI(..)
, Frame
, Game
, FreeGame(..)
) where
import FreeGame.Class
import FreeGame.Internal.Finalizer
import FreeGame.Types
import Control.Applicative
import qualified Data.Map as Map
import FreeGame.Data.Bitmap (Bitmap)
import Data.Color
import Control.Monad.Free.Church
import Control.Monad.Trans.Iter
data UI a =
Draw (forall m. (Applicative m, Monad m, Picture2D m, Local m) => m a)
| PreloadBitmap Bitmap a
| FromFinalizer (FinalizerT IO a)
| KeyStates (Map.Map Key Bool -> Map.Map Key Bool -> a)
| MouseButtons (Map.Map Int Bool -> Map.Map Int Bool -> a)
| MousePosition (Vec2 -> a)
| TakeScreenshot (Bitmap -> a)
| Bracket (Frame a)
| SetFPS Int a
| SetTitle String a
| ShowCursor a
| HideCursor a
| ClearColor Color a
| GetFPS (Int -> a)
deriving Functor
type Game = IterT Frame
type Frame = F UI
class (Picture2D m, Local m, Keyboard m, Mouse m, FromFinalizer m) => FreeGame m where
draw :: (forall f. (Applicative f, Monad f, Picture2D f, Local f) => f a) => m a
preloadBitmap :: Bitmap -> m ()
bracket :: Frame a -> m a
takeScreenshot :: m Bitmap
setFPS :: Int -> m ()
setTitle :: String -> m ()
showCursor :: m ()
hideCursor :: m ()
clearColor :: Color -> m ()
getFPS :: m Int
instance FreeGame UI where
draw = Draw
preloadBitmap bmp = PreloadBitmap bmp ()
bracket = Bracket
takeScreenshot = TakeScreenshot id
setFPS a = SetFPS a ()
setTitle t = SetTitle t ()
showCursor = ShowCursor ()
hideCursor = HideCursor ()
clearColor c = ClearColor c ()
getFPS = GetFPS id
overDraw :: (forall m. (Applicative m, Monad m, Picture2D m, Local m) => m a -> m a) -> UI a -> UI a
overDraw f (Draw m) = Draw (f m)
overDraw _ x = x
instance Affine UI where
translate v = overDraw (translate v)
rotateR t = overDraw (rotateR t)
rotateD t = overDraw (rotateD t)
scale v = overDraw (scale v)
instance Picture2D UI where
bitmap x = Draw (bitmap x)
line vs = Draw (line vs)
polygon vs = Draw (polygon vs)
polygonOutline vs = Draw (polygonOutline vs)
circle r = Draw (circle r)
circleOutline r = Draw (circleOutline r)
thickness t = overDraw (thickness t)
color c = overDraw (color c)
instance Local UI where
getLocation = Draw getLocation
instance FromFinalizer UI where
fromFinalizer = FromFinalizer
instance Keyboard UI where
keyStates_ = KeyStates (,)
instance Mouse UI where
globalMousePosition = MousePosition id
mouseButtons_ = MouseButtons (,)