free-game 1.1.9 → 1.1.78

raw patch · 15 files changed

+73/−268 lines, 15 filesdep −StateVardep ~JuicyPixels-utildep ~OpenGLdep ~OpenGLRaw

Dependencies removed: StateVar

Dependency ranges changed: JuicyPixels-util, OpenGL, OpenGLRaw, colors, mtl, reflection

Files

• CHANGELOG.md +7/−19
• FreeGame.hs +0/−3
• FreeGame/Backend/GLFW.hs +2/−7
• FreeGame/Class.hs +2/−5
• FreeGame/Data/Bitmap.hs +2/−4
• FreeGame/Data/Font.hs +3/−5
• FreeGame/Instances.hs +15/−50
• FreeGame/Internal/Finalizer.hs +0/−2
• FreeGame/Internal/GLFW.hs +12/−31
• FreeGame/UI.hs +12/−21
• FreeGame/Util.hs +3/−4
• examples/demo.hs +6/−9
• examples/demo_stateful.hs +0/−23
• examples/fib.hs +0/−75
• free-game.cabal +9/−10

@@ -1,25 +1,13 @@-1.1.80
----------------------------------------------------------------------
-* Added `mouseScroll`
-* Fixed the malfunction of FPS management
-
-1.1.79
----------------------------------------------------------------------
-* Exported `clipBitmap`
-
-1.1.78
-* Added `mouseInWindow`
-
 1.1
--------------------------------------------------------------------------
+----------------------------------------------------------------------------------------------------
 * Use Box instead of drab BoundingBox
 
 1.0.5
--------------------------------------------------------------------------
+----------------------------------------------------------------------------------------------------
 * No fundamental changes
 
 1.0.4
--------------------------------------------------------------------------
+----------------------------------------------------------------------------------------------------
 
 * Fixed some potential bugs that appeared on 7.8.1 RC2
 * Added `getBoundingBox` and `setBoundingBox` which accesses the window size and the region to draw.
@@ -27,7 +15,7 @@ * Demoted the precedence of `thickness` and `blendMode` according to other APIs.
 
 1.0.3
--------------------------------------------------------------------------
+----------------------------------------------------------------------------------------------------
 * Added `runGameDefault` as an alternative of classic `runGame def`.
 * Removed the duplicate instance of `MonadIO`.
 * `free-game` no longer depends on ominous `repa`.
@@ -38,18 +26,18 @@ * Make the window size solid.
 
 1.0.2
--------------------------------------------------------------------------
+----------------------------------------------------------------------------------------------------
 * Supported changing a blend function. `blendMode mode m` changes the blend mode while `m` is running.
 * Fixed fatal 'keyPress'-related bugs.
 * Special thanks: [@myuon_myon](https://twitter.com/myuon_myon)
 * Re-added `keyChar` and `keySpecial`.
 
 1.0.1
--------------------------------------------------------------------------
+----------------------------------------------------------------------------------------------------
 * Demoted the precedence of `Affine` APIs to 5.
 
 1.0
--------------------------------------------------------------------------
+----------------------------------------------------------------------------------------------------
 * Supported free-4.4.
 * Supported GLFW-b-1.3.
 * Use `Double` instead of `Float`.

@@ -35,14 +35,12 @@     globalize,
     localize,
     -- * Pictures
-    Drawable,
     Picture2D(..),
     BlendMode(..),
     Bitmap,
     bitmapSize,
     readBitmap,
     cropBitmap,
-    clipBitmap,
     loadBitmaps,
     loadBitmapsWith,
     writeBitmap,
@@ -59,7 +57,6 @@     keyDown,
     -- * Mouse
     Mouse(),
-    mouseScroll,
     mouseInWindow,
     mousePositionMay,
     mousePosition,

@@ -67,17 +67,15 @@     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
 
@@ -87,7 +85,6 @@     , 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
@@ -99,7 +96,6 @@     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_
 
@@ -123,7 +119,6 @@     , 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
@@ -145,10 +140,10 @@     cont
 runUI (KeyStates cont) = liftIO (readIORef $ getKeyStates given) >>= cont
 runUI (MouseButtons cont) = liftIO (readIORef $ getMouseButtonStates given) >>= cont
+-- runUI _ _ (MouseWheel cont) = GLFW.getMouseWheel >>= 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

@@ -8,14 +8,12 @@ -- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
 -- Stability   :  provisional
 -- Portability :  non-portable
---
+-- 
 ----------------------------------------------------------------------------
 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
@@ -56,7 +54,7 @@     circle :: Double -> p ()
     circleOutline :: Double -> p ()
     thickness :: Float -> p a -> p a
-    color :: Color Float -> p a -> p a
+    color :: Color -> p a -> p a
     blendMode :: BlendMode -> p a -> p a
 
 class Affine p => Local p where
@@ -146,7 +144,6 @@     globalMousePosition :: f Vec2
     mouseButtons_ :: f (Map.Map Int ButtonState)
     mouseInWindow :: f Bool
-    mouseScroll :: f Vec2
 
 -- | Returns the relative coordinate of the cursor.
 mousePosition :: (Applicative f, Mouse f, Local f) => f Vec2

@@ -22,9 +22,9 @@ 
     -- * Bitmap operations
     ,cropBitmap
-    ,clipBitmap
     -- * V2
     ,sizeBitmap
+    ,clipBitmap
     ) where
 
 import qualified Codec.Picture as C
@@ -33,12 +33,10 @@ 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 }
+data Bitmap = Bitmap (C.Image C.PixelRGBA8) Int
 
 -- | Get the size of the 'Bitmap'.
 bitmapSize :: Bitmap -> (Int, Int)

@@ -10,7 +10,7 @@ --
 -- Rendering characters
 ----------------------------------------------------------------------------
-module FreeGame.Data.Font
+module FreeGame.Data.Font 
   ( Font
   , loadFontFromFile
   , loadFont
@@ -21,9 +21,7 @@   , RenderedChar(..)
   ) where
 
-#if !MIN_VERSION_base(4,8,0)
 import Control.Applicative
-#endif
 import Control.Monad.IO.Class
 import Control.Monad
 import Data.IORef
@@ -121,7 +119,7 @@     let dpi = fromIntegral resolutionDPI
 
     runFreeType $ ft_Set_Char_Size face 0 (floor $ siz * 64) dpi dpi
-
+    
     ix <- ft_Get_Char_Index face (fromIntegral $ fromEnum ch)
     runFreeType $ ft_Load_Glyph face ix ft_LOAD_DEFAULT
 
@@ -134,7 +132,7 @@ 
     let h = fromIntegral $ B.rows bmp
         w = fromIntegral $ B.width bmp
-
+    
     fptr <- newForeignPtr_ $ castPtr $ buffer bmp
 
     adv <- peek $ GS.advance slot

@@ -9,11 +9,7 @@ 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 +17,7 @@ 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
@@ -69,7 +63,6 @@     globalMousePosition = (l) globalMousePosition; \
     mouseButtons_ = (l) mouseButtons_; \
     mouseInWindow = (l) mouseInWindow; \
-    mouseScroll = (l) mouseScroll; \
     }
 
 #define MK_FROM_FINALIZER(cxt, ty, l) instance (FromFinalizer m cxt) => FromFinalizer (ty) where { \
@@ -91,25 +84,21 @@     setBoundingBox b = (l) (setBoundingBox b); \
     }
 
-MK_AFFINE(, F m, hoistF)
-MK_AFFINE(, Free.Free m, Free.hoistFree)
+MK_AFFINE(_COMMA_ Functor m, F m, hoistF)
+MK_AFFINE(_COMMA_ Functor m, Free.Free m, Free.hoistFree)
 MK_AFFINE(_COMMA_ Monad m, IterT m, hoistIterT)
-MK_AFFINE(, ReaderT r m, mapReaderT)
-MK_AFFINE(, Lazy.StateT s m, Lazy.mapStateT)
-MK_AFFINE(, Strict.StateT s m, Strict.mapStateT)
-MK_AFFINE(, Lazy.WriterT w m, Lazy.mapWriterT)
-MK_AFFINE(, Strict.WriterT w m, Strict.mapWriterT)
-MK_AFFINE(, Lazy.RWST r w s m, Lazy.mapRWST)
-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_AFFINE(_COMMA_ Monad m, ReaderT r m, mapReaderT)
+MK_AFFINE(_COMMA_ Monad m, Lazy.StateT s m, Lazy.mapStateT)
+MK_AFFINE(_COMMA_ Monad m, Strict.StateT s m, Strict.mapStateT)
+MK_AFFINE(_COMMA_ Monad m _COMMA_ Monoid w, Lazy.WriterT w m, Lazy.mapWriterT)
+MK_AFFINE(_COMMA_ Monad m _COMMA_ Monoid w, Strict.WriterT w m, Strict.mapWriterT)
+MK_AFFINE(_COMMA_ Monad m _COMMA_ Monoid w, Lazy.RWST r w s m, Lazy.mapRWST)
+MK_AFFINE(_COMMA_ Monad m _COMMA_ Monoid w, Strict.RWST r w s m, Strict.mapRWST)
+MK_AFFINE(_COMMA_ Monad m, IdentityT m, mapIdentityT)
+MK_AFFINE(_COMMA_ Monad m, MaybeT m, mapMaybeT)
+MK_AFFINE(_COMMA_ Monad m, ListT m, mapListT)
+MK_AFFINE(_COMMA_ Monad m _COMMA_ Error e, ErrorT e m, mapErrorT)
+MK_AFFINE(_COMMA_ Monad m, ContT r m, mapContT)
 
 MK_PICTURE_2D(_COMMA_ Functor m, F m, Church.liftF, hoistF)
 MK_PICTURE_2D(_COMMA_ Functor m, Free.Free m, Free.liftF, Free.hoistFree)
@@ -124,11 +113,7 @@ 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)
@@ -144,11 +129,7 @@ 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)
@@ -164,11 +145,7 @@ 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)
@@ -184,11 +161,7 @@ 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)
@@ -203,11 +176,7 @@ 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)
@@ -222,9 +191,5 @@ 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)
+MK_FREE_GAME(_COMMA_ Monad m, ContT r m, lift)

@@ -3,9 +3,7 @@ 
 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

@@ -2,17 +2,15 @@ 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.Color
 import Data.IORef
 import FreeGame.Types
 import Data.BoundingBox
-import Data.StateVar
-import Graphics.GL.Compatibility30
+import Graphics.Rendering.OpenGL.GL.StateVar
+import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility
 import Linear
 import qualified Graphics.Rendering.OpenGL.GL as GL
 import qualified Graphics.UI.GLFW as GLFW
@@ -22,26 +20,16 @@ import Codec.Picture
 import Codec.Picture.RGBA8
 import qualified GHC.IO.Encoding as Encoding
-import qualified Data.Sequence as S
-import qualified Data.Foldable as F
+
 data System = System
     { refFrameCounter :: IORef Int
-    , theFPS :: IORef Double
-    , frameTimes :: IORef (S.Seq Double)
+    , refFPS :: IORef Int
+    , theFPS :: IORef Int
     , currentFPS :: IORef Int
-    , startTime :: IORef Double
     , refRegion :: IORef BoundingBox2
     , theWindow :: GLFW.Window
     }
 
-trim1 :: S.Seq Double -> S.Seq Double
-trim1 s0 = go zs s0 (sum zs) where
-    go (x:xs) s a
-        | a < 1 = s
-        | otherwise = go xs (S.drop 1 s) (a - x)
-    go [] s _ = s
-    zs = F.toList s0
-
 type Texture = (GL.TextureObject, Double, Double)
 
 runVertices :: MonadIO m => [V2 Double] -> m ()
@@ -111,7 +99,7 @@     let s = 2 * pi / 64
     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 :: Color -> IO a -> IO a
 color col m = do
     oldColor <- liftIO $ get GL.currentColor
     liftIO $ GL.currentColor $= unsafeCoerce col
@@ -158,8 +146,6 @@     GL.ortho wl wr wb wt 0 (-100)
     GL.matrixMode $= GL.Modelview 0
     GL.clear [GL.ColorBuffer]
-    Just t <- GLFW.getTime
-    writeIORef (startTime sys) t
 
 endFrame :: System -> IO Bool
 endFrame sys = do
@@ -168,14 +154,10 @@     Just t <- GLFW.getTime
     n <- readIORef (refFrameCounter sys)
     fps <- readIORef (theFPS sys)
-    threadDelay $ max 0 $ floor $ (1000000 *) $ fromIntegral n / fps - t
-    writeIORef (refFrameCounter sys) (succ n)
-    t0 <- readIORef (startTime sys)
-    fs <- readIORef (frameTimes sys)
-    Just t1 <- GLFW.getTime
-    let !fs' = trim1 $ fs S.|> (t1 - t0)
-    writeIORef (currentFPS sys) (S.length fs')
-    writeIORef (frameTimes sys) fs'
+    threadDelay $ max 0 $ floor $ (1000000 *) $ fromIntegral n / fromIntegral fps - t
+    if t > 1
+        then GLFW.setTime 0 >> writeIORef (currentFPS sys) n >> writeIORef (refFrameCounter sys) 0
+        else writeIORef (refFrameCounter sys) (succ n)
     GLFW.windowShouldClose (theWindow sys)
 
 withGLFW :: WindowMode -> BoundingBox2 -> (System -> IO a) -> IO a
@@ -209,10 +191,9 @@ 
     sys <- System
         <$> newIORef 0
+        <*> newIORef 0
         <*> newIORef 60
-        <*> newIORef S.empty
         <*> newIORef 60
-        <*> newIORef 0
         <*> pure rbox
         <*> pure win
 
@@ -249,4 +230,4 @@     GL.blendFunc $= blendMode2BlendingFactors mode
     a <- m
     GL.blendFunc $= oldFunc
-    return a
+    return a

@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveFunctor, ExistentialQuantification, Rank2Types, UndecidableInstances #-}
+{-# LANGUAGE DeriveFunctor, ExistentialQuantification, Rank2Types #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  FreeGame.UI
@@ -12,7 +12,6 @@ ----------------------------------------------------------------------------
 module FreeGame.UI (
     UI(..)
-    , Drawable
     , reUI
     , reFrame
     , reGame
@@ -24,36 +23,30 @@ 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 Data.BoundingBox
 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)
+    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
+    | SetFPS Int a
     | SetTitle String a
     | ShowCursor a
     | HideCursor a
-    | ClearColor (Color Float) a
+    | ClearColor Color a
     | GetFPS (Int -> a)
     | ForkFrame (Frame ()) a
     | GetBoundingBox (BoundingBox2 -> a)
@@ -84,7 +77,6 @@ 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
@@ -101,7 +93,7 @@ 
 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
+    draw :: (forall f. (Applicative f, Monad f, Picture2D f, Local 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.
@@ -111,22 +103,22 @@     -- | Generate a 'Bitmap' from the front buffer.
     takeScreenshot :: m Bitmap
     -- | Set the goal FPS.
-    setFPS :: Double -> m ()
+    setFPS :: Int -> m ()
     setTitle :: String -> m ()
     showCursor :: m ()
     hideCursor :: m ()
-    clearColor :: Color Float -> m ()
+    clearColor :: Color -> 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 ()
@@ -140,7 +132,7 @@     getBoundingBox = GetBoundingBox id
     setBoundingBox s = SetBoundingBox s ()
 
-overDraw :: (forall m. Drawable m => m a -> m a) -> UI a -> UI a
+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
 {-# INLINE overDraw #-}
@@ -186,5 +178,4 @@     globalMousePosition = MousePosition id
     -- mouseWheel = MouseWheel id
     mouseButtons_ = MouseButtons id
-    mouseInWindow = MouseInWindow id
-    mouseScroll = MouseScroll id
+    mouseInWindow = MouseInWindow id

@@ -35,9 +35,7 @@     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
@@ -64,6 +62,7 @@ -- | An infinite loop that run 'tick' every frame after the given action.
 foreverTick :: (Monad f, MonadFree f m) => m a -> m any
 foreverTick m = let m' = foreverTick m in m >> wrap (return m')
+{-# WARNING foreverTick "In most cases, foreverFrame is good enough and fast." #-}
 
 -- | @foreverFrame :: Frame a -> Game any@
 foreverFrame :: (Monad f, Monad m, MonadTrans t, MonadFree f (t m)) => m a -> t m any
@@ -110,7 +109,7 @@ loadBitmapsWith getFullPath path = do
     loc <- (</>path) <$> takeDirectory <$> loc_filename <$> location
     paths <- runIO $ getFileList loc
-
+    
     sequence $ do
         p <- paths
         let name = pathToName p
@@ -189,4 +188,4 @@ 
 {-# DEPRECATED keySpecial "use keyPress instead" #-}
 keySpecial :: Keyboard f => Key -> f Bool
-keySpecial = keyPress
+keySpecial = keyPress

@@ -40,15 +40,15 @@ bitmapTest :: Bitmap -> Frame ()
 bitmapTest bmp = blendMode Add $ do
     
-    color (fromRGB 1 0 0) $ do
+    color (Color 1 0 0 1) $ do
         translate (V2 300 346) $ bitmap bmp -- 'bitmap' creates an action from the bitmap.
-    color (fromRGB 0 1 0) $ do
+    color (Color 0 1 0 1) $ do
         translate (V2 310 350) $ bitmap bmp -- 'bitmap' creates an action from the bitmap.
-    color (fromRGB 0 0 1) $ do
+    color (Color 0 0 1 1) $ do
         translate (V2 293 359) $ bitmap bmp -- 'bitmap' creates an action from the bitmap.
     
-mouseTest :: Font -> Frame ()
-mouseTest font = whenM mouseInWindow $ do
+mouseTest :: Frame ()
+mouseTest = whenM mouseInWindow $ do
     p <- mousePosition
     l <- mouseButtonL
     r <- mouseButtonR
@@ -58,9 +58,6 @@             (False, True) -> blue
             (True, True) -> blend 0.5 red blue
     translate p $ color col $ thickness 4 $ circleOutline 16
-    translate p $ color white $ do
-        r <- mouseScroll
-        text font 48 $ show r
 
 main = runGame Windowed (Box (V2 0 0) (V2 640 480)) $ do
     bmp <- readBitmap "bird.png"
@@ -77,7 +74,7 @@ 
         fontTest font
         translate (V2 240 240) $ do
-            mouseTest font
+            mouseTest
 
             fps <- getFPS
 

@@ -1,23 +0,0 @@-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

@@ -1,75 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}
-import FreeGame
-import Control.Lens
-import Control.Monad.State
-import Control.Monad.Trans.Maybe
-
-data Mode = Scroll Double | Dist Double
-
-data World = World
-    { _seq0 :: [Int]
-    , _seq1 :: [Int]
-    , _offset :: Vec2
-    , _target :: Int
-    , _mode :: Mode
-    -- visual
-    , _font :: Font
-    }
-makeLenses ''World
-
-fibs = 1 : 1 : zipWith (+) fibs (tail fibs)
-
-speed = 1
-
-update :: StateT World Game ()
-update = do
-    s0 <- use seq0
-    s1 <- use seq1
-    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"
-      translate (V2 24 280) $ text font 24 "tail fibs"
-      forM_ (zip [0..] s0) $ \(i, v) -> translate (ofs + V2 (i * 36) 240) $ text font 24 (show v)
-      forM_ (zip [0..] s1) $ \(i, v) -> translate (ofs + V2 (i * 36) 280) $ text font 24 (show v)
-    color blue $ line [V2 400 480, V2 400 0]
-    ph <- use mode
-    case ph of
-      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
-      Dist ph
-        | ph >= 1 -> do
-          seq0 .= s0 ++ [v]
-          seq1 .= s1 ++ [v]
-          mode .= Scroll 36
-          target += 1
-        | otherwise -> color black $ do
-          translate (p0 ^* (1 - ph) + V2 (390+36) 240 ^* ph) $ text font 24 (show v)
-          translate (p0 ^* (1 - ph) + V2 (390) 280 ^* ph) $ text font 24 (show v)
-          mode .= Dist (ph + 1/30)
-    color red $ translate (V2 24 120) $ text font 24 "Press ESC to exit"
-  where
-    p0 = V2 390 320
-
-mainLoop :: World -> Game ()
-mainLoop s = do
-  s' <- execStateT update s
-  tick
-  unlessM (keyDown KeyEscape) $ mainLoop s'
-
-main = runGameDefault $ do
-    font <- loadFont "VL-PGothic-Regular.ttf"
-    runMaybeT $ forever $ do
-      color red $ translate (V2 24 240) $ text font 24 "Press SPACE to start"
-      tick
-      () <- whenM (keyDown KeySpace) mzero
-      return ()
-    mainLoop $ World [1,1] [1] (V2 400 0) 0 (Scroll 36) font

@@ -1,5 +1,5 @@ name:                free-game
-version:             1.1.9
+version:             1.1.78
 synopsis:            Create games for free
 description:
     free-game defines a monad that integrates features to create 2D games.
@@ -46,11 +46,11 @@     FreeGame.Util
 
   ghc-options: -Wall -fexcess-precision -O2
-  default-extensions: FlexibleContexts, FlexibleInstances, CPP
+  default-extensions: FlexibleContexts, FlexibleInstances
   build-depends:
     array >= 0.4,
     base == 4.*,
-    colors == 0.3.*,
+    colors == 0.1.*,
     containers >= 0.4,
     control-bool,
     directory >= 1.0,
@@ -60,17 +60,16 @@     GLFW-b >= 1.3 && <2,
     hashable >= 1.2,
     JuicyPixels,
-    JuicyPixels-util >=0.1.1 && < 0.3,
+    JuicyPixels-util == 0.1.*,
     linear >= 1.0 && < 2,
-    mtl >= 2.2 && <4,
-    OpenGL >= 3 && <4,
-    OpenGLRaw,
+    mtl >= 2.1,
+    OpenGL == 2.9.*,
+    OpenGLRaw == 1.4.*,
     random == 1.*,
-    reflection,
-    StateVar,
+    reflection == 1.*,
     template-haskell,
     transformers >= 0.3,
     vector >= 0.9 && <0.12,
     void >= 0.5,
     boundingboxes >= 0.2 && < 0.4,
-    lens >= 3.8 && < 5
+    lens >= 3.8 && < 5