free-game 1.1.80 → 1.1.81

raw patch · 13 files changed

+88/−36 lines, 13 filesdep ~OpenGLdep ~colors

Dependency ranges changed: OpenGL, colors

Files

• FreeGame.hs +1/−0
• FreeGame/Class.hs +4/−2
• FreeGame/Data/Bitmap.hs +2/−0
• FreeGame/Data/Font.hs +5/−3
• FreeGame/Instances.hs +2/−0
• FreeGame/Internal/Finalizer.hs +2/−0
• FreeGame/Internal/GLFW.hs +5/−3
• FreeGame/UI.hs +16/−10
• FreeGame/Util.hs +3/−2
• examples/demo.hs +4/−3
• examples/demo_stateful.hs +23/−0
• examples/fib.hs +16/−8
• free-game.cabal +5/−5

@@ -35,6 +35,7 @@     globalize,
     localize,
     -- * Pictures
+    Drawable,
     Picture2D(..),
     BlendMode(..),
     Bitmap,

@@ -8,12 +8,14 @@ -- 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
@@ -54,7 +56,7 @@     circle :: Double -> p ()
     circleOutline :: Double -> p ()
     thickness :: Float -> p a -> p a
-    color :: Color -> p a -> p a
+    color :: Color Float -> p a -> p a
     blendMode :: BlendMode -> p a -> p a
 
 class Affine p => Local p where

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

@@ -10,7 +10,7 @@ --
 -- Rendering characters
 ----------------------------------------------------------------------------
-module FreeGame.Data.Font 
+module FreeGame.Data.Font
   ( Font
   , loadFontFromFile
   , loadFont
@@ -21,7 +21,9 @@   , RenderedChar(..)
   ) where
 
+#if !MIN_VERSION_base(4,8,0)
 import Control.Applicative
+#endif
 import Control.Monad.IO.Class
 import Control.Monad
 import Data.IORef
@@ -119,7 +121,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
 
@@ -132,7 +134,7 @@ 
     let h = fromIntegral $ B.rows bmp
         w = fromIntegral $ B.width bmp
-    
+
     fptr <- newForeignPtr_ $ castPtr $ buffer bmp
 
     adv <- peek $ GS.advance slot

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

@@ -3,7 +3,9 @@ 
 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,7 +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.Color
@@ -109,7 +111,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 -> IO a -> IO a
+color :: Color Float -> IO a -> IO a
 color col m = do
     oldColor <- liftIO $ get GL.currentColor
     liftIO $ GL.currentColor $= unsafeCoerce col
@@ -171,7 +173,7 @@     t0 <- readIORef (startTime sys)
     fs <- readIORef (frameTimes sys)
     Just t1 <- GLFW.getTime
-    let fs' = trim1 $ fs S.|> (t1 - t0)
+    let !fs' = trim1 $ fs S.|> (t1 - t0)
     writeIORef (currentFPS sys) (S.length fs')
     writeIORef (frameTimes sys) fs'
     GLFW.windowShouldClose (theWindow sys)
@@ -247,4 +249,4 @@     GL.blendFunc $= blendMode2BlendingFactors mode
     a <- m
     GL.blendFunc $= oldFunc
-    return a+    return a

@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveFunctor, ExistentialQuantification, Rank2Types #-}
+{-# LANGUAGE DeriveFunctor, ExistentialQuantification, Rank2Types, UndecidableInstances #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  FreeGame.UI
@@ -12,6 +12,7 @@ ----------------------------------------------------------------------------
 module FreeGame.UI (
     UI(..)
+    , Drawable
     , reUI
     , reFrame
     , reGame
@@ -23,17 +24,22 @@ 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. (Applicative m, Monad m, Picture2D m, Local m) => m a)
+    Draw (forall m. Drawable m => m a)
     | PreloadBitmap Bitmap a
     | FromFinalizer (FinalizerT IO a)
     | KeyStates (Map.Map Key ButtonState -> a)
@@ -47,7 +53,7 @@     | SetTitle String a
     | ShowCursor a
     | HideCursor a
-    | ClearColor Color a
+    | ClearColor (Color Float) a
     | GetFPS (Int -> a)
     | ForkFrame (Frame ()) a
     | GetBoundingBox (BoundingBox2 -> a)
@@ -95,7 +101,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. (Applicative f, Monad f, Picture2D f, Local f) => f a) -> m a
+    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.
@@ -109,18 +115,18 @@     setTitle :: String -> m ()
     showCursor :: m ()
     hideCursor :: m ()
-    clearColor :: Color -> 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 ()
@@ -134,7 +140,7 @@     getBoundingBox = GetBoundingBox id
     setBoundingBox s = SetBoundingBox s ()
 
-overDraw :: (forall m. (Applicative m, Monad m, Picture2D m, Local m) => m a -> m a) -> UI a -> UI a
+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 #-}
@@ -181,4 +187,4 @@     -- mouseWheel = MouseWheel id
     mouseButtons_ = MouseButtons id
     mouseInWindow = MouseInWindow id
-    mouseScroll = MouseScroll id+    mouseScroll = MouseScroll id

@@ -35,7 +35,9 @@     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
@@ -62,7 +64,6 @@ -- | 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
@@ -109,7 +110,7 @@ loadBitmapsWith getFullPath path = do
     loc <- (</>path) <$> takeDirectory <$> loc_filename <$> location
     paths <- runIO $ getFileList loc
-    
+
     sequence $ do
         p <- paths
         let name = pathToName p

@@ -40,11 +40,11 @@ bitmapTest :: Bitmap -> Frame ()
 bitmapTest bmp = blendMode Add $ do
     
-    color (Color 1 0 0 1) $ do
+    color (fromRGB 1 0 0) $ do
         translate (V2 300 346) $ bitmap bmp -- 'bitmap' creates an action from the bitmap.
-    color (Color 0 1 0 1) $ do
+    color (fromRGB 0 1 0) $ do
         translate (V2 310 350) $ bitmap bmp -- 'bitmap' creates an action from the bitmap.
-    color (Color 0 0 1 1) $ do
+    color (fromRGB 0 0 1) $ do
         translate (V2 293 359) $ bitmap bmp -- 'bitmap' creates an action from the bitmap.
     
 mouseTest :: Font -> Frame ()
@@ -61,6 +61,7 @@     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"

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

@@ -12,6 +12,8 @@     , _offset :: Vec2
     , _target :: Int
     , _mode :: Mode
+    -- visual
+    , _font :: Font
     }
 makeLenses ''World
 
@@ -19,12 +21,13 @@ 
 speed = 1
 
-update :: Font -> StateT World Game ()
-update font = do
+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
@@ -52,16 +55,21 @@           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 :: Font -> World -> Game ()
-mainLoop font s = do
-  s' <- execStateT (update font) s
+mainLoop :: World -> Game ()
+mainLoop s = do
+  s' <- execStateT update s
   tick
-  mainLoop font s'
+  unlessM (keyDown KeyEscape) $ mainLoop 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)+    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.80
+version:             1.1.81
 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
+  default-extensions: FlexibleContexts, FlexibleInstances, CPP
   build-depends:
     array >= 0.4,
     base == 4.*,
-    colors == 0.1.*,
+    colors == 0.3.*,
     containers >= 0.4,
     control-bool,
     directory >= 1.0,
@@ -63,7 +63,7 @@     JuicyPixels-util >=0.1.1 && < 0.3,
     linear >= 1.0 && < 2,
     mtl >= 2.2 && <3,
-    OpenGL == 2.9.*,
+    OpenGL >= 2.9 && <3,
     OpenGLRaw >= 1.3 && < 1.6,
     random == 1.*,
     reflection == 1.*,
@@ -72,4 +72,4 @@     vector >= 0.9 && <0.12,
     void >= 0.5,
     boundingboxes >= 0.2 && < 0.4,
-    lens >= 3.8 && < 5+    lens >= 3.8 && < 5