free-game 1.1.90 → 1.2

raw patch · 17 files changed

+272/−600 lines, 17 filesdep +free-gamedep +resourcetdep −reflectiondep ~basedep ~freedep ~freetype2new-component:exe:demonew-component:exe:demo-statefulnew-component:exe:fibnew-component:exe:helloworld

Dependencies added: free-game, resourcet

Dependencies removed: reflection

Dependency ranges changed: base, free, freetype2, lens, mtl, transformers, vector

Files

• CHANGELOG.md +7/−0
• FreeGame.hs +19/−32
• FreeGame/Backend/GLFW.hs +97/−135
• FreeGame/Class.hs +2/−18
• FreeGame/Data/Bitmap.hs +0/−3
• FreeGame/Data/Font.hs +11/−13
• FreeGame/Instances.hs +0/−63
• FreeGame/Internal/Finalizer.hs +0/−51
• FreeGame/Internal/GLFW.hs +7/−10
• FreeGame/Text.hs +5/−4
• FreeGame/UI.hs +36/−190
• FreeGame/Util.hs +12/−35
• examples/demo.hs +9/−9
• examples/demo_stateful.hs +24/−23
• examples/fib.hs +3/−3
• examples/helloworld.hs +1/−1
• free-game.cabal +39/−10

@@ -1,3 +1,10 @@+1.2
+---------------------------------------------------------------------
+
+* Removed `Drawable`, `reGame` and `reFrame`
+* Removed `FromFinalizer` and `embedIO` in favour of `MonadResource` and `liftIO`
+* Thoroughly cleaned up the codebase
+
 1.1.80
 ---------------------------------------------------------------------
 * Added `mouseScroll`

@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE GeneralisedNewtypeDeriving #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  FreeGame
@@ -11,10 +11,9 @@ ----------------------------------------------------------------------------
 module FreeGame
   ( -- * Game
-    Game,
+    Game(..),
     runGame,
     runGameDefault,
-    reGame,
     WindowMode(..),
     BoundingBox2,
     Box(..),
@@ -26,8 +25,8 @@     untickInfinite,
     -- * Frame
     Frame,
-    reFrame,
     FreeGame(..),
+    liftFrame,
     -- * Transformations
     Vec2,
     Affine(..),
@@ -35,7 +34,6 @@     globalize,
     localize,
     -- * Pictures
-    Drawable,
     Picture2D(..),
     BlendMode(..),
     Bitmap,
@@ -73,8 +71,6 @@     mouseUpR,
     mouseUpM,
     -- * IO
-    FromFinalizer(),
-    embedIO,
     liftIO,
     randomness,
     -- * Utility functions
@@ -95,37 +91,28 @@ 
 ) where
 
-import FreeGame.UI
-import FreeGame.Util
-import FreeGame.Types
-import FreeGame.Text
-import FreeGame.Class
-import FreeGame.Instances ()
-import FreeGame.Data.Bitmap
-import FreeGame.Data.Font
-import qualified FreeGame.Backend.GLFW as GLFW
-import Control.Monad.IO.Class
-import Control.Monad
 import Control.Applicative
 import Control.Bool
+import Control.Monad
+import Control.Monad.IO.Class
+import Control.Monad.Trans
+import Control.Monad.Trans.Iter
+import Data.BoundingBox
 import Data.Color
 import Data.Color.Names
+import FreeGame.Backend.GLFW
+import FreeGame.Class
+import FreeGame.Data.Bitmap
+import FreeGame.Data.Font
+import FreeGame.Instances ()
+import FreeGame.Text
+import FreeGame.Types
+import FreeGame.UI
+import FreeGame.Util
 import Linear
-import Data.BoundingBox
-import Control.Monad.Trans.Iter
 
--- | 'Game' is a kind of procedure but you can also use it like a value.
--- free-game's design is based on free structures, however, you don't have to mind it -- Just apply 'runGame', and enjoy.
---
--- <<http://shared.botis.org/free-game.png>>
---
--- For more examples, see <https://github.com/fumieval/free-game/tree/master/examples>.
-
-runGame :: WindowMode -> BoundingBox2 -> Game a -> IO (Maybe a)
-runGame = GLFW.runGame
+liftFrame :: Frame a -> Game a
+liftFrame = Game . lift
 
 runGameDefault :: Game a -> IO (Maybe a)
 runGameDefault = runGame Windowed (Box (V2 0 0) (V2 640 480))
-
-instance MonadIO Frame where
-    liftIO = embedIO

@@ -1,5 +1,8 @@ {-# LANGUAGE Rank2Types, BangPatterns, ViewPatterns, CPP #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE GeneralisedNewtypeDeriving #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 -----------------------------------------------------------------------------
 -- |
@@ -12,32 +15,26 @@ -- Portability :  non-portable
 --
 ----------------------------------------------------------------------------
-module FreeGame.Backend.GLFW (runGame) where
-import Control.Monad.Free.Church
-import Control.Monad.Trans.Iter
+module FreeGame.Backend.GLFW (Game(..), Frame, runGame) where
+import Control.Lens (view)
 import Control.Monad.IO.Class
 import Control.Monad.Reader
-import Data.IORef
-import Data.Reflection
+import Control.Monad.Trans.Iter
+import Control.Monad.Trans.Resource
 import Data.BoundingBox
+import Data.Functor.Identity
+import Data.IORef
 import FreeGame.Class
 import FreeGame.Data.Bitmap
-import FreeGame.Internal.Finalizer
-import FreeGame.UI
+import FreeGame.Instances ()
 import FreeGame.Types
+import FreeGame.UI
 import Linear
-#if (MIN_VERSION_containers(0,5,0))
 import qualified Data.IntMap.Strict as IM
-#else
-import qualified Data.IntMap as IM
-#endif
 import qualified Data.Map.Strict as Map
 import qualified FreeGame.Internal.GLFW as G
-import qualified Graphics.UI.GLFW as GLFW
 import qualified Graphics.Rendering.OpenGL.GL as GL
-import Unsafe.Coerce
-import Control.Concurrent
-import Control.Lens (view)
+import qualified Graphics.UI.GLFW as GLFW
 
 keyCallback :: IORef (Map.Map Key ButtonState) -> GLFW.Window -> GLFW.Key -> Int -> GLFW.KeyState -> GLFW.ModifierKeys -> IO ()
 keyCallback keyBuffer _ key _ GLFW.KeyState'Pressed _ = modifyIORef' keyBuffer $ Map.adjust buttonDown (toEnum $ fromEnum key)
@@ -52,7 +49,7 @@ mouseEnterCallback ref _ GLFW.CursorState'InWindow = writeIORef ref True
 mouseEnterCallback ref _ GLFW.CursorState'NotInWindow = writeIORef ref False
 
-runGame :: WindowMode -> BoundingBox2 -> IterT (F UI) a -> IO (Maybe a)
+runGame :: WindowMode -> BoundingBox2 -> Game a -> IO (Maybe a)
 runGame mode bbox m = G.withGLFW mode bbox (execGame m)
 
 initialKeyBuffer :: Map.Map Key ButtonState
@@ -61,150 +58,115 @@ initialMouseBuffer :: Map.Map Int ButtonState
 initialMouseBuffer = Map.fromList $ zip [0..7] (repeat Release)
 
-execGame :: IterT (F UI) a -> G.System -> IO (Maybe a)
-execGame m sys = do
-    texs <- newIORef IM.empty
+execGame :: Game a -> G.System -> IO (Maybe a)
+execGame m system = do
+    textureStorage <- newIORef IM.empty
     keyBuffer <- newIORef initialKeyBuffer
     mouseBuffer <- newIORef initialMouseBuffer
     mouseIn <- newIORef True
     scroll <- newIORef (V2 0 0)
-    GLFW.setKeyCallback (G.theWindow sys) $ Just $ keyCallback keyBuffer
-    GLFW.setMouseButtonCallback (G.theWindow sys) $ Just $ mouseButtonCallback mouseBuffer
-    GLFW.setCursorEnterCallback (G.theWindow sys) $ Just $ mouseEnterCallback mouseIn
-    GLFW.setScrollCallback (G.theWindow sys) $ Just $ \_ x y -> modifyIORef scroll (+V2 x y)
-    execFinalizerT
-        $ give (RefKeyStates keyBuffer)
-        $ give (RefMouseButtonStates mouseBuffer)
-        $ give (RefMouseInWindow mouseIn)
-        $ give (TextureStorage texs)
-        $ give scroll
-        $ give sys
-        $ gameLoop m
+    GLFW.setKeyCallback (G.theWindow system) $ Just $ keyCallback keyBuffer
+    GLFW.setMouseButtonCallback (G.theWindow system) $ Just $ mouseButtonCallback mouseBuffer
+    GLFW.setCursorEnterCallback (G.theWindow system) $ Just $ mouseEnterCallback mouseIn
+    GLFW.setScrollCallback (G.theWindow system) $ Just $ \_ x y -> modifyIORef scroll (+V2 x y)
+    let drawLocation = Location id id
+    runResourceT $ gameLoop Env{..} m
 
-gameLoop ::
-    ( Given G.System
-    , Given TextureStorage
-    , Given KeyStates
-    , Given MouseButtonStates
-    , Given MouseInWindow
-    , Given (IORef (V2 Double))
-    ) => IterT (F UI) a -> FinalizerT IO (Maybe a)
-gameLoop m = do
-    liftIO $ G.beginFrame given
+data Env = Env
+    { system :: G.System
+    , textureStorage :: IORef (IM.IntMap G.Texture)
+    , keyBuffer :: IORef (Map.Map Key ButtonState)
+    , mouseBuffer :: IORef (Map.Map Int ButtonState)
+    , mouseIn :: IORef Bool
+    , scroll :: IORef (V2 Double)
+    , drawLocation :: Location ()
+    }
 
-    fs <- liftIO $ newIORef ([] :: [IO ()])
+newtype Game a = Game { unGame :: IterT Frame a }
+    deriving (Functor, Applicative, Monad, MonadIO, Affine, Picture2D, Mouse, Keyboard, FreeGame, Local, MonadFree Identity)
 
-    r <- give fs $ iterM runUI $ runIterT m
+instance MonadResource Game where
+    liftResourceT = Game . lift . liftResourceT
 
+newtype Frame a = Frame { unFrame :: ReaderT Env (ResourceT IO) a }
+    deriving (Functor, Applicative, Monad, MonadResource, MonadIO, MonadReader Env)
+
+gameLoop :: Env -> Game a -> ResourceT IO (Maybe a)
+gameLoop env@Env{..} (Game m0) = flip fix m0 $ \self m -> do
+    liftIO $ G.beginFrame system
+
+    r <- runReaderT (unFrame (runIterT m)) env
+
     b <- liftIO $ do
-        modifyIORef' (getKeyStates given) (Map.map buttonStay)
-        modifyIORef' (getMouseButtonStates given) (Map.map buttonStay)
-        writeIORef given (V2 0 0 :: V2 Double)
-        G.endFrame given
-    liftIO (readIORef fs) >>= finalizer . sequence_
+        modifyIORef' keyBuffer (Map.map buttonStay)
+        modifyIORef' mouseBuffer (Map.map buttonStay)
+        writeIORef scroll (V2 0 0 :: V2 Double)
+        G.endFrame system
 
     if b
         then return Nothing
-        else either (return . Just) gameLoop r
+        else either (return . Just) self r
 
-newtype TextureStorage = TextureStorage { getTextureStorage :: IORef (IM.IntMap G.Texture) }
+withLocation :: (Location () -> Location ()) -> Env -> Env
+withLocation f de = de { drawLocation = f $ drawLocation de }
 
-type DrawM = ReaderT (Location ()) IO
+instance FreeGame Frame where
+    preloadBitmap (Bitmap bmp h) = Frame $ ReaderT $ \Env{..} -> do
+        m <- liftIO $ readIORef textureStorage
+        case IM.lookup h m of
+            Just _ -> return ()
+            Nothing -> do
+                t <- liftIO $ G.installTexture bmp
+                liftIO $ writeIORef textureStorage $ IM.insert h t m
+                void $ register $ G.releaseTexture t >> modifyIORef' textureStorage (IM.delete h)
 
-newtype KeyStates = RefKeyStates { getKeyStates :: IORef (Map.Map Key ButtonState) }
-newtype MouseButtonStates = RefMouseButtonStates { getMouseButtonStates :: IORef (Map.Map Int ButtonState) }
+    takeScreenshot = Frame $ ReaderT $ \Env{..} -> liftIO (G.screenshot system >>= liftBitmapIO)
+    clearColor (V4 r g b a) = liftIO $ GL.clearColor GL.$= GL.Color4 r g b a
+    setTitle str = Frame $ ReaderT $ \Env{..} -> liftIO $ GLFW.setWindowTitle (G.theWindow system) str
+    showCursor = Frame $ ReaderT $ \Env{..} -> liftIO $ GLFW.setCursorInputMode (G.theWindow system) GLFW.CursorInputMode'Normal
+    hideCursor = Frame $ ReaderT $ \Env{..} -> liftIO $ GLFW.setCursorInputMode (G.theWindow system) GLFW.CursorInputMode'Hidden
+    setFPS n = Frame $ ReaderT $ \Env{..} -> liftIO $ writeIORef (G.theFPS system) n
+    getFPS = Frame $ ReaderT $ \Env{..} -> liftIO (readIORef (G.currentFPS system))
+    getBoundingBox = Frame $ ReaderT $ \Env{..} -> liftIO (readIORef (G.refRegion system))
+    setBoundingBox bbox@(view (size zero)-> V2 w h) = Frame $ ReaderT $ \Env{..} -> do
+        liftIO $ GLFW.setWindowSize (G.theWindow system) (floor w) (floor h)
+        liftIO $ writeIORef (G.refRegion system) bbox
 
-newtype MouseInWindow = RefMouseInWindow { getMouseInWindow :: IORef Bool }
+instance Keyboard Frame where
+    keyStates_ = Frame $ ReaderT $ \Env{..} -> liftIO (readIORef keyBuffer)
 
-runUI :: forall a.
-    ( Given G.System
-    , Given TextureStorage
-    , Given KeyStates
-    , Given MouseButtonStates
-    , Given MouseInWindow
-    , Given (IORef [IO ()])
-    , Given (IORef (V2 Double))
-    ) => UI (FinalizerT IO a) -> FinalizerT IO a
-runUI (Draw m) = do
-    (cont, xs) <- liftIO $ do
-        cxt <- newIORef []
-        cont <- give (Context cxt) $ runReaderT (m :: DrawM (FinalizerT IO a)) (Location id id)
-        xs <- readIORef cxt
-        return (cont, xs)
-    unless (null xs) $ finalizer $ forM_ xs $ \(t, h) -> G.releaseTexture t >> modifyIORef' (getTextureStorage given) (IM.delete h)
-    cont
-runUI (FromFinalizer m) = join m
-runUI (PreloadBitmap (Bitmap bmp h) cont) = do
-    m <- liftIO $ readIORef (getTextureStorage given)
-    case IM.lookup h m of
-        Just _ -> return ()
-        Nothing -> do
-            t <- liftIO $ G.installTexture bmp
-            liftIO $ writeIORef (getTextureStorage given) $ IM.insert h t m
-            finalizer $ G.releaseTexture t >> modifyIORef' (getTextureStorage given) (IM.delete h)
-    cont
-runUI (KeyStates cont) = liftIO (readIORef $ getKeyStates given) >>= cont
-runUI (MouseButtons cont) = liftIO (readIORef $ getMouseButtonStates given) >>= cont
-runUI (MousePosition cont) = do
-    (x, y) <- liftIO $ GLFW.getCursorPos (G.theWindow given)
-    cont $ V2 x y
-runUI (MouseScroll cont) = liftIO (readIORef given) >>= cont
-runUI (MouseInWindow cont) = liftIO (readIORef $ getMouseInWindow given) >>= cont
-runUI (Bracket m) = join $ iterM runUI m
-runUI (TakeScreenshot cont) = liftIO (G.screenshot given >>= liftBitmapIO) >>= cont
-runUI (ClearColor col cont) = do
-    liftIO $ GL.clearColor GL.$= unsafeCoerce col
-    cont
-runUI (SetTitle str cont) = do
-    liftIO $ GLFW.setWindowTitle (G.theWindow given) str
-    cont
-runUI (ShowCursor cont) = do
-    liftIO $ GLFW.setCursorInputMode (G.theWindow given) GLFW.CursorInputMode'Normal
-    cont
-runUI (HideCursor cont) = do
-    liftIO $ GLFW.setCursorInputMode (G.theWindow given) GLFW.CursorInputMode'Hidden
-    cont
-runUI (SetFPS n cont) = do
-    liftIO $ writeIORef (G.theFPS given) n
-    cont
-runUI (GetFPS cont) = liftIO (readIORef (G.currentFPS given)) >>= cont
-runUI (ForkFrame m cont) = do
-    _ <- liftIO $ forkIO $ do
-        (_, f) <- runFinalizerT $ iterM runUI m
-        modifyIORef' given (f:)
-    cont
-runUI (GetBoundingBox cont) = liftIO (readIORef (G.refRegion given)) >>= cont
-runUI (SetBoundingBox bbox@(view (size zero)-> V2 w h) cont) = do
-    liftIO $ GLFW.setWindowSize (G.theWindow given) (floor w) (floor h)
-    liftIO $ writeIORef (G.refRegion given) bbox
-    cont
+instance Mouse Frame where
+    mouseButtons_ = Frame $ ReaderT $ \Env{..} -> liftIO (readIORef mouseBuffer)
+    globalMousePosition = Frame $ ReaderT $ \Env{..} -> do
+        (x, y) <- liftIO $ GLFW.getCursorPos (G.theWindow system)
+        pure $ V2 x y
+    mouseScroll = Frame $ ReaderT $ \Env{..} -> liftIO (readIORef scroll)
+    mouseInWindow = Frame $ ReaderT $ \Env{..} -> liftIO (readIORef mouseIn)
 
-mapReaderWith :: (s -> r) -> (m a -> n b) -> ReaderT r m a -> ReaderT s n b
-mapReaderWith f g m = unsafeCoerce $ \s -> g (unsafeCoerce m (f s))
+mapReaderWith :: (Env -> Env) -> (IO a -> IO a) -> Frame a -> Frame a
+mapReaderWith f g m = Frame $ ReaderT $ \s -> transResourceT g (runReaderT (unFrame m) (f s))
 {-# INLINE mapReaderWith #-}
 
-instance Affine DrawM where
-    translate v = mapReaderWith (translate v) (G.translate v)
+instance Affine Frame where
+    translate v = mapReaderWith (withLocation $ translate v) (G.translate v)
     {-# INLINE translate #-}
-    rotateD t = mapReaderWith (rotateD t) (G.rotateD t)
+    rotateD t = mapReaderWith (withLocation $ rotateD t) (G.rotateD t)
     {-# INLINE rotateD #-}
-    rotateR t = let t' = t / pi * 180 in mapReaderWith (rotateR t) (G.rotateD t')
+    rotateR t = let t' = t / pi * 180 in mapReaderWith (withLocation $ rotateR t) (G.rotateD t')
     {-# INLINE rotateR #-}
-    scale v = mapReaderWith (scale v) (G.scale v)
+    scale v = mapReaderWith (withLocation $ scale v) (G.scale v)
     {-# INLINE scale #-}
 
-newtype Context = Context { getContext :: IORef [(G.Texture, Int)] }
-
-instance (Given Context, Given TextureStorage) => Picture2D DrawM where
-    bitmap (Bitmap bmp h) = liftIO $ do
-        m <- readIORef (getTextureStorage given)
+instance Picture2D Frame where
+    bitmap (Bitmap bmp h) = Frame $ ReaderT $ \Env{..} -> do
+        m <- liftIO $ readIORef textureStorage
         case IM.lookup h m of
-            Just t -> G.drawTexture t
+            Just t -> liftIO $ G.drawTexture t
             Nothing -> do
-                t <- G.installTexture bmp
-                writeIORef (getTextureStorage given) $ IM.insert h t m
-                modifyIORef (getContext given) ((t, h) :)
-                G.drawTexture t
+                t <- liftIO $ G.installTexture bmp
+                liftIO $ writeIORef textureStorage $ IM.insert h t m
+                _ <- register $ modifyIORef' textureStorage $ IM.delete h
+                liftIO $ G.drawTexture t
     bitmapOnce (Bitmap bmp _) = liftIO $ do
         t <- G.installTexture bmp
         G.drawTexture t
@@ -227,5 +189,5 @@     blendMode m = mapReaderWith id (G.blendMode m)
     {-# INLINE blendMode #-}
 
-instance Local DrawM where
-    getLocation = asks coerceLocation
+instance Local Frame where
+    getLocation = asks $ coerceLocation . drawLocation

@@ -13,15 +13,10 @@ module FreeGame.Class where
 
 import Linear
-#if !MIN_VERSION_base(4,8,0)
-import Control.Applicative
-#endif
-import Unsafe.Coerce
 import FreeGame.Types
 import FreeGame.Data.Bitmap
-import FreeGame.Internal.Finalizer
 import Data.Color
-import Control.Monad.IO.Class
+import Data.Coerce
 import Control.Bool
 import qualified Data.Map as Map
 
@@ -65,7 +60,7 @@ data Location a = Location (Vec2 -> Vec2) (Vec2 -> Vec2) deriving Functor
 
 coerceLocation :: Location a -> Location b
-coerceLocation = unsafeCoerce
+coerceLocation = coerce
 
 flipLocation :: Location a -> Location b
 flipLocation (Location f g) = Location g f
@@ -193,14 +188,3 @@ 
 mouseUpM :: Mouse f => f Bool
 mouseUpM = mouseUp 2
-
-class FromFinalizer m where
-    fromFinalizer :: FinalizerT IO a -> m a
-
-instance FromFinalizer (FinalizerT IO) where
-    fromFinalizer = id
-
--- | 'liftIO'　variety for 'FromFinalizer'.
-embedIO :: FromFinalizer m => IO a -> m a
-embedIO m = fromFinalizer (liftIO m)
-{-# INLINE embedIO #-}

@@ -33,9 +33,6 @@ import Data.BoundingBox
 import Linear.V2
 import System.Random
-#if !MIN_VERSION_base(4,8,0)
-import Control.Applicative
-#endif
 import Data.Hashable
 
 data Bitmap = Bitmap { bitmapImage :: C.Image C.PixelRGBA8, bitmapHash :: Int }

@@ -21,9 +21,6 @@   , RenderedChar(..)
   ) where
 
-#if !MIN_VERSION_base(4,8,0)
-import Control.Applicative
-#endif
 import Control.Monad.IO.Class
 import Control.Monad
 import Data.IORef
@@ -31,9 +28,8 @@ import qualified Data.Map as M
 import qualified Data.Vector.Storable as V
 import Linear
-import FreeGame.Class
 import FreeGame.Data.Bitmap
-import FreeGame.Internal.Finalizer
+import Control.Monad.Trans.Resource
 import Graphics.Rendering.FreeType.Internal
 import qualified Graphics.Rendering.FreeType.Internal.GlyphSlot as GS
 import qualified Graphics.Rendering.FreeType.Internal.Vector as V
@@ -97,26 +93,28 @@ data RenderedChar = RenderedChar
     { charBitmap :: Bitmap
     , charOffset :: V2 Double
-    ,　charAdvance :: Double
+    , charAdvance :: Double
+    , charReleaseKey :: ReleaseKey
     }
 
 -- | The resolution used to render fonts.
 resolutionDPI :: Int
 resolutionDPI = 300
 
-charToBitmap :: FromFinalizer m => Font -> Double -> Char -> m RenderedChar
-charToBitmap (Font face _ _ refCache) pixel ch = fromFinalizer $ do
+charToBitmap :: Font -> Double -> Char -> ResourceT IO RenderedChar
+charToBitmap (Font face _ _ refCache) pixel ch = do
     let siz = pixel * 72 / fromIntegral resolutionDPI
     cache <- liftIO $ readIORef refCache
     case M.lookup (siz, ch) cache of
         Just d -> return d
         Nothing -> do
-            d <- liftIO $ render face siz ch
-            liftIO $ writeIORef refCache $ M.insert (siz, ch) d cache
-            finalizer $ modifyIORef refCache $ M.delete (siz, ch)
-            return d
+            mkChar <- liftIO $ render face siz ch
+            key <- register $ modifyIORef refCache $ M.delete (siz, ch)
+            let r = mkChar key
+            liftIO $ writeIORef refCache $ M.insert (siz, ch) r cache
+            return r
 
-render :: FT_Face -> Double -> Char -> IO RenderedChar
+render :: FT_Face -> Double -> Char -> IO (ReleaseKey -> RenderedChar)
 render face siz ch = do
     let dpi = fromIntegral resolutionDPI
 

@@ -8,12 +8,7 @@ import Control.Monad.Trans.Reader
 import Control.Monad.Trans.Cont
 import Control.Monad.Trans.Maybe
-import Control.Monad.Trans.List
-#if MIN_VERSION_transformers(0,4,0)
 import Control.Monad.Trans.Except
-#else
-import Control.Monad.Trans.Error
-#endif
 import Control.Monad.Trans.Identity
 import qualified Control.Monad.State.Lazy as Lazy
 import qualified Control.Monad.State.Strict as Strict
@@ -21,9 +16,6 @@ import qualified Control.Monad.Writer.Strict as Strict
 import qualified Control.Monad.Trans.RWS.Strict as Strict
 import qualified Control.Monad.Trans.RWS.Lazy as Lazy
-#if !MIN_VERSION_base(4,8,0)
-import Data.Monoid
-#endif
 import Control.Monad.Free.Church as Church
 import Control.Monad.Free as Free
 import FreeGame.Class
@@ -72,15 +64,9 @@     mouseScroll = (l) mouseScroll; \
     }
 
-#define MK_FROM_FINALIZER(cxt, ty, l) instance (FromFinalizer m cxt) => FromFinalizer (ty) where { \
-    fromFinalizer = (l) . fromFinalizer }
-
 #define MK_FREE_GAME(cxt, ty, l) instance (FreeGame m cxt) => FreeGame (ty) where { \
-    draw = (l) . draw; \
     preloadBitmap = (l) . preloadBitmap; \
     takeScreenshot = (l) takeScreenshot; \
-    bracket m = (l) (bracket m); \
-    forkFrame m = (l) (forkFrame m); \
     setFPS a = (l) (setFPS a); \
     setTitle t = (l) (setTitle t); \
     showCursor = (l) showCursor; \
@@ -103,12 +89,7 @@ MK_AFFINE(, Strict.RWST r w s m, Strict.mapRWST)
 MK_AFFINE(, IdentityT m, mapIdentityT)
 MK_AFFINE(, MaybeT m, mapMaybeT)
-MK_AFFINE(, ListT m, mapListT)
-#if MIN_VERSION_transformers(0,4,0)
 MK_AFFINE(, ExceptT e m, mapExceptT)
-#else
-MK_AFFINE(_COMMA_ Error e, ErrorT e m, mapErrorT)
-#endif
 MK_AFFINE(, ContT r m, mapContT)
 
 MK_PICTURE_2D(_COMMA_ Functor m, F m, Church.liftF, hoistF)
@@ -123,12 +104,7 @@ MK_PICTURE_2D(_COMMA_ Monad m _COMMA_ Monoid w, Strict.RWST r w s m, lift, Strict.mapRWST)
 MK_PICTURE_2D(_COMMA_ Monad m, IdentityT m, lift, mapIdentityT)
 MK_PICTURE_2D(_COMMA_ Monad m, MaybeT m, lift, mapMaybeT)
-MK_PICTURE_2D(_COMMA_ Monad m, ListT m, lift, mapListT)
-#if MIN_VERSION_transformers(0,4,0)
 MK_PICTURE_2D(_COMMA_ Monad m, ExceptT e m, lift, mapExceptT)
-#else
-MK_PICTURE_2D(_COMMA_ Monad m _COMMA_ Error e, ErrorT e m, lift, mapErrorT)
-#endif
 MK_PICTURE_2D(_COMMA_ Monad m, ContT r m, lift, mapContT)
 
 MK_LOCAL(_COMMA_ Functor m, F m, Church.liftF)
@@ -143,12 +119,7 @@ MK_LOCAL(_COMMA_ Monad m _COMMA_ Monoid w, Strict.RWST r w s m, lift)
 MK_LOCAL(_COMMA_ Monad m, IdentityT m, lift)
 MK_LOCAL(_COMMA_ Monad m, MaybeT m, lift)
-MK_LOCAL(_COMMA_ Monad m, ListT m, lift)
-#if MIN_VERSION_transformers(0,4,0)
 MK_LOCAL(_COMMA_ Monad m, ExceptT e m, lift)
-#else
-MK_LOCAL(_COMMA_ Monad m _COMMA_ Error e, ErrorT e m, lift)
-#endif
 MK_LOCAL(_COMMA_ Monad m, ContT r m, lift)
 
 MK_KEYBOARD(_COMMA_ Functor m, F m, Church.liftF)
@@ -163,12 +134,7 @@ MK_KEYBOARD(_COMMA_ Monad m _COMMA_ Monoid w, Strict.RWST r w s m, lift)
 MK_KEYBOARD(_COMMA_ Monad m, IdentityT m, lift)
 MK_KEYBOARD(_COMMA_ Monad m, MaybeT m, lift)
-MK_KEYBOARD(_COMMA_ Monad m, ListT m, lift)
-#if MIN_VERSION_transformers(0,4,0)
 MK_KEYBOARD(_COMMA_ Monad m, ExceptT e m, lift)
-#else
-MK_KEYBOARD(_COMMA_ Monad m _COMMA_ Error e, ErrorT e m, lift)
-#endif
 MK_KEYBOARD(_COMMA_ Monad m, ContT r m, lift)
 
 MK_MOUSE(_COMMA_ Functor m, F m, liftF)
@@ -183,33 +149,9 @@ MK_MOUSE(_COMMA_ Monad m _COMMA_ Monoid w, Strict.RWST r w s m, lift)
 MK_MOUSE(_COMMA_ Monad m, IdentityT m, lift)
 MK_MOUSE(_COMMA_ Monad m, MaybeT m, lift)
-MK_MOUSE(_COMMA_ Monad m, ListT m, lift)
-#if MIN_VERSION_transformers(0,4,0)
 MK_MOUSE(_COMMA_ Monad m, ExceptT e m, lift)
-#else
-MK_MOUSE(_COMMA_ Monad m _COMMA_ Error e, ErrorT e m, lift)
-#endif
 MK_MOUSE(_COMMA_ Monad m, ContT r m, lift)
 
-MK_FROM_FINALIZER(_COMMA_ Functor m, F m, liftF)
-MK_FROM_FINALIZER(_COMMA_ Functor m, Free.Free m, Free.liftF)
-MK_FROM_FINALIZER(_COMMA_ Monad m, IterT m, lift)
-MK_FROM_FINALIZER(_COMMA_ Monad m, Lazy.StateT s m, lift)
-MK_FROM_FINALIZER(_COMMA_ Monad m, Strict.StateT s m, lift)
-MK_FROM_FINALIZER(_COMMA_ Monad m _COMMA_ Monoid w, Lazy.WriterT w m, lift)
-MK_FROM_FINALIZER(_COMMA_ Monad m _COMMA_ Monoid w, Strict.WriterT w m, lift)
-MK_FROM_FINALIZER(_COMMA_ Monad m _COMMA_ Monoid w, Lazy.RWST r w s m, lift)
-MK_FROM_FINALIZER(_COMMA_ Monad m _COMMA_ Monoid w, Strict.RWST r w s m, lift)
-MK_FROM_FINALIZER(_COMMA_ Monad m, IdentityT m, lift)
-MK_FROM_FINALIZER(_COMMA_ Monad m, MaybeT m, lift)
-MK_FROM_FINALIZER(_COMMA_ Monad m, ListT m, lift)
-#if MIN_VERSION_transformers(0,4,0)
-MK_FROM_FINALIZER(_COMMA_ Monad m, ExceptT e m, lift)
-#else
-MK_FROM_FINALIZER(_COMMA_ Monad m _COMMA_ Error e, ErrorT e m, lift)
-#endif
-MK_FROM_FINALIZER(_COMMA_ Monad m, ContT r m, lift)
-
 MK_FREE_GAME(_COMMA_ Functor m, F m, liftF)
 MK_FREE_GAME(_COMMA_ Functor m, Free.Free m, Free.liftF)
 MK_FREE_GAME(_COMMA_ Monad m, IterT m, lift)
@@ -221,10 +163,5 @@ MK_FREE_GAME(_COMMA_ Monad m _COMMA_ Monoid w, Strict.RWST r w s m, lift)
 MK_FREE_GAME(_COMMA_ Monad m, IdentityT m, lift)
 MK_FREE_GAME(_COMMA_ Monad m, MaybeT m, lift)
-MK_FREE_GAME(_COMMA_ Monad m, ListT m, lift)
-#if MIN_VERSION_transformers(0,4,0)
 MK_FREE_GAME(_COMMA_ Monad m, ExceptT e m, lift)
-#else
-MK_FREE_GAME(_COMMA_ Monad m _COMMA_ Error e, ErrorT e m, lift)
-#endif
 MK_FREE_GAME(_COMMA_ Monad m, ContT r m, lift)

@@ -1,51 +0,0 @@-{-# LANGUAGE Rank2Types #-}
-module FreeGame.Internal.Finalizer (FinalizerT(..), finalizer, runFinalizerT, execFinalizerT, mapFinalizerT) where
-
-import Control.Monad.IO.Class
-import Control.Monad.Trans
-#if !MIN_VERSION_base(4,8,0)
-import Control.Applicative
-#endif
-
--- | An action with explicit releasing action.
-newtype FinalizerT m a = FinalizerT
-    { unFinalizerT :: forall r. (a -> m r) -> (IO () -> r -> m r) -> m r }
-
--- | Add a finalizer.
-finalizer :: Monad m => IO () -> FinalizerT m ()
-finalizer m = FinalizerT $ \p f -> p () >>= f m
-
-instance Functor (FinalizerT m) where
-    fmap f (FinalizerT g) = FinalizerT $ \p -> g (p . f)
-
-instance Applicative (FinalizerT m) where
-    pure a = FinalizerT $ \p _ -> p a
-    FinalizerT ff <*> FinalizerT fa = FinalizerT $ \p f -> ff (\a -> fa (\b -> p (a b)) f) f
-
-instance Monad (FinalizerT m) where
-    return a = FinalizerT $ \p _ -> p a
-    FinalizerT rf >>= k = FinalizerT $ \p f -> rf (\x -> unFinalizerT (k x) p f) f
-
-instance MonadIO m => MonadIO (FinalizerT m) where
-    liftIO m = FinalizerT $ \r _ -> liftIO m >>= r
-    {-# INLINE liftIO #-}
-
-instance MonadTrans FinalizerT where
-    lift m = FinalizerT $ \r _ -> m >>= r
-    {-# INLINE lift #-}
-
--- | Run the action and run all associated finalizers.
-runFinalizerT :: Monad m => FinalizerT m a -> m (a, IO ())
-runFinalizerT (FinalizerT z) = z (\a -> return (a, return ())) (\m (r, fs) -> return (r, m >> fs))
-
-execFinalizerT :: MonadIO m => FinalizerT m a -> m a
-execFinalizerT m = do
-    (a, fin) <- runFinalizerT m
-    liftIO fin
-    return a
-
-mapFinalizerT :: (Monad m, Monad n) => (forall x. m x -> n x) -> FinalizerT m a -> FinalizerT n a
-mapFinalizerT t m = FinalizerT $ \p f -> do
-    (a, fin) <- t (runFinalizerT m)
-    r <- p a
-    f fin r

@@ -2,11 +2,9 @@ module FreeGame.Internal.GLFW where
 import Control.Concurrent
 import Control.Bool
-#if !MIN_VERSION_base(4,8,0)
-import Control.Applicative
-#endif
 import Control.Monad.IO.Class
 import Control.Lens
+import Data.Coerce
 import Data.Color
 import Data.IORef
 import FreeGame.Types
@@ -16,7 +14,6 @@ import Linear
 import qualified Graphics.Rendering.OpenGL.GL as GL
 import qualified Graphics.UI.GLFW as GLFW
-import Unsafe.Coerce
 import qualified Data.Vector.Storable as V
 import qualified Data.Vector.Storable.Mutable as MV
 import Codec.Picture
@@ -78,19 +75,19 @@ 
 mkVertex2 :: V2 Double -> GL.Vertex2 GL.GLdouble
 {-# INLINE mkVertex2 #-}
-mkVertex2 = unsafeCoerce
+mkVertex2 (V2 x y) = GL.Vertex2 x y
 
 gf :: Float -> GL.GLfloat
 {-# INLINE gf #-}
-gf = unsafeCoerce
+gf = coerce
 
 gd :: Double -> GL.GLdouble
 {-# INLINE gd #-}
-gd = unsafeCoerce
+gd = coerce
 
 gsizei :: Int -> GL.GLsizei
 {-# INLINE gsizei #-}
-gsizei = unsafeCoerce
+gsizei = fromIntegral
 
 translate :: V2 Double -> IO a -> IO a
 translate (V2 tx ty) m = preservingMatrix' $ GL.translate (GL.Vector3 (gd tx) (gd ty) 0) >> m
@@ -112,9 +109,9 @@     GL.renderPrimitive GL.LineLoop $ runVertices [V2 (cos t * r) (sin t * r) | t <- [0,s..2 * pi]]
 
 color :: Color Float -> IO a -> IO a
-color col m = do
+color (V4 r g b a) m = do
     oldColor <- liftIO $ get GL.currentColor
-    liftIO $ GL.currentColor $= unsafeCoerce col
+    liftIO $ GL.currentColor $= GL.Color4 r g b a
     res <- m
     liftIO $ GL.currentColor $= oldColor
     return res

@@ -8,6 +8,7 @@ import FreeGame.Class
 import FreeGame.Instances ()
 import Control.Monad.Trans.Free
+import Control.Monad.Trans.Resource
 import Control.Monad.State
 import Linear
 
@@ -19,7 +20,7 @@     fromString str = mapM_ (\c -> liftF (TypeChar c ())) str
 
 -- | Render a 'TextT'.
-runTextT :: (FromFinalizer m, Monad m, Picture2D m) => Maybe (Box V2 Double) -> Font -> Double -> TextT m a -> m a
+runTextT :: (MonadResource m, Picture2D m) => Maybe (Box V2 Double) -> Font -> Double -> TextT m a -> m a
 runTextT bbox font siz = flip evalStateT (V2 x0 y0) . go where
     go m = lift (runFreeT m) >>= \r -> case r of
         Pure a -> return a
@@ -28,7 +29,7 @@             _y += advV
             go cont
         Free (TypeChar ch cont) -> do
-            RenderedChar bmp offset adv <- fromFinalizer $ charToBitmap font siz ch
+            RenderedChar bmp offset adv _ <- liftResourceT $ charToBitmap font siz ch
             pen <- get
             translate (pen + offset) $ bitmap bmp
             let pen' = over _x (+adv) pen
@@ -39,10 +40,10 @@     advV = siz * (metricsAscent font - metricsDescent font) * 1.1
     (V2 x0 y0, cond) = maybe (zero, const True) (\b -> (b ^. position zero, flip isInside b)) bbox
 
-runTextT_ :: (FromFinalizer m, Monad m, Picture2D m) => Maybe (Box V2 Double) -> Font -> Double -> TextT m () -> m ()
+runTextT_ :: (MonadResource m, Monad m, Picture2D m) => Maybe (Box V2 Double) -> Font -> Double -> TextT m () -> m ()
 runTextT_ = runTextT
 {-# INLINE runTextT_ #-}
 
 -- | Render a 'String'.
-text :: (FromFinalizer m, Monad m, Picture2D m) => Font -> Double -> String -> m ()
+text :: (MonadResource m, Monad m, Picture2D m) => Font -> Double -> String -> m ()
 text font siz str = runTextT Nothing font siz (fromString str)

@@ -1,190 +1,36 @@-{-# LANGUAGE DeriveFunctor, ExistentialQuantification, Rank2Types, UndecidableInstances #-}
------------------------------------------------------------------------------
--- |
--- Module      :  FreeGame.UI
--- Copyright   :  (C) 2013 Fumiaki Kinoshita
--- License     :  BSD-style (see the file LICENSE)
---
--- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
--- Stability   :  provisional
--- Portability :  non-portable
--- Provides the "free" embodiment.
-----------------------------------------------------------------------------
-module FreeGame.UI (
-    UI(..)
-    , Drawable
-    , reUI
-    , reFrame
-    , reGame
-    , Frame
-    , Game
-    , FreeGame(..)
-) where
-
-import FreeGame.Class
-import FreeGame.Internal.Finalizer
-import FreeGame.Types
-#if !MIN_VERSION_base(4,8,0)
-import Control.Applicative
-#endif
-import qualified Data.Map as Map
-import FreeGame.Data.Bitmap (Bitmap)
-import Data.Color
-import Control.Monad.Free.Church (F, iterM)
-import Control.Monad.Trans.Iter (IterT, foldM)
-import Control.Monad (join)
-
-class (Applicative f, Monad f, Picture2D f, Local f) => Drawable f where { }
-
-instance (Applicative f, Monad f, Picture2D f, Local f) => Drawable f where { }
-
-data UI a =
-    Draw (forall m. Drawable 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 Float) a
-    | GetFPS (Int -> a)
-    | ForkFrame (Frame ()) a
-    | GetBoundingBox (BoundingBox2 -> a)
-    | SetBoundingBox BoundingBox2 a
-    deriving Functor
-
-type Game = IterT Frame
-
-type Frame = F UI
-
--- | Generalize `Game` to any monad based on `FreeGame`.
-reGame :: (FreeGame m, Monad m) => Game a -> m a
-reGame = Control.Monad.Trans.Iter.foldM (join . reFrame)
-{-# RULES "reGame/sameness" reGame = id #-}
-{-# INLINE[1] reGame #-}
-
--- | Generalize `Frame` to any monad based on `FreeGame`.
-reFrame :: (FreeGame m, Monad m) => Frame a -> m a
-reFrame = iterM (join . reUI)
-{-# RULES "reFrame/sameness" reFrame = id #-}
-{-# INLINE[1] reFrame #-}
-
-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
-{-# INLINE[1] reUI #-}
-{-# RULES "reUI/sameness" reUI = id #-}
-
-class (Picture2D m, Local m, Keyboard m, Mouse m, FromFinalizer m) => FreeGame m where
-    -- | Draw an action that consist of 'Picture2D''s methods.
-    draw :: (forall f. Drawable f => f a) -> m a
-    -- | Load a 'Bitmap' to avoid the cost of the first invocation of 'bitmap'.
-    preloadBitmap :: Bitmap -> m ()
-    -- | Run a 'Frame', and release all the matter happened.
-    bracket :: Frame a -> m a
-    -- | Run a 'Frame' action concurrently. Do not use this function to draw pictures.
-    forkFrame :: Frame () -> m ()
-    -- | Generate a 'Bitmap' from the front buffer.
-    takeScreenshot :: m Bitmap
-    -- | Set the goal FPS.
-    setFPS :: Double -> m ()
-    setTitle :: String -> m ()
-    showCursor :: m ()
-    hideCursor :: m ()
-    clearColor :: Color Float -> m ()
-    -- | Get the actual FPS value.
-    getFPS :: m Int
-    getBoundingBox :: m BoundingBox2
-    setBoundingBox :: BoundingBox2 -> m ()
-
-instance FreeGame UI where
-    draw = Draw
-    {-# INLINE draw #-}
-    preloadBitmap bmp = PreloadBitmap bmp ()
-    {-# INLINE preloadBitmap #-}
-
-    bracket = Bracket
-    {-# INLINE 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. Drawable m => m a -> m a) -> UI a -> UI a
-overDraw f (Draw m) = Draw (f m)
-overDraw _ x = x
-{-# INLINE overDraw #-}
-
-instance Affine UI where
-    translate v = overDraw (translate v)
-    {-# INLINE translate #-}
-    rotateR t = overDraw (rotateR t)
-    {-# INLINE rotateR #-}
-    rotateD t = overDraw (rotateD t)
-    {-# INLINE rotateD #-}
-    scale v = overDraw (scale v)
-    {-# INLINE scale #-}
-
-instance Picture2D UI where
-    bitmap x = Draw (bitmap x)
-    {-# INLINE bitmap #-}
-    bitmapOnce x = Draw (bitmapOnce x)
-    {-# INLINE bitmapOnce #-}
-    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)
-    {-# INLINE thickness #-}
-    color c = overDraw (color c)
-    {-# INLINE color #-}
-    blendMode m = overDraw (blendMode m)
-    {-# INLINE blendMode #-}
-
-instance Local UI where
-    getLocation = Draw getLocation
-
-instance FromFinalizer UI where
-    fromFinalizer = FromFinalizer
-    {-# INLINE fromFinalizer #-}
-
-instance Keyboard UI where
-    keyStates_ = KeyStates id
-
-instance Mouse UI where
-    globalMousePosition = MousePosition id
-    -- mouseWheel = MouseWheel id
-    mouseButtons_ = MouseButtons id
-    mouseInWindow = MouseInWindow id
-    mouseScroll = MouseScroll id
+{-# LANGUAGE DeriveFunctor, ExistentialQuantification, Rank2Types, UndecidableInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  FreeGame.UI+-- Copyright   :  (C) 2013 Fumiaki Kinoshita+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>+-- Stability   :  provisional+-- Portability :  non-portable+-- Provides the "free" embodiment.+----------------------------------------------------------------------------+module FreeGame.UI (+    FreeGame(..)+) where++import FreeGame.Class+import FreeGame.Types+import FreeGame.Data.Bitmap (Bitmap)+import Data.Color++class (Picture2D m, Local m, Keyboard m, Mouse m) => FreeGame m where+    -- | Load a 'Bitmap' to avoid the cost of the first invocation of 'bitmap'.+    preloadBitmap :: Bitmap -> m ()+    -- | Generate a 'Bitmap' from the front buffer.+    takeScreenshot :: m Bitmap+    -- | Set the goal FPS.+    setFPS :: Double -> m ()+    setTitle :: String -> m ()+    showCursor :: m ()+    hideCursor :: m ()+    clearColor :: Color Float -> m ()+    -- | Get the actual FPS value.+    getFPS :: m Int+    getBoundingBox :: m BoundingBox2+    setBoundingBox :: BoundingBox2 -> m ()

@@ -35,16 +35,13 @@     keySpecial
     ) where
 
-#if !MIN_VERSION_base(4,8,0)
-import Control.Applicative
-#endif
 import Control.Monad
 import Control.Monad.Free.Class
 import Control.Monad.Trans.Iter
 import Control.Monad.Trans
-import Control.Monad.Free.Church
 import Data.Char
 import Data.Void
+import FreeGame.Backend.GLFW
 import FreeGame.Data.Bitmap
 import FreeGame.Class
 import FreeGame.Types
@@ -54,28 +51,26 @@ import System.FilePath
 import System.IO.Unsafe
 import System.Random
-import System.Environment
-import FreeGame.UI
 
 -- | Delimit the computation to yield a frame.
 tick :: (Monad f, MonadFree f m) => m ()
 tick = delay (return ())
 
 -- | An infinite loop that run 'tick' every frame after the given action.
-foreverTick :: (Monad f, MonadFree f m) => m a -> m any
+foreverTick :: Game a -> Game any
 foreverTick m = let m' = foreverTick m in m >> wrap (return m')
 
 -- | @foreverFrame :: Frame a -> Game any@
-foreverFrame :: (Monad f, Monad m, MonadTrans t, MonadFree f (t m)) => m a -> t m any
-foreverFrame m = foreverTick (lift m)
+foreverFrame :: Frame a -> Game any
+foreverFrame m = foreverTick (Game $ lift m)
 
 -- | Extract the next frame of the action.
-untick :: (Monad m, FreeGame m) => IterT Frame a -> m (Either (IterT Frame a) a)
-untick = liftM (either Right Left) . iterM (join . reUI) . runIterT where
+untick :: IterT Frame a -> Frame (Either (IterT Frame a) a)
+untick = liftM (either Right Left) . runIterT where
 
 -- | An infinite version of 'untick'.
-untickInfinite :: (Monad m, FreeGame m) => IterT Frame Void -> m (IterT Frame Void)
-untickInfinite = liftM (either absurd id) . iterM (join . reUI) . runIterT where
+untickInfinite :: IterT Frame Void -> Frame (IterT Frame Void)
+untickInfinite = liftM (either absurd id) . runIterT where
 
 -- | An unit vector with the specified angle.
 unitV2 :: Floating a => a -> V2 a
@@ -86,8 +81,8 @@ angleV2 (V2 a b) = atan2 b a
 
 -- | Get a given range of value.
-randomness :: (Random r, FromFinalizer m) => (r, r) -> m r
-randomness r = embedIO $ randomRIO r
+randomness :: (Random r, MonadIO m) => (r, r) -> m r
+randomness r = liftIO $ randomRIO r
 {-# INLINE randomness #-}
 
 -- | Convert radians to degrees.
@@ -101,8 +96,8 @@ radians x = x / 180 * pi
 
 -- | Create a 'Picture' from the given file.
-loadPictureFromFile :: (Picture2D p, FromFinalizer m) => FilePath -> m (p ())
-loadPictureFromFile = embedIO . fmap bitmap . readBitmap
+loadPictureFromFile :: (Picture2D p, MonadIO m) => FilePath -> m (p ())
+loadPictureFromFile = liftIO . fmap bitmap . readBitmap
 
 -- | The type of the given 'ExpQ' must be @FilePath -> IO FilePath@
 -- FIXME: This may cause name duplication if there are multiple non-alphanumeric file names.
@@ -126,26 +121,8 @@                 (varE 'readBitmap)
 
 -- | Load and define all pictures in the specified directory.
--- On base >= 4.6, file paths to actually load will be respect to the directory of the executable. Otherwise it will be based on the current directory.
-
-#if (MIN_VERSION_base(4,6,0))
-
 loadBitmaps :: FilePath -> Q [Dec]
-loadBitmaps path = do
-    v <- newName "v"
-    loadBitmapsWith (lamE [varP v] $
-        appsE [varE 'fmap, uInfixE
-                    (infixE Nothing (varE '(</>)) (Just (varE v)))
-                    (varE '(.))
-                    (varE 'takeDirectory)
-                , varE 'getExecutablePath]) path
-
-#else
-
-loadBitmaps :: FilePath -> Q [Dec]
 loadBitmaps path = loadBitmapsWith (varE 'return) path
-
-#endif
 
 getFileList :: FilePath -> IO [FilePath]
 getFileList path = do

@@ -6,7 +6,7 @@ import Control.Monad.State.Strict
 
 figureTest :: Frame ()
-figureTest = draw $ do
+figureTest = do
     color cyan -- 'colored' gives a color to the action.
         $ line [V2 80 80, V2 160 160] -- 'line' draws line through the given coordinates.
 
@@ -34,19 +34,19 @@         translate (V2 0 160) $ do
             text font 48 "0123456789" -- Use 'text font size string' to draw a string.
             color red $ line [V2 (-100) 0, V2 640 0]
-        
+
         color red $ line [V2 0 (-600), V2 0 600]
 
 bitmapTest :: Bitmap -> Frame ()
 bitmapTest bmp = blendMode Add $ do
-    
+
     color (fromRGB 1 0 0) $ do
         translate (V2 300 346) $ bitmap bmp -- 'bitmap' creates an action from the bitmap.
     color (fromRGB 0 1 0) $ do
         translate (V2 310 350) $ bitmap bmp -- 'bitmap' creates an action from the bitmap.
     color (fromRGB 0 0 1) $ do
         translate (V2 293 359) $ bitmap bmp -- 'bitmap' creates an action from the bitmap.
-    
+
 mouseTest :: Font -> Frame ()
 mouseTest font = whenM mouseInWindow $ do
     p <- mousePosition
@@ -60,15 +60,15 @@     translate p $ color col $ thickness 4 $ circleOutline 16
     translate p $ color white $ do
         r <- mouseScroll
-        text font 48 $ show r
+        text font 48 $ "scroll: " <> show r
 
 main = runGame Windowed (Box (V2 0 0) (V2 640 480)) $ do
-    bmp <- readBitmap "bird.png"
-    bmp' <- readBitmap "logo.png"
-    font <- loadFont "VL-PGothic-Regular.ttf"
+    bmp <- readBitmap "examples/bird.png"
+    bmp' <- readBitmap "examples/logo.png"
+    font <- loadFont "examples/VL-PGothic-Regular.ttf"
     let bmp' = cropBitmap bmp (128, 128) (64, 64)
     clearColor black
-    forkFrame $ preloadBitmap bmp'
+    preloadBitmap bmp'
     foreverFrame $ do
 
         bitmapTest bmp

@@ -1,23 +1,24 @@-import FreeGame
-
-data StateData = StateData { _counter :: Int
-                           , _font :: Font
-                           }
-    
-loop :: StateData -> Game ()
-loop state = do
-    let fnt = _font state
-        cnt = 1 + _counter state
-        state' = state{_counter = cnt}
-
-    translate (V2 100 240) . color green . text fnt 15 $ show cnt
-    translate (V2 340 240) . rotateD (fromIntegral cnt) . color red $ text fnt 70 "Test"
-
-    key <- keyPress KeyEscape
-    unless key $ tick >> loop state'
-
-main = runGame Windowed (Box (V2 0 0) (V2 640 480)) $ do
-    font <- loadFont "VL-PGothic-Regular.ttf"
-    clearColor black
-    let state = StateData{_counter=0, _font=font}
-    loop state
+import FreeGame+import Control.Monad.Trans++data StateData = StateData { _counter :: Int+                           , _font :: Font+                           }++loop :: StateData -> Game ()+loop state = do+    let fnt = _font state+        cnt = 1 + _counter state+        state' = state{_counter = cnt}++    translate (V2 100 240) . color green . text fnt 15 $ show cnt+    translate (V2 340 240) . rotateD (fromIntegral cnt) . color red $ text fnt 70 "Test"++    key <- keyPress KeyEscape+    unless key $ tick >> loop state'++main = runGame Windowed (Box (V2 0 0) (V2 640 480)) $ do+    font <- loadFont "examples/VL-PGothic-Regular.ttf"+    clearColor black+    let state = StateData{_counter=0, _font=font}+    loop state

@@ -28,7 +28,7 @@     ofs <- use offset
     t <- use target
     font <- use font
-    
+
     let v = s0 !! t + s1 !! t
     color black $ do
       translate (V2 24 240) $ text font 24 "fibs"
@@ -41,7 +41,7 @@       Scroll ph
         | ph > 0 -> do
           mode .= Scroll (ph - 1)
-          
+
           color black $ translate (V2 390 320) $ text font 24 (show v)
           offset .= ofs - V2 speed 0
         | otherwise -> mode .= Dist 0
@@ -66,7 +66,7 @@   unlessM (keyDown KeyEscape) $ mainLoop s'
 
 main = runGameDefault $ do
-    font <- loadFont "VL-PGothic-Regular.ttf"
+    font <- loadFont "examples/VL-PGothic-Regular.ttf"
     runMaybeT $ forever $ do
       color red $ translate (V2 24 240) $ text font 24 "Press SPACE to start"
       tick

@@ -2,5 +2,5 @@ 
 main = runGame Windowed (Box (V2 0 0) (V2 640 480)) $ do
     hideCursor
-    font <- loadFont "VL-PGothic-Regular.ttf"
+    font <- loadFont "examples/VL-PGothic-Regular.ttf"
     foreverFrame $ translate (V2 80 200) $ color black $ text font 40 "Hello, World"

@@ -1,5 +1,6 @@+cabal-version: 3.0
 name:                free-game
-version:             1.1.90
+version:             1.2
 synopsis:            Create games for free
 description:
     free-game defines a monad that integrates features to create 2D games.
@@ -8,16 +9,16 @@ 
 homepage:            https://github.com/fumieval/free-game
 bug-reports:         https://github.com/fumieval/free-game/issues
-license:             BSD3
+license:             BSD-3-Clause
 license-file:        LICENSE
 author:              Fumiaki Kinoshita
 maintainer:          Fumiaki Kinoshita <fumiexcel@gmail.com>
-copyright:           Copyright (C) 2012-2013 Fumiaki Kinoshita
+copyright:           Copyright (C) 2012-2022 Fumiaki Kinoshita
 category:            Graphics, Monads
 build-type:          Simple
 stability:           experimental
-cabal-version:       >=1.10
 
+
 extra-source-files:
   CHANGELOG.md
   examples/*.hs
@@ -28,6 +29,10 @@   type: git
   location: https://github.com/fumieval/free-game.git
 
+flag build-example
+  default: False
+  manual: True
+
 library
   default-language:   Haskell2010
 
@@ -40,7 +45,6 @@     FreeGame.UI
     FreeGame.Instances
     FreeGame.Backend.GLFW
-    FreeGame.Internal.Finalizer
     FreeGame.Internal.GLFW
     FreeGame.Types
     FreeGame.Util
@@ -55,8 +59,8 @@     control-bool,
     directory >= 1.0,
     filepath >= 1.3,
-    free >= 4.6.1 && < 5,
-    freetype2 >= 0.1,
+    free,
+    freetype2 ^>= 0.1,
     GLFW-b >= 1.3 && <2,
     hashable >= 1.2,
     JuicyPixels,
@@ -66,11 +70,36 @@     OpenGL >= 3 && <4,
     OpenGLRaw,
     random == 1.*,
-    reflection,
     StateVar,
     template-haskell,
     transformers >= 0.3,
-    vector >= 0.9 && <0.12,
+    vector,
     void >= 0.5,
     boundingboxes >= 0.2 && < 0.4,
-    lens >= 3.8 && < 5
+    lens >= 5.2,
+    resourcet
+
+common example
+  if flag(build-example)
+    buildable: True
+  else
+    buildable: False
+  build-depends: base, free-game, mtl, lens, transformers
+  hs-source-dirs: examples
+  default-language: Haskell2010
+
+executable demo
+  import: example
+  main-is: demo.hs
+
+executable demo-stateful
+  import: example
+  main-is: demo_stateful.hs
+
+executable fib
+  import: example
+  main-is: fib.hs
+
+executable helloworld
+  import: example
+  main-is: helloworld.hs