free-game 0.3.1.1 → 0.3.1.2

raw patch · 6 files changed

+116/−103 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Graphics/FreeGame/Backends/GLFW.hs +107/−96
• Graphics/FreeGame/Base.hs +4/−2
• Graphics/FreeGame/Data/Bitmap.hs +3/−3
• Graphics/FreeGame/Data/Font.hs +0/−1
• Graphics/FreeGame/Simple.hs +1/−0
• free-game.cabal +1/−1

@@ -90,6 +90,53 @@ 
 drawPic (IOPicture m) = m >>= drawPic
 
+
+run :: (?windowWidth :: Int, ?windowHeight :: Int
+    , ?refTextures :: IORef (IM.IntMap Texture)
+    , ?refFrame :: IORef Int
+    , ?frameTime :: Double
+    ) => [Int] -> Game a -> IO (Maybe a)
+run is (Pure x) = do
+    m <- readIORef ?refTextures
+    GL.deleteObjectNames [texObj $ m IM.! i | i <- is]
+    modifyIORef ?refTextures $ flip (foldr IM.delete) is
+    return (Just x)
+run is (Free f) = case f of
+    DrawPicture pic cont -> do
+        ls <- GL.preservingMatrix $ do
+            GL.loadIdentity
+            GL.scale (gf 1) (-1) 1
+            GL.ortho 0 (fromIntegral ?windowWidth) 0 (fromIntegral ?windowHeight) 0 (-100)
+            GL.matrixMode   $= GL.Modelview 0
+            ls <- drawPic pic
+            GL.matrixMode   $= GL.Projection
+            return ls
+        flip run cont $! ls Prelude.++ is -- Strict!!!
+    EmbedIO m -> m >>= run is
+    Bracket m -> run [] m >>= maybe (return Nothing) (run is)
+    Tick cont -> do
+        swapBuffers
+        t <- getTime
+        n <- readIORef ?refFrame
+        sleep (fromIntegral n * ?frameTime - t)
+        if t > 1
+            then resetTime >> writeIORef ?refFrame 0
+            else writeIORef ?refFrame (succ n)
+
+        r <- windowIsOpen
+        if r
+            then GL.clear [GL.ColorBuffer] >> performGC >> run is cont
+            else return Nothing
+    AskInput key fcont -> keyIsPressed (mapKey key) >>= run is . fcont
+    GetMouseState fcont -> do
+        (x, y) <- getMousePosition
+        b0 <- mouseButtonIsPressed MouseButton0
+        b1 <- mouseButtonIsPressed MouseButton1
+        b2 <- mouseButtonIsPressed MouseButton1
+        w <- getMouseWheel
+        run is $ fcont $ I.MouseState (Vec2 (fromIntegral x) (fromIntegral y)) b0 b2 b1 w
+    QuitGame -> return Nothing
+
 -- | Run 'Game' using OpenGL and GLFW.
 runGame :: GameParam -> Game a -> IO (Maybe a)
 runGame param game = do
@@ -97,19 +144,28 @@     pf <- openGLProfile
     let ?windowWidth = fst $ windowSize param
         ?windowHeight = snd $ windowSize param
+    
     openWindow $ defaultDisplayOptions {
         displayOptions_width = fromIntegral ?windowWidth
         ,displayOptions_height = fromIntegral ?windowHeight
         ,displayOptions_displayMode = Window
         ,displayOptions_windowIsResizable = False
         ,displayOptions_openGLProfile = pf
+        ,displayOptions_numDepthBits = 8
     }
+    
+    unless (cursorVisible param) $ disableMouseCursor
+
     setWindowTitle $ windowTitle param
+    
     GL.lineSmooth $= GL.Enabled
     GL.blend      $= GL.Enabled
     GL.blendFunc  $= (GL.SrcAlpha, GL.OneMinusSrcAlpha)
     GL.shadeModel $= GL.Smooth
-    GL.clearColor $= GL.Color4 1 1 1 1
+    
+    let Color r g b a = clearColor param
+    GL.clearColor $= GL.Color4 (gf r) (gf g) (gf b) (gf a)
+
     ref <- newIORef IM.empty
     ref' <- newIORef 0
     let ?refTextures = ref
@@ -120,102 +176,57 @@     closeWindow
     terminate
     return r
-    where
-    run :: (?windowWidth :: Int, ?windowHeight :: Int
-        , ?refTextures :: IORef (IM.IntMap Texture)
-        , ?refFrame :: IORef Int
-        , ?frameTime :: Double) => [Int] -> Game a -> IO (Maybe a)
-    run is (Pure x) = do
-        m <- readIORef ?refTextures
-        GL.deleteObjectNames [texObj $ m IM.! i | i <- is]
-        modifyIORef ?refTextures $ flip (foldr IM.delete) is
-        return (Just x)
-    run is (Free f) = case f of
-        DrawPicture pic cont -> do
-            ls <- GL.preservingMatrix $ do
-                GL.loadIdentity
-                GL.scale (gf 1) (-1) 1
-                GL.ortho 0 (fromIntegral ?windowWidth) 0 (fromIntegral ?windowHeight) 0 (-100)
-                GL.matrixMode   $= GL.Modelview 0
-                ls <- drawPic pic
-                GL.matrixMode   $= GL.Projection
-                return ls
-            flip run cont $! ls Prelude.++ is -- Strict!!!
-        EmbedIO m -> m >>= run is
-        Bracket m -> run [] m >>= maybe (return Nothing) (run is)
-        Tick cont -> do
-            swapBuffers
-            t <- getTime
-            n <- readIORef ?refFrame
-            sleep (fromIntegral n * ?frameTime - t)
-            if t > 1
-                then resetTime >> writeIORef ?refFrame 0
-                else writeIORef ?refFrame (succ n)
 
-            r <- windowIsOpen
-            if r
-                then GL.clear [GL.ColorBuffer] >> performGC >> run is cont
-                else return Nothing
-        AskInput key fcont -> keyIsPressed (mapKey key) >>= run is . fcont
-        GetMouseState fcont -> do
-            (x, y) <- getMousePosition
-            b0 <- mouseButtonIsPressed MouseButton0
-            b1 <- mouseButtonIsPressed MouseButton1
-            b2 <- mouseButtonIsPressed MouseButton1
-            w <- getMouseWheel
-            run is $ fcont $ I.MouseState (Vec2 (fromIntegral x) (fromIntegral y)) b0 b2 b1 w
-        QuitGame -> return Nothing
-
-    mapKey k = case k of
-        I.KeyChar c -> CharKey c
-        I.KeySpace -> KeySpace
-        I.KeyF1 -> KeyF1
-        I.KeyF2 -> KeyF2
-        I.KeyF3 -> KeyF3
-        I.KeyF4 -> KeyF4
-        I.KeyF5 -> KeyF5
-        I.KeyF6 -> KeyF6
-        I.KeyF7 -> KeyF7
-        I.KeyF8 -> KeyF8
-        I.KeyF9 -> KeyF9
-        I.KeyF10 -> KeyF10
-        I.KeyF11 -> KeyF11
-        I.KeyF12 -> KeyF12
-        I.KeyEsc -> KeyEsc
-        I.KeyUp -> KeyUp
-        I.KeyDown -> KeyDown
-        I.KeyLeft -> KeyLeft
-        I.KeyRight -> KeyRight
-        I.KeyLeftShift -> KeyLeftShift
-        I.KeyRightShift -> KeyLeftShift
-        I.KeyLeftControl -> KeyLeftCtrl
-        I.KeyRightControl -> KeyRightCtrl
-        I.KeyTab -> KeyTab
-        I.KeyEnter -> KeyEnter
-        I.KeyBackspace -> KeyBackspace
-        I.KeyInsert -> KeyInsert
-        I.KeyDelete -> KeyDel
-        I.KeyPageUp -> KeyPageup
-        I.KeyPageDown -> KeyPagedown
-        I.KeyHome -> KeyHome
-        I.KeyEnd -> KeyEnd
-        I.KeyPad0 -> KeyPad0
-        I.KeyPad1 -> KeyPad1
-        I.KeyPad2 -> KeyPad2
-        I.KeyPad3 -> KeyPad3
-        I.KeyPad4 -> KeyPad4
-        I.KeyPad5 -> KeyPad5
-        I.KeyPad6 -> KeyPad6
-        I.KeyPad7 -> KeyPad7
-        I.KeyPad8 -> KeyPad8
-        I.KeyPad9 -> KeyPad9
-        I.KeyPadDivide -> KeyPadDivide
-        I.KeyPadMultiply -> KeyPadMultiply
-        I.KeyPadSubtract -> KeyPadSubtract
-        I.KeyPadAdd -> KeyPadAdd
-        I.KeyPadDecimal -> KeyPadDecimal
-        I.KeyPadEqual -> KeyPadEqual
-        I.KeyPadEnter -> KeyPadEnter
+mapKey k = case k of
+    I.KeyChar c -> CharKey c
+    I.KeySpace -> KeySpace
+    I.KeyF1 -> KeyF1
+    I.KeyF2 -> KeyF2
+    I.KeyF3 -> KeyF3
+    I.KeyF4 -> KeyF4
+    I.KeyF5 -> KeyF5
+    I.KeyF6 -> KeyF6
+    I.KeyF7 -> KeyF7
+    I.KeyF8 -> KeyF8
+    I.KeyF9 -> KeyF9
+    I.KeyF10 -> KeyF10
+    I.KeyF11 -> KeyF11
+    I.KeyF12 -> KeyF12
+    I.KeyEsc -> KeyEsc
+    I.KeyUp -> KeyUp
+    I.KeyDown -> KeyDown
+    I.KeyLeft -> KeyLeft
+    I.KeyRight -> KeyRight
+    I.KeyLeftShift -> KeyLeftShift
+    I.KeyRightShift -> KeyLeftShift
+    I.KeyLeftControl -> KeyLeftCtrl
+    I.KeyRightControl -> KeyRightCtrl
+    I.KeyTab -> KeyTab
+    I.KeyEnter -> KeyEnter
+    I.KeyBackspace -> KeyBackspace
+    I.KeyInsert -> KeyInsert
+    I.KeyDelete -> KeyDel
+    I.KeyPageUp -> KeyPageup
+    I.KeyPageDown -> KeyPagedown
+    I.KeyHome -> KeyHome
+    I.KeyEnd -> KeyEnd
+    I.KeyPad0 -> KeyPad0
+    I.KeyPad1 -> KeyPad1
+    I.KeyPad2 -> KeyPad2
+    I.KeyPad3 -> KeyPad3
+    I.KeyPad4 -> KeyPad4
+    I.KeyPad5 -> KeyPad5
+    I.KeyPad6 -> KeyPad6
+    I.KeyPad7 -> KeyPad7
+    I.KeyPad8 -> KeyPad8
+    I.KeyPad9 -> KeyPad9
+    I.KeyPadDivide -> KeyPadDivide
+    I.KeyPadMultiply -> KeyPadMultiply
+    I.KeyPadSubtract -> KeyPadSubtract
+    I.KeyPadAdd -> KeyPadAdd
+    I.KeyPadDecimal -> KeyPadDecimal
+    I.KeyPadEqual -> KeyPadEqual
+    I.KeyPadEnter -> KeyPadEnter
 
 gf :: Float -> GL.GLfloat
 {-# INLINE gf #-}

@@ -114,7 +114,7 @@     = BitmapPicture Bitmap
     -- | A picture consist of some 'Picture's.
     | Pictures [Picture]
-    -- | A picture that may have side effects.
+    -- | A picture that may have side effects(rarely needed).
     | IOPicture (IO Picture)
     -- | Rotated picture by the given angle (in degrees, counterclockwise).
     | Rotate Float Picture
@@ -131,11 +131,13 @@         ,windowSize :: (Int, Int)
         ,windowTitle :: String
         ,windowed :: Bool
+        ,cursorVisible :: Bool
+        ,clearColor :: Color
     }
 
 -- | 640*480(windowed), 60fps
 defaultGameParam :: GameParam
-defaultGameParam = GameParam 60 (640,480) "free-game" True
+defaultGameParam = GameParam 60 (640,480) "free-game" True True white
 
 {-# DEPRECATED loadPicture "No longer needed; use BitmapPicture instead" #-}
 -- | Create a 'Picture' from 'Bitmap'.

@@ -47,16 +47,16 @@     ,bitmapHash :: Maybe Int -- ^ This value is used to ensure that two bitmaps are equivalent.
     }
 
--- Create unstable 'Bitmap' from the given array.
+-- | Create unstable 'Bitmap' from the given array.
 toBitmap :: R.Array RF.F DIM3 Word8 -> Bitmap
 toBitmap ar = Bitmap ar Nothing
 
--- Create stable 'Bitmap' from the given array and compute the hash.
+-- | Create stable 'Bitmap' from the given array and compute the hash.
 toStableBitmap :: R.Array RF.F DIM3 Word8 -> Bitmap
 toStableBitmap ar = Bitmap ar $ Just $ head $ foldAllP combine 0 $ R.map fromIntegral ar where
     combine p q = hash (p, q)
 
--- Create stable 'Bitmap' with unique hash from the given array.
+-- | Create stable 'Bitmap' with unique hash from the given array.
 makeStableBitmap :: R.Array RF.F DIM3 Word8 -> IO Bitmap
 makeStableBitmap ar = Bitmap ar <$> Just <$> randomIO
 

@@ -36,7 +36,6 @@ import Foreign.Storable
 import System.IO.Unsafe
 import Unsafe.Coerce
-import Paths_free_game
 
 -- | Font object
 data Font = Font FT_Face (IORef (M.Map (Float, Char) RenderedChar))

@@ -33,6 +33,7 @@     ,Vec2(..)
 
     -- * Drawing texts
+    ,Font
     ,loadFont
     ,text
 

@@ -1,5 +1,5 @@ name:                free-game
-version:             0.3.1.1
+version:             0.3.1.2
 synopsis:            Create graphical applications for free.
 description:         Cross-platform GUI library based on free monads.
 homepage:            https://github.com/fumieval/free-game