packages feed

free-game 1.0.2 → 1.0.3

raw patch · 10 files changed

+114/−152 lines, 10 filesdep +JuicyPixels-utildep −JuicyPixels-repadep −data-defaultdep −repadep ~free

Dependencies added: JuicyPixels-util

Dependencies removed: JuicyPixels-repa, data-default, repa

Dependency ranges changed: free

Files

FreeGame.hs view
@@ -13,6 +13,7 @@   ( -- * Game
     Game,
     runGame,
+    runGameDefault,
     WindowMode(..),
     BoundingBox(..),
     delay,
@@ -33,6 +34,7 @@     Picture2D(..),
     BlendMode(..),
     Bitmap,
+    bitmapSize,
     readBitmap,
     cropBitmap,
     loadBitmaps,
@@ -105,28 +107,18 @@ import Linear hiding (rotate)
 import Control.Monad.Trans.Iter
 
--- | 'Game' is a monad literally expressing games.
--- This monad is an instance of 'Picture2D' so you can construct it using 'bitmap' and can be transformed with 'translate', 'scale', 'rotate', 'color'.
---
--- It is also an instance of 'Keyboard' and 'Mouse'. Note that 'mousePosition' returns a relative position.
---
--- > foo = foreverFrame $ do
--- >   p <- mousePosition
--- >   translate p $ color blue $ polygonOutline [V2 (-8) (-8), V2 8 (-8), V2 8 8, V2 (-8) 8]
--- 
--- When we run @foo@ using 'runGame', a blue square follows the cursor.
--- And 'translate' (V2 240 240) @foo@, 'rotate' 45 @foo@, 'scale' 1.5 @foo@ also does in the same way.
---
+-- | '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.
 --
--- The only way to embody a 'Game' as a real stuff is to apply 'runGame'.
+-- <<http://shared.botis.org/free-game.png>>
 --
 -- For more examples, see <https://github.com/fumieval/free-game/tree/master/examples>.
 
 runGame :: WindowMode -> BoundingBox Double -> Game a -> IO (Maybe a)
 runGame = GLFW.runGame
 
-instance MonadIO Game where
-    liftIO = embedIO
+runGameDefault :: Game a -> IO (Maybe a)
+runGameDefault = runGame Windowed (BoundingBox 0 0 640 480)
 
 instance MonadIO Frame where
-    liftIO = embedIO+    liftIO = embedIO
FreeGame/Backend/GLFW.hs view
@@ -20,7 +20,6 @@ import Data.IORef
 import Data.Reflection
 import FreeGame.Class
-import FreeGame.Data.Bitmap
 import FreeGame.Internal.Finalizer
 import FreeGame.UI
 import FreeGame.Types
@@ -31,6 +30,8 @@ import qualified Graphics.UI.GLFW as GLFW
 import qualified Graphics.Rendering.OpenGL.GL as GL
 import Unsafe.Coerce
+import Codec.Picture.RGBA8
+import Control.Concurrent
 
 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)
@@ -74,12 +75,15 @@ gameLoop m = do
     liftIO $ G.beginFrame given
 
-    r <- iterM runUI $ runIterT m
+    fs <- liftIO $ newIORef ([] :: [IO ()])
 
+    r <- give fs $ iterM runUI $ runIterT m
+
     b <- liftIO $ do
         modifyIORef' (getKeyStates given) (Map.map buttonStay)
         modifyIORef' (getMouseButtonStates given) (Map.map buttonStay)
         G.endFrame given
+    liftIO (readIORef fs) >>= finalizer . sequence_
 
     if b
         then return Nothing
@@ -97,6 +101,7 @@     , Given TextureStorage
     , Given KeyStates
     , Given MouseButtonStates
+    , Given (IORef [IO ()])
     ) => UI (FinalizerT IO a) -> FinalizerT IO a
 runUI (Draw m) = do
     (cont, xs) <- liftIO $ do
@@ -108,10 +113,10 @@     cont
 runUI (FromFinalizer m) = join m
 runUI (PreloadBitmap bmp cont) = do
-    loadTexture given bmp
-        (\t h -> finalizer $ G.releaseTexture t >> modifyIORef' (getTextureStorage given) (IM.delete h))
-        (const $ return ())
-        (const $ return ())
+    t <- liftIO $ G.installTexture bmp
+    h <- liftIO $ addrImage bmp
+    liftIO $ modifyIORef' (getTextureStorage given) (IM.insert h t)
+    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
@@ -120,7 +125,7 @@     (x, y) <- liftIO $ GLFW.getCursorPos (G.theWindow given)
     cont $ V2 x y
 runUI (Bracket m) = join $ iterM runUI m
-runUI (TakeScreenshot cont) = liftIO (G.screenshot given >>= makeStableBitmap) >>= cont
+runUI (TakeScreenshot cont) = liftIO (G.screenshot given) >>= cont
 runUI (ClearColor col cont) = do
     liftIO $ GL.clearColor GL.$= unsafeCoerce col
     cont
@@ -137,6 +142,11 @@     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
 
 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))
@@ -152,33 +162,24 @@     scale v = mapReaderWith (scale v) (G.scale v)
     {-# INLINE scale #-}
 
-loadTexture :: MonadIO m => TextureStorage -> Bitmap
-    -> (G.Texture -> Int -> m ())
-    -> (G.Texture -> m ())
-    -> (G.Texture -> m ())
-    -> m ()
-loadTexture (TextureStorage st) (BitmapData img (Just h)) hook cont _ = do
-    m <- liftIO $ readIORef st
-    case IM.lookup h m of
-        Just t -> cont t
-        Nothing -> do
-            t <- liftIO $ G.installTexture img
-            liftIO $ writeIORef st $ IM.insert h t m
-            hook t h
-            cont t
-loadTexture _ (BitmapData img Nothing) _ cont fin = do
-    t <- liftIO $ G.installTexture img
-    cont t
-    fin t
-
 newtype Context = Context { getContext :: IORef [(G.Texture, Int)] }
 
 instance (Given Context, Given TextureStorage) => Picture2D DrawM where
-    bitmap bmp = liftIO $ loadTexture given bmp
-        (\t h -> modifyIORef (getContext given) ((t, h) :))
-        G.drawTexture
-        G.releaseTexture
-    {-# INLINE bitmap #-}
+    bitmap bmp = liftIO $ do
+        m <- readIORef (getTextureStorage given)
+        h <- addrImage bmp
+        case IM.lookup h m of
+            Just t -> 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
+    bitmapOnce bmp = liftIO $ do
+        t <- G.installTexture bmp
+        G.drawTexture t
+        G.releaseTexture t
+
     circle r = liftIO (G.circle r)
     {-# INLINE circle #-}
     circleOutline r = liftIO (G.circleOutline r)
FreeGame/Class.hs view
@@ -44,6 +44,8 @@ class Affine p => Picture2D p where
     -- | Construct a 'Picture2D' from a 'Bitmap'.
     bitmap :: Bitmap -> p ()
+    -- | Same as 'bitmap', but it does not create a cache.
+    bitmapOnce :: Bitmap -> p ()
     line :: [Vec2] -> p ()
     polygon :: [Vec2] -> p ()
     polygonOutline :: [Vec2] -> p ()
FreeGame/Data/Bitmap.hs view
@@ -13,78 +13,32 @@ 
 module FreeGame.Data.Bitmap (
     -- * Basic types and functions
-    Bitmap(..)
-    , _BitmapArray
-    , _BitmapHash
+    Bitmap
     ,bitmapSize
 
     -- * Load and Save
     ,readBitmap
     ,writeBitmap
-    , loadBitmapFromFile
-    -- * Constructing bitmaps
-    ,toBitmap
-    ,toStableBitmap
-    ,makeStableBitmap
+    ,loadBitmapFromFile
 
     -- * Bitmap operations
-    ,onBitmapWithHashable
     ,cropBitmap
     
     ) where
 
-import Control.Applicative
-import Codec.Picture.Repa
 import qualified Codec.Picture as C
-import Data.Array.Repa as R
-import qualified Data.Array.Repa.Repr.ForeignPtr as RF
-import Data.Word
-import System.Random
-import Data.Hashable
+import qualified Codec.Picture.RGBA8 as C
 import Control.Monad.IO.Class
-import qualified Data.Vector.Storable as V
 
--- | Bitmap data with unique hashes. 
-data Bitmap = BitmapData (R.Array RF.F DIM3 Word8) (Maybe Int) -- ^ This value is used to ensure that two bitmaps are equivalent.
-
-instance Show Bitmap where
-    show (BitmapData _ h) = "<BitmapData #" Prelude.++ show h Prelude.++ ">"
-
-instance Eq Bitmap where
-    BitmapData _ h == BitmapData _ h' = h == h'
-
-instance Ord Bitmap where
-    BitmapData _ h <= BitmapData _ h' = h <= h'
-
--- | @'_BitmapArray' :: Lens' 'Bitmap' ('R.Array' 'RF.F' 'DIM3' 'Word8')@
--- The concrete data is stored as a repa array (y * x * ABGR).
-_BitmapArray :: Functor f => (R.Array RF.F DIM3 Word8 -> f (R.Array RF.F DIM3 Word8)) -> Bitmap -> f Bitmap
-_BitmapArray f (BitmapData a h) = fmap (\a' -> BitmapData a' h) (f a)
-
--- | @'_BitmapHash' :: Lens' 'Bitmap' ('Maybe' 'Int')@
-_BitmapHash :: Functor f => (Maybe Int -> f (Maybe Int)) -> Bitmap -> f Bitmap
-_BitmapHash f (BitmapData a h) = fmap (\h' -> BitmapData a h') (f h)
-
--- | Create unstable 'Bitmap' from the given array.
-toBitmap :: R.Array RF.F DIM3 Word8 -> Bitmap
-toBitmap ar = BitmapData ar Nothing
-
--- | Create stable 'Bitmap' from the given array and compute the hash.
-toStableBitmap :: R.Array RF.F DIM3 Word8 -> Bitmap
-toStableBitmap ar = BitmapData ar $ Just $ foldAllS combine 0 $ R.map fromIntegral ar where
-    combine p q = hash (p, q)
-
--- | Create stable 'Bitmap' with unique hash from the given array.
-makeStableBitmap :: R.Array RF.F DIM3 Word8 -> IO Bitmap
-makeStableBitmap ar = BitmapData ar <$> Just <$> randomIO
+type Bitmap = C.Image C.PixelRGBA8
 
 -- | Get the size of the 'Bitmap'.
 bitmapSize :: Bitmap -> (Int, Int)
-bitmapSize (BitmapData a _) = let (Z :. h :. w :. _) = R.extent a in (w, h)
+bitmapSize (C.Image w h _) = (w, h)
 
 -- | Load an image file.
 readBitmap :: MonadIO m => FilePath -> m Bitmap
-readBitmap path = liftIO $ readImageRGBA path >>= either fail return >>= makeStableBitmap . imgData
+readBitmap path = liftIO (C.readImageRGBA8 path)
 
 {-# DEPRECATED loadBitmapFromFile "use readBitmap instead" #-}
 loadBitmapFromFile :: MonadIO m => FilePath -> m Bitmap
@@ -92,16 +46,11 @@ 
 -- | Save 'Bitmap' into a file.
 writeBitmap :: MonadIO m => FilePath -> Bitmap -> m ()
-writeBitmap path (BitmapData img _) = liftIO $ C.writePng path (C.Image w h $ V.unsafeFromForeignPtr0 (RF.toForeignPtr img) (h * w * 4) :: C.Image C.PixelRGBA8) where
-    R.Z R.:. h R.:. w R.:. _ = R.extent img
-
--- | Convert the 'Bitmap' uniformalized by the 'Hashable' value by the given function.
-onBitmapWithHashable :: Hashable h => h -> (R.Array RF.F DIM3 Word8 -> R.Array RF.F DIM3 Word8) -> Bitmap -> Bitmap
-onBitmapWithHashable v f (BitmapData ar h) = BitmapData (f ar) (hash <$> (,) v <$> h)
+writeBitmap path = liftIO . C.writePng path
 
 -- | Extract a 'Bitmap' from the specified range.
 cropBitmap :: Bitmap -- ^original bitmap
     -> (Int, Int) -- ^width and height
     -> (Int, Int) -- ^x and y
     -> Bitmap -- ^result
-cropBitmap bmp (w, h) (x, y) = onBitmapWithHashable (w,h,x,y) (computeS . extract (Z :. y :. x :. 0) (Z :. h :. w :. 4)) bmp
+cropBitmap = C.trimImage
FreeGame/Data/Font.hs view
@@ -25,10 +25,8 @@ import Control.Monad.IO.Class
 import Control.Monad
 import Data.IORef
-import Data.Array.Repa as R
-import Data.Array.Repa.Repr.ForeignPtr as R
 import qualified Data.Map as M
-import Data.Word
+import qualified Data.Vector.Storable as V
 import Linear
 import FreeGame.Types
 import FreeGame.Class
@@ -49,6 +47,8 @@ import Foreign.ForeignPtr
 import Foreign.Ptr
 import System.IO.Unsafe
+import Codec.Picture
+import Codec.Picture.RGBA8
 
 -- | Font object
 data Font = Font FT_Face (Double, Double) (BoundingBox Double) (IORef (M.Map (Double, Char) RenderedChar))
@@ -136,13 +136,7 @@ 
     adv <- peek $ GS.advance slot
 
-    let ar = fromForeignPtr (Z:.h:.w) fptr :: R.Array F DIM2 Word8
-        pix (crd:.3) = R.index ar crd
-        pix (_:._) = 255
-
-    result <- computeP (fromFunction (Z:.h:.w:.4) pix) >>= makeStableBitmap
-    
     return $ RenderedChar
-        result
+        (fromColorAndOpacity (PixelRGB8 255 255 255) $ Image w h $ V.unsafeFromForeignPtr0 fptr $ h * w)
         (V2 (left + fromIntegral w / 2) (-top + fromIntegral h / 2))
         (fromIntegral (V.x adv) / 64)
FreeGame/Instances.hs view
@@ -39,6 +39,8 @@ #define MK_PICTURE_2D(cxt, ty, l, t) instance (Picture2D m cxt) => Picture2D (ty) where { \
     bitmap b = (l) (bitmap b); \
     {-# INLINE bitmap #-}; \
+    bitmapOnce b = (l) (bitmapOnce b); \
+    {-# INLINE bitmapOnce #-}; \
     line = (l) . line; \
     polygon = (l) . polygon; \
     polygonOutline = (l) . polygonOutline; \
@@ -70,6 +72,7 @@     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; \
FreeGame/Internal/GLFW.hs view
@@ -6,19 +6,17 @@ import Control.Monad.IO.Class
 import Data.Color
 import Data.IORef
-import Foreign.ForeignPtr
 import FreeGame.Types
 import Graphics.Rendering.OpenGL.GL.StateVar
 import Graphics.Rendering.OpenGL.Raw.ARB.Compatibility
 import Linear
-import qualified Data.Array.Repa.Repr.ForeignPtr as RF
 import qualified Graphics.Rendering.OpenGL.GL as GL
 import qualified Graphics.UI.GLFW as GLFW
 import Unsafe.Coerce
-import Foreign.Marshal.Alloc
-import qualified Data.Array.Repa as R
-import Data.Word
-import qualified Data.Array.Repa.Operators.IndexSpace as R
+import qualified Data.Vector.Storable as V
+import qualified Data.Vector.Storable.Mutable as MV
+import Codec.Picture
+import Codec.Picture.RGBA8
 
 data System = System
     { refFrameCounter :: IORef Int
@@ -123,16 +121,15 @@     liftIO $ GL.lineWidth $= oldWidth
     return res
 
-installTexture :: R.Array RF.F R.DIM3 Word8 -> IO Texture
-installTexture ar = do
+installTexture :: Image PixelRGBA8 -> IO Texture
+installTexture (Image w h v) = do
     [tex] <- GL.genObjectNames 1
     GL.textureBinding GL.Texture2D GL.$= Just tex
-    let R.Z R.:. height R.:. width R.:. _ = R.extent ar
-    let siz = GL.TextureSize2D (gsizei width) (gsizei height)
-    withForeignPtr (RF.toForeignPtr ar)
+    let siz = GL.TextureSize2D (gsizei w) (gsizei h)
+    V.unsafeWith v
         $ GL.texImage2D GL.Texture2D GL.NoProxy 0 GL.RGBA8 siz 0
         . GL.PixelData GL.ABGR GL.UnsignedInt8888
-    return (tex, fromIntegral width / 2, fromIntegral height / 2)
+    return (tex, fromIntegral w / 2, fromIntegral h / 2)
 
 releaseTexture :: Texture -> IO ()
 releaseTexture (tex, _, _) = GL.deleteObjectNames [tex]
@@ -170,6 +167,7 @@         FullScreen -> GLFW.getPrimaryMonitor
         Windowed -> return Nothing
 
+    GLFW.windowHint (GLFW.WindowHint'Resizable False)
     Just win <- GLFW.createWindow ww wh title mon Nothing
     GLFW.makeContextCurrent (Just win)
     GL.lineSmooth $= GL.Enabled
@@ -177,6 +175,7 @@     GL.blendFunc  $= (GL.SrcAlpha, GL.OneMinusSrcAlpha)
     GL.shadeModel $= GL.Flat
     GL.textureFunction $= GL.Combine
+
     GLFW.swapInterval 1
     GL.clearColor $= GL.Color4 1 1 1 1
 
@@ -194,28 +193,22 @@     GLFW.terminate
     return res
 
-screenshotFlipped :: System -> IO (R.Array RF.F R.DIM3 Word8)
+screenshotFlipped :: System -> IO (Image PixelRGBA8)
 screenshotFlipped sys = do
     let BoundingBox x0 y0 x1 y1 = theRegion sys
         w = floor $ x1 - x0
         h = floor $ y1 - y0
-        sh = R.Z R.:. h R.:. w R.:. 4
     
-    ptr <- mallocBytes (w * h * 4)
+    mv <- MV.unsafeNew (w * h * 4)
     GL.readBuffer $= GL.FrontBuffers
-    GL.readPixels (GL.Position 0 0) (GL.Size (gsizei w) (gsizei h)) (GL.PixelData GL.RGBA GL.UnsignedByte ptr)
-
-    ptr' <- newForeignPtr_ ptr
-    return $ RF.fromForeignPtr sh ptr'
+    MV.unsafeWith mv
+        $ \ptr -> GL.readPixels (GL.Position 0 0) (GL.Size (gsizei w) (gsizei h))
+            (GL.PixelData GL.RGBA GL.UnsignedByte ptr)
 
-screenshot :: System -> IO (R.Array RF.F R.DIM3 Word8)
-screenshot sys = screenshotFlipped sys >>= flipVertically 
+    Image w h <$> V.unsafeFreeze mv
 
-flipVertically :: Monad m => R.Array RF.F R.DIM3 Word8 -> m (R.Array RF.F R.DIM3 Word8)
-flipVertically img = R.computeP $ R.unsafeBackpermute e order img where
-    e@(R.Z R.:. r R.:. _ R.:. _) = R.extent img
-    order (R.Z R.:. y R.:. x R.:. c) = R.Z R.:. r - 1 - y R.:. x R.:. c
-    {-# INLINE order #-}
+screenshot :: System -> IO (Image PixelRGBA8)
+screenshot sys = flipVertically <$> screenshotFlipped sys
 
 blendMode2BlendingFactors :: BlendMode -> (GL.BlendingFactor, GL.BlendingFactor)
 blendMode2BlendingFactors Normal = (GL.SrcAlpha, GL.OneMinusSrcAlpha)
FreeGame/UI.hs view
@@ -12,6 +12,7 @@ ----------------------------------------------------------------------------
 module FreeGame.UI (
     UI(..)
+    , reUI
     , Frame
     , Game
     , FreeGame(..)
@@ -42,12 +43,32 @@     | HideCursor a
     | ClearColor Color a
     | GetFPS (Int -> a)
+    | ForkFrame (Frame ()) a
     deriving Functor
 
 type Game = IterT Frame
 
 type Frame = F UI
 
+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 (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
+
+{-# RULES "reUI/Frame" 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. (Applicative f, Monad f, Picture2D f, Local f) => f a) => m a
@@ -55,6 +76,8 @@     preloadBitmap :: Bitmap -> m ()
     -- | Run a 'Frame', and release all the matter happened.
     bracket :: Frame a -> m a
+    -- | Run a 'Frame' action concurrently. Please do not use this function to draw pictures.
+    forkFrame :: Frame () -> m ()
     -- | Generate a 'Bitmap' from the front buffer.
     takeScreenshot :: m Bitmap
     setFPS :: Int -> m ()
@@ -64,7 +87,6 @@     clearColor :: Color -> m ()
     getFPS :: m Int
     
-
 instance FreeGame UI where
     draw = Draw
     {-# INLINE draw #-}
@@ -73,6 +95,7 @@     
     bracket = Bracket
     {-# INLINE bracket #-}
+    forkFrame m = ForkFrame m ()
     takeScreenshot = TakeScreenshot id
     setFPS a = SetFPS a ()
     setTitle t = SetTitle t ()
@@ -99,14 +122,20 @@ 
 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
FreeGame/Util.hs view
@@ -53,6 +53,7 @@ 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 ()
@@ -68,12 +69,12 @@ foreverFrame m = foreverTick (lift m)
 
 -- | Extract the next frame of the action.
-untick :: (Functor f, MonadFree f m) => IterT (F f) a -> m (Either (IterT (F f) a) a)
-untick = liftM (either Right Left) . iterM wrap . runIterT where
+untick :: (Monad m, FreeGame m) => IterT Frame a -> m (Either (IterT Frame a) a)
+untick = liftM (either Right Left) . iterM (join . reUI) . runIterT where
 
 -- | An infinite version of 'untick'.
-untickInfinite :: (Functor f, MonadFree f m) => IterT (F f) Void -> m (IterT (F f) Void)
-untickInfinite = liftM (either absurd id) . iterM wrap . runIterT where
+untickInfinite :: (Monad m, FreeGame m) => IterT Frame Void -> m (IterT Frame Void)
+untickInfinite = liftM (either absurd id) . iterM (join . reUI) . runIterT where
 
 -- | An unit vector with the specified angle.
 unitV2 :: Floating a => a -> V2 a
free-game.cabal view
@@ -1,5 +1,5 @@ name:                free-game
-version:             1.0.2
+version:             1.0.3
 synopsis:            Create games for free
 description:
     free-game defines a monad that integrates features to create 2D games.
@@ -49,22 +49,20 @@     colors == 0.1.*,
     containers >= 0.4,
     control-bool,
-    data-default,
     directory >= 1.0,
     filepath >= 1.3,
-    free >= 4.4 && < 5,
+    free >= 4.5 && < 5,
     freetype2 >= 0.1,
     GLFW-b >= 1.3 && <2,
     hashable >= 1.2,
     JuicyPixels,
-    JuicyPixels-repa >= 0.5 && <1,
+    JuicyPixels-util == 0.1.*,
     linear >= 1.0 && < 1.7,
     mtl >= 2.1,
     OpenGL == 2.9.*,
     OpenGLRaw == 1.4.*,
     random == 1.*,
     reflection==1.*,
-    repa,
     template-haskell,
     transformers >= 0.3,
     vector >= 0.9 && <0.12,