free-game 1.1.79 → 1.1.80

raw patch · 10 files changed

+136/−27 lines, 10 filesdep ~JuicyPixels-utildep ~mtl

Dependency ranges changed: JuicyPixels-util, mtl

Files

• CHANGELOG.md +19/−7
• FreeGame.hs +1/−0
• FreeGame/Backend/GLFW.hs +7/−2
• FreeGame/Class.hs +1/−0
• FreeGame/Instances.hs +1/−0
• FreeGame/Internal/GLFW.hs +25/−8
• FreeGame/UI.hs +6/−3
• examples/demo.hs +6/−4
• examples/fib.hs +67/−0
• free-game.cabal +3/−3

@@ -1,13 +1,25 @@+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.
@@ -15,7 +27,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`.
@@ -26,18 +38,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`.

@@ -58,6 +58,7 @@     keyDown,
     -- * Mouse
     Mouse(),
+    mouseScroll,
     mouseInWindow,
     mousePositionMay,
     mousePosition,

@@ -67,15 +67,17 @@     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
 
@@ -85,6 +87,7 @@     , 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
@@ -96,6 +99,7 @@     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_
 
@@ -119,6 +123,7 @@     , 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
@@ -140,10 +145,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

@@ -144,6 +144,7 @@     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

@@ -67,6 +67,7 @@     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 { \

@@ -20,16 +20,26 @@ 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
-    , refFPS :: IORef Int
-    , theFPS :: IORef Int
+    , theFPS :: IORef Double
+    , frameTimes :: IORef (S.Seq Double)
     , 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 ()
@@ -146,6 +156,8 @@     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
@@ -154,10 +166,14 @@     Just t <- GLFW.getTime
     n <- readIORef (refFrameCounter sys)
     fps <- readIORef (theFPS sys)
-    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)
+    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'
     GLFW.windowShouldClose (theWindow sys)
 
 withGLFW :: WindowMode -> BoundingBox2 -> (System -> IO a) -> IO a
@@ -191,9 +207,10 @@ 
     sys <- System
         <$> newIORef 0
-        <*> newIORef 0
         <*> newIORef 60
+        <*> newIORef S.empty
         <*> newIORef 60
+        <*> newIORef 0
         <*> pure rbox
         <*> pure win
 

@@ -40,9 +40,10 @@     | MouseButtons (Map.Map Int ButtonState -> a)
     | MousePosition (Vec2 -> a)
     | MouseInWindow (Bool -> a)
+    | MouseScroll (Vec2 -> a)
     | TakeScreenshot (Bitmap -> a)
     | Bracket (Frame a)
-    | SetFPS Int a
+    | SetFPS Double a
     | SetTitle String a
     | ShowCursor a
     | HideCursor a
@@ -77,6 +78,7 @@ 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
@@ -103,7 +105,7 @@     -- | Generate a 'Bitmap' from the front buffer.
     takeScreenshot :: m Bitmap
     -- | Set the goal FPS.
-    setFPS :: Int -> m ()
+    setFPS :: Double -> m ()
     setTitle :: String -> m ()
     showCursor :: m ()
     hideCursor :: m ()
@@ -178,4 +180,5 @@     globalMousePosition = MousePosition id
     -- mouseWheel = MouseWheel id
     mouseButtons_ = MouseButtons id
-    mouseInWindow = MouseInWindow id+    mouseInWindow = MouseInWindow id
+    mouseScroll = MouseScroll id

@@ -47,8 +47,8 @@     color (Color 0 0 1 1) $ do
         translate (V2 293 359) $ bitmap bmp -- 'bitmap' creates an action from the bitmap.
     
-mouseTest :: Frame ()
-mouseTest = whenM mouseInWindow $ do
+mouseTest :: Font -> Frame ()
+mouseTest font = whenM mouseInWindow $ do
     p <- mousePosition
     l <- mouseButtonL
     r <- mouseButtonR
@@ -58,7 +58,9 @@             (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"
     bmp' <- readBitmap "logo.png"
@@ -74,7 +76,7 @@ 
         fontTest font
         translate (V2 240 240) $ do
-            mouseTest
+            mouseTest font
 
             fps <- getFPS
 

@@ -0,0 +1,67 @@+{-# 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
+    }
+makeLenses ''World
+
+fibs = 1 : 1 : zipWith (+) fibs (tail fibs)
+
+speed = 1
+
+update :: Font -> StateT World Game ()
+update font = do
+    s0 <- use seq0
+    s1 <- use seq1
+    ofs <- use offset
+    t <- use target
+    
+    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)
+  where
+    p0 = V2 390 320
+
+mainLoop :: Font -> World -> Game ()
+mainLoop font s = do
+  s' <- execStateT (update font) s
+  tick
+  mainLoop font s'
+
+main = runGameDefault $ do
+    font <- loadFont "VL-PGothic-Regular.ttf"
+    runMaybeT $ forever $ do {tick;()<-whenM (keyDown KeySpace) mzero; return ()}
+    mainLoop font $ World [1,1] [1] (V2 400 0) 0 (Scroll 36)

@@ -1,5 +1,5 @@ name:                free-game
-version:             1.1.79
+version:             1.1.80
 synopsis:            Create games for free
 description:
     free-game defines a monad that integrates features to create 2D games.
@@ -60,9 +60,9 @@     GLFW-b >= 1.3 && <2,
     hashable >= 1.2,
     JuicyPixels,
-    JuicyPixels-util == 0.1.*,
+    JuicyPixels-util >=0.1.1 && < 0.3,
     linear >= 1.0 && < 2,
-    mtl >= 2.1 && <3,
+    mtl >= 2.2 && <3,
     OpenGL == 2.9.*,
     OpenGLRaw >= 1.3 && < 1.6,
     random == 1.*,