module FreeGame.UI (
UI(..)
, reUI
, reFrame
, reGame
, 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 Data.BoundingBox
import Control.Monad.Free.Church (F, iterM)
import Control.Monad.Trans.Iter (IterT, foldM)
import Control.Monad (join)
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 ButtonState -> a)
| MouseButtons (Map.Map Int ButtonState -> a)
| MousePosition (Vec2 -> a)
| MouseInWindow (Bool -> a)
| MouseScroll (Vec2 -> a)
| TakeScreenshot (Bitmap -> a)
| Bracket (Frame a)
| SetFPS Double a
| SetTitle String a
| ShowCursor a
| HideCursor a
| ClearColor Color a
| GetFPS (Int -> a)
| ForkFrame (Frame ()) a
| GetBoundingBox (BoundingBox2 -> a)
| SetBoundingBox BoundingBox2 a
deriving Functor
type Game = IterT Frame
type Frame = F UI
reGame :: (FreeGame m, Monad m) => Game a -> m a
reGame = Control.Monad.Trans.Iter.foldM (join . reFrame)
reFrame :: (FreeGame m, Monad m) => Frame a -> m a
reFrame = iterM (join . reUI)
reUI :: FreeGame f => UI a -> f a
reUI (Draw m) = draw m
reUI (PreloadBitmap bmp cont) = cont <$ preloadBitmap bmp
reUI (FromFinalizer m) = fromFinalizer m
reUI (KeyStates cont) = cont <$> keyStates_
reUI (MouseButtons cont) = cont <$> mouseButtons_
reUI (MousePosition cont) = cont <$> globalMousePosition
reUI (MouseInWindow cont) = cont <$> mouseInWindow
reUI (MouseScroll cont) = cont <$> mouseScroll
reUI (TakeScreenshot cont) = cont <$> takeScreenshot
reUI (Bracket m) = bracket m
reUI (SetFPS i cont) = cont <$ setFPS i
reUI (SetTitle t cont) = cont <$ setTitle t
reUI (ShowCursor cont) = cont <$ showCursor
reUI (HideCursor cont) = cont <$ hideCursor
reUI (ClearColor col cont) = cont <$ clearColor col
reUI (GetFPS cont) = cont <$> getFPS
reUI (ForkFrame m cont) = cont <$ forkFrame m
reUI (GetBoundingBox cont) = cont <$> getBoundingBox
reUI (SetBoundingBox bb cont) = cont <$ setBoundingBox bb
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
forkFrame :: Frame () -> m ()
takeScreenshot :: m Bitmap
setFPS :: Double -> m ()
setTitle :: String -> m ()
showCursor :: m ()
hideCursor :: m ()
clearColor :: Color -> m ()
getFPS :: m Int
getBoundingBox :: m BoundingBox2
setBoundingBox :: BoundingBox2 -> m ()
instance FreeGame UI where
draw = Draw
preloadBitmap bmp = PreloadBitmap bmp ()
bracket = Bracket
forkFrame m = ForkFrame m ()
takeScreenshot = TakeScreenshot id
setFPS a = SetFPS a ()
setTitle t = SetTitle t ()
showCursor = ShowCursor ()
hideCursor = HideCursor ()
clearColor c = ClearColor c ()
getFPS = GetFPS id
getBoundingBox = GetBoundingBox id
setBoundingBox s = SetBoundingBox s ()
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)
bitmapOnce x = Draw (bitmapOnce 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)
blendMode m = overDraw (blendMode m)
instance Local UI where
getLocation = Draw getLocation
instance FromFinalizer UI where
fromFinalizer = FromFinalizer
instance Keyboard UI where
keyStates_ = KeyStates id
instance Mouse UI where
globalMousePosition = MousePosition id
mouseButtons_ = MouseButtons id
mouseInWindow = MouseInWindow id
mouseScroll = MouseScroll id