free-game 0.3.1.4 → 0.3.2.0

raw patch · 9 files changed

+206/−169 lines, 9 filesdep +transformersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: transformers

API changes (from Hackage documentation)

Files

• Graphics/FreeGame/Backends/GLFW.hs +89/−102
• Graphics/FreeGame/Base.hs +22/−16
• Graphics/FreeGame/Data/Font.hs +65/−43
• Graphics/FreeGame/Input.hs +3/−0
• Graphics/FreeGame/Types.hs +17/−0
• Graphics/FreeGame/Util.hs +0/−1
• examples/font.hs +4/−3
• examples/test.hs +1/−1
• free-game.cabal +5/−3

@@ -17,47 +17,37 @@ import Graphics.FreeGame.Data.Bitmap
 import Graphics.FreeGame.Data.Color
 import qualified Graphics.FreeGame.Input as I
-import Codec.Picture.Repa
 import Control.Applicative
 import Control.Monad.Free
 import Control.Monad
-import System.Random
-import Data.Unique
 import Data.IORef
-import Data.Array.Repa as R
 import Data.StateVar
 import qualified Data.Array.Repa.Repr.ForeignPtr as RF
 import Foreign.ForeignPtr
 import qualified Data.IntMap as IM
 import Unsafe.Coerce
-import Data.Vect
 import System.Mem
 
-data Texture = Texture {texObj :: GL.TextureObject, texWidth :: Int, texHeight :: Int}
+data Texture = Texture GL.TextureObject Int Int
 
 installTexture :: Bitmap -> IO Texture
 installTexture bmp = do
     [tex] <- GL.genObjectNames 1
     GL.textureBinding GL.Texture2D GL.$= Just tex
 
-    let ar = bitmapData bmp
     let (width, height) = bitmapSize bmp
-    withForeignPtr (RF.toForeignPtr ar)
+    withForeignPtr (RF.toForeignPtr $ bitmapData bmp)
         $ GL.texImage2D Nothing GL.NoProxy 0 GL.RGBA8 (GL.TextureSize2D (gsizei width) (gsizei height)) 0
         . GL.PixelData GL.RGBA GL.UnsignedInt8888
     return $ Texture tex width height
 
 freeTexture :: Texture -> IO ()
-freeTexture (Texture tex width height) = GL.deleteObjectNames [tex]
+freeTexture (Texture tex _ _) = GL.deleteObjectNames [tex]
 
 drawTexture :: Texture -> IO ()
 drawTexture (Texture tex width height) = do
     let (w, h) = (fromIntegral width / 2, fromIntegral height / 2)
-    GL.textureWrapMode GL.Texture2D GL.S $= (GL.Repeated, GL.Clamp)
-    GL.textureWrapMode GL.Texture2D GL.T $= (GL.Repeated, GL.Clamp)
-    GL.textureFilter   GL.Texture2D      $= ((GL.Nearest, Nothing), GL.Nearest)
-    GL.texture GL.Texture2D $= GL.Enabled
-    GL.textureFunction      $= GL.Combine    
+    GL.textureFilter   GL.Texture2D $= ((GL.Nearest, Nothing), GL.Nearest)
     GL.textureBinding GL.Texture2D $= Just tex
     GL.renderPrimitive GL.Polygon $ zipWithM_
         (\(pX, pY) (tX, tY) -> do
@@ -65,7 +55,6 @@             GL.vertex $ GL.Vertex2   (gf pX) (gf pY))
         [(-w, -h), (w, -h), (w, h), (-w, h)]
         [(0,0), (1.0,0), (1.0,1.0), (0,1.0)]
-    GL.texture GL.Texture2D GL.$= GL.Disabled
 
 drawPic :: (?refTextures :: IORef (IM.IntMap Texture)) => Picture -> IO [Int]
 drawPic (BitmapPicture bmp) = case bitmapHash bmp of
@@ -85,49 +74,33 @@                 return [h]
 
 drawPic (Rotate theta p) = GL.preservingMatrix $ GL.rotate (gf (-theta)) (GL.Vector3 0 0 1) >> drawPic p
-
 drawPic (Scale (Vec2 sx sy) p) = GL.preservingMatrix $ GL.scale (gf sx) (gf sy) 1 >> drawPic p
-
 drawPic (Translate (Vec2 tx ty) p) = GL.preservingMatrix $ GL.translate (GL.Vector3 (gf tx) (gf ty) 0) >> drawPic p
-
 drawPic (Pictures ps) = concat <$> mapM drawPic ps
-
+drawPic (IOPicture m) = m >>= drawPic
 drawPic (Colored (Color r g b a) pic) = do
     oldColor <- get GL.currentColor
     GL.currentColor  $= GL.Color4 (gf r) (gf g) (gf b) (gf a)
-    r <- drawPic pic
+    xs <- drawPic pic
     GL.currentColor $= oldColor
-    return r
-
-drawPic (IOPicture m) = m >>= drawPic
-
+    return xs
 
 run :: (?windowWidth :: Int, ?windowHeight :: Int
     , ?refTextures :: IORef (IM.IntMap Texture)
     , ?refFrame :: IORef Int
     , ?frameTime :: Double
-    , ?windowTitle :: String, ?windowMode :: Bool
+    , ?windowTitle :: String
+    , ?windowMode :: Bool
     , ?cursorVisible :: Bool
     ) => [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
+        ls <- drawPic pic
         flip run cont $! ls Prelude.++ is -- Strict!!!
     EmbedIO m -> m >>= run is
     Bracket m -> run [] m >>= maybe (return Nothing) (run is)
     Tick cont -> do
+        GL.matrixMode   $= GL.Projection
         swapBuffers
         t <- getTime
         n <- readIORef ?refFrame
@@ -138,16 +111,21 @@ 
         r <- windowIsOpen
         if r
-            then GL.clear [GL.ColorBuffer] >> performGC >> run is cont
+            then do
+                GL.clear [GL.ColorBuffer] 
+                performGC
+                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
+                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 MouseButton2
-        w <- getMouseWheel
-        run is $ fcont $ I.MouseState (Vec2 (fromIntegral x) (fromIntegral y)) b0 b2 b1 w
+    AskInput key fcont -> either keyIsPressed mouseButtonIsPressed (mapKey key) >>= run is . fcont
+    GetMousePosition fcont -> do
+        (x, y) <- GLFW.getMousePosition
+        run is $ fcont $ Vec2 (fromIntegral x) (fromIntegral y)
+    GetMouseWheel fcont -> GLFW.getMouseWheel >>= run is . fcont
     GetGameParam fcont -> do
         dim <- GLFW.getWindowDimensions
         GL.Color4 r g b a <- get GL.clearColor
@@ -162,24 +140,28 @@                                                         (realToFrac a)
                                    }
     QuitGame -> return Nothing
+run is (Pure x) = do
+    m <- readIORef ?refTextures
+    GL.deleteObjectNames [obj | i <- is, let Texture obj _ _ = m IM.! i]
+    modifyIORef ?refTextures $ flip (foldr IM.delete) is
+    return (Just x)
 
 -- | Run 'Game' using OpenGL and GLFW.
 runGame :: GameParam -> Game a -> IO (Maybe a)
 runGame param game = do
-    initialize
+    True <- initialize
     pf <- openGLProfile
     let ?windowWidth = fst $ windowSize param
         ?windowHeight = snd $ windowSize param
         ?windowTitle = windowTitle param
         ?windowMode = windowed param
         ?cursorVisible = cursorVisible param
-    openWindow $ defaultDisplayOptions {
+    True <- openWindow $ defaultDisplayOptions {
         displayOptions_width = fromIntegral ?windowWidth
         ,displayOptions_height = fromIntegral ?windowHeight
         ,displayOptions_displayMode = if ?windowMode then Window else Fullscreen
         ,displayOptions_windowIsResizable = False
         ,displayOptions_openGLProfile = pf
-        ,displayOptions_numDepthBits = 8
     }
     
     if ?cursorVisible then enableMouseCursor 
@@ -191,10 +173,11 @@     GL.blend      $= GL.Enabled
     GL.blendFunc  $= (GL.SrcAlpha, GL.OneMinusSrcAlpha)
     GL.shadeModel $= GL.Smooth
-    
-    let Color r g b a = clearColor param
-    GL.clearColor $= GL.Color4 (gf r) (gf g) (gf b) (gf a)
+    GL.texture GL.Texture2D $= GL.Enabled
+    GL.textureFunction $= GL.Combine
 
+    let Color r g b a = clearColor param in GL.clearColor $= GL.Color4 (gf r) (gf g) (gf b) (gf a)
+
     ref <- newIORef IM.empty
     ref' <- newIORef 0
     let ?refTextures = ref
@@ -206,56 +189,60 @@     terminate
     return r
 
+mapKey :: I.Key -> Either Key MouseButton
 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
+    I.KeyChar c -> Left $ CharKey c
+    I.KeySpace -> Left KeySpace
+    I.KeyF1 -> Left KeyF1
+    I.KeyF2 -> Left KeyF2
+    I.KeyF3 -> Left KeyF3
+    I.KeyF4 -> Left KeyF4
+    I.KeyF5 -> Left KeyF5
+    I.KeyF6 -> Left KeyF6
+    I.KeyF7 -> Left KeyF7
+    I.KeyF8 -> Left KeyF8
+    I.KeyF9 -> Left KeyF9
+    I.KeyF10 -> Left KeyF10
+    I.KeyF11 -> Left KeyF11
+    I.KeyF12 -> Left KeyF12
+    I.KeyEsc -> Left KeyEsc
+    I.KeyUp -> Left KeyUp
+    I.KeyDown -> Left KeyDown
+    I.KeyLeft -> Left KeyLeft
+    I.KeyRight -> Left KeyRight
+    I.KeyLeftShift -> Left KeyLeftShift
+    I.KeyRightShift -> Left KeyLeftShift
+    I.KeyLeftControl -> Left KeyLeftCtrl
+    I.KeyRightControl -> Left KeyRightCtrl
+    I.KeyTab -> Left KeyTab
+    I.KeyEnter -> Left KeyEnter
+    I.KeyBackspace -> Left KeyBackspace
+    I.KeyInsert -> Left KeyInsert
+    I.KeyDelete -> Left KeyDel
+    I.KeyPageUp -> Left KeyPageup
+    I.KeyPageDown -> Left KeyPagedown
+    I.KeyHome -> Left KeyHome
+    I.KeyEnd -> Left KeyEnd
+    I.KeyPad0 -> Left KeyPad0
+    I.KeyPad1 -> Left KeyPad1
+    I.KeyPad2 -> Left KeyPad2
+    I.KeyPad3 -> Left KeyPad3
+    I.KeyPad4 -> Left KeyPad4
+    I.KeyPad5 -> Left KeyPad5
+    I.KeyPad6 -> Left KeyPad6
+    I.KeyPad7 -> Left KeyPad7
+    I.KeyPad8 -> Left KeyPad8
+    I.KeyPad9 -> Left KeyPad9
+    I.KeyPadDivide -> Left KeyPadDivide
+    I.KeyPadMultiply -> Left KeyPadMultiply
+    I.KeyPadSubtract -> Left KeyPadSubtract
+    I.KeyPadAdd -> Left KeyPadAdd
+    I.KeyPadDecimal -> Left KeyPadDecimal
+    I.KeyPadEqual -> Left KeyPadEqual
+    I.KeyPadEnter -> Left KeyPadEnter
+    I.MouseLeft -> Right MouseButton0
+    I.MouseRight -> Right MouseButton1
+    I.MouseMiddle -> Right MouseButton2
 
 gf :: Float -> GL.GLfloat
 {-# INLINE gf #-}

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts, DeriveFunctor #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Graphics.FreeGame.Base
@@ -25,12 +25,15 @@ 
     -- * Pictures
     ,Vec2(..)
+    ,Color(..)
     ,Picture(..)
     ,transPicture
     ,drawPicture
     
     -- * Inputs
     ,askInput
+    ,getMousePosition
+    ,getMouseWheel
     ,getMouseState
 
     -- * Settings
@@ -64,19 +67,11 @@     | Bracket (Game a)
     | DrawPicture Picture a
     | AskInput Key (Bool -> a)
-    | GetMouseState (MouseState -> a)
+    | GetMousePosition (Vec2 -> a)
+    | GetMouseWheel (Int -> a)
     | GetGameParam (GameParam -> a)
     | QuitGame
-
-instance Functor GameAction where
-    fmap f (DrawPicture a cont) = DrawPicture a (f cont)
-    fmap f (AskInput a cont)    = AskInput a (f . cont)
-    fmap f (GetMouseState cont) = GetMouseState (f . cont)
-    fmap f (GetGameParam cont)  = GetGameParam (f . cont)
-    fmap f (EmbedIO m) = EmbedIO (fmap f m)
-    fmap f (Bracket m) = Bracket (fmap f m)
-    fmap f (Tick cont) = Tick (f cont)
-    fmap _ QuitGame = QuitGame
+    deriving Functor
 
 -- | Finalize the current frame and refresh the screen.
 tick :: MonadFree GameAction m => m ()
@@ -102,10 +97,12 @@ askInput :: MonadFree GameAction m => Key -> m Bool
 askInput key = wrap $ AskInput key return
 
--- | Get the mouse's state.
-getMouseState :: MonadFree GameAction m => m MouseState
-getMouseState = wrap $ GetMouseState return
+getMouseWheel :: MonadFree GameAction m => m Int
+getMouseWheel = wrap $ GetMouseWheel return
 
+getMousePosition :: MonadFree GameAction m => m Vec2
+getMousePosition = wrap $ GetMousePosition return
+
 -- | Get the game params that apply to the currently running game.
 getCurrentGameParam :: MonadFree GameAction m => m GameParam
 getCurrentGameParam = wrap $ GetGameParam return
@@ -121,7 +118,7 @@     = BitmapPicture Bitmap
     -- | A picture consist of some 'Picture's.
     | Pictures [Picture]
-    -- | A picture that may have side effects(rarely needed).
+    -- | A picture that may have side effects(for internal use).
     | IOPicture (IO Picture)
     -- | Rotated picture by the given angle (in degrees, counterclockwise).
     | Rotate Float Picture
@@ -145,6 +142,15 @@ -- | 640*480(windowed), 60fps
 defaultGameParam :: GameParam
 defaultGameParam = GameParam 60 (640,480) "free-game" True True white
+
+-- | Get the mouse's state.
+getMouseState :: MonadFree GameAction m => m MouseState
+getMouseState = MouseState
+    `liftM` getMousePosition
+    `ap` askInput MouseLeft
+    `ap` askInput MouseMiddle
+    `ap` askInput MouseRight
+    `ap` getMouseWheel
 
 {-# DEPRECATED loadPicture "No longer needed; use BitmapPicture instead" #-}
 -- | Create a 'Picture' from 'Bitmap'.

@@ -11,90 +11,114 @@ --
 -- Rendering characters
 ----------------------------------------------------------------------------
-module Graphics.FreeGame.Data.Font (Font, loadFont, text, withRenderString, withRenderCharacters ) where
+module Graphics.FreeGame.Data.Font 
+  ( Font
+  , loadFont
+  , Metrics(..)
+  , Graphics.FreeGame.Data.Font.metrics
+  , fontBoundingBox
+  , text
+  , renderCharacters
+  ) where
 
 import Control.Applicative
 import Data.Array.Repa as R
 import Data.Array.Repa.Eval
-import qualified Data.Array.Repa.Repr.ForeignPtr as RF
 import Data.Vect
 import Data.IORef
 import qualified Data.Map as M
 import Data.Word
 import Graphics.FreeGame.Base
+import Graphics.FreeGame.Types
 import Graphics.FreeGame.Data.Bitmap
 import Graphics.Rendering.FreeType.Internal
-import Graphics.Rendering.FreeType.Internal.GlyphSlot as GS
-import Graphics.Rendering.FreeType.Internal.Vector as V
+import qualified Graphics.Rendering.FreeType.Internal.GlyphSlot as GS
+import qualified Graphics.Rendering.FreeType.Internal.Vector as V
 import Graphics.Rendering.FreeType.Internal.Bitmap as B
 import Graphics.Rendering.FreeType.Internal.PrimitiveTypes as PT
 import Graphics.Rendering.FreeType.Internal.Face as F
 import Graphics.Rendering.FreeType.Internal.Library as L
-
+import Graphics.Rendering.FreeType.Internal.BBox as BB
 import Foreign.Marshal.Alloc
+import Foreign.C.Types
 import Foreign.C.String
 import Foreign.Storable
 import System.IO.Unsafe
 import Unsafe.Coerce
 
 -- | Font object
-data Font = Font FT_Face (IORef (M.Map (Float, Char) RenderedChar))
+data Font = Font FT_Face Metrics BoundingBox (IORef (M.Map (Float, Char) RenderedChar))
 
 -- | Create a 'Font' from the given file.
 loadFont :: FilePath -> IO Font
 loadFont path = alloca $ \p -> do
     e <- withCString path $ \str -> ft_New_Face freeType str 0 p
     failFreeType e
-    Font <$> peek p <*> newIORef M.empty
+    f <- peek p
+    b <- peek (bbox f)
+    asc <- peek (ascender f)
+    desc <- peek (descender f)
+    u <- fromIntegral <$> peek (units_per_EM f)
+    let m = Metrics (fromIntegral asc/u) (fromIntegral desc/u)
+        box = BoundingBox (Vec2 (fromIntegral (xMin b)/u) (fromIntegral (yMin b)/u))
+                          (Vec2 (fromIntegral (xMax b)/u) (fromIntegral (yMin b)/u))
+    Font f m box <$> newIORef M.empty
+-- | Get the font's metrics.
+metrics :: Font -> Metrics
+metrics (Font _ m _ _) = m
 
+fontBoundingBox :: Font -> BoundingBox
+fontBoundingBox (Font _ _ b _) = b
+
 -- | Render a text by the specified 'Font'.
 text :: Font -> Float -> String -> Picture
-text font size str = IOPicture $ Pictures <$> renderCharacters font size str
-
--- | Render the string by the given font, and pass it to the 'Game' action. 
-withRenderCharacters :: Font -> Float -> String -> ([Picture] -> Game a) -> Game a
-withRenderCharacters font size str action = bracket
-    $ embedIO (renderCharacters font size str) >>= action
-
--- | Render the string by the given font, and pass it to the 'Game' action. 
-withRenderString :: Font -> Float -> String -> (Picture -> Game a) -> Game a
-withRenderString font size str action = withRenderCharacters font size str (action . Pictures)
+text font siz str = IOPicture $ Pictures <$> renderCharacters font siz str
 
+failFreeType :: Monad m => CInt -> m ()
 failFreeType 0 = return ()
 failFreeType e = fail $ "FreeType Error:" Prelude.++ show e
 
 freeType :: FT_Library
 freeType = unsafePerformIO $ alloca $ \p -> do
-    e <- ft_Init_FreeType p
-    failFreeType e
+    failFreeType =<< ft_Init_FreeType p
     peek p
 
 data RenderedChar = RenderedChar
-    {
-        charBitmap :: Bitmap
-        ,charOffset :: Vec2
-        ,charAdvance :: Float
+    { charBitmap :: Bitmap
+    , charOffset :: Vec2
+    ,　charAdvance :: Float
     }
 
+data Metrics = Metrics
+    { metricsAscent :: Float
+    , metricsDescent :: Float
+    }
+
+-- | The resolution used to render fonts.
+resolutionDPI :: Int
+resolutionDPI = 300
+
 charToBitmap :: Font -> Float -> Char -> IO RenderedChar
-charToBitmap (Font face refCache) size ch = do
+charToBitmap (Font face _ _ refCache) pixel ch = do
     cache <- readIORef refCache
-    case M.lookup (size, ch) cache of
+    case M.lookup (siz, ch) cache of
         Nothing -> do
             d <- render
-            writeIORef refCache $ M.insert (size, ch) d cache
+            writeIORef refCache $ M.insert (siz, ch) d cache
             return d
         Just d -> return d
-
     where
+        siz = pixel * 72 / fromIntegral resolutionDPI
         render = do
-            ft_Set_Char_Size face 0 (floor $ size * 64) 300 300
+            let dpi = fromIntegral resolutionDPI
+
+            failFreeType =<< ft_Set_Char_Size face 0 (floor $ siz * 64) dpi dpi
+            
             ix <- ft_Get_Char_Index face (fromIntegral $ fromEnum ch)
-            ft_Load_Glyph face ix ft_LOAD_DEFAULT
+            failFreeType =<< ft_Load_Glyph face ix ft_LOAD_DEFAULT
 
             slot <- peek $ glyph face
-            e <- ft_Render_Glyph slot ft_RENDER_MODE_NORMAL
-            failFreeType e
+            failFreeType =<< ft_Render_Glyph slot ft_RENDER_MODE_NORMAL
 
             bmp <- peek $ GS.bitmap slot
             left <- fmap fromIntegral $ peek $ GS.bitmap_left slot
@@ -108,24 +132,22 @@             fillChunkedIOP (w * h) (unsafeWriteMVec mv) $ const $ return
                 $ fmap unsafeCoerce . peekElemOff (buffer bmp)
 
-            adv <- peek $ advance slot
+            adv <- peek $ GS.advance slot
 
             ar :: R.Array U DIM2 Word8 <- unsafeFreezeMVec (Z:.h:.w) mv
 
             let pixel (crd:.0) = R.index ar crd
-                pixel (crd:._) = 255
+                pixel (_:._) = 255
 
             result <- computeP (fromFunction (Z:.h:.w:.4) pixel) >>= makeStableBitmap
             
             return $ RenderedChar result (Vec2 left (-top)) (fromIntegral (V.x adv) / 64)
-
+ 
 renderCharacters :: Font -> Float -> String -> IO [Picture]
-renderCharacters font size str = render str 0
-    where
-        render [] _ = return []
-        render (c:cs) pen = do
-            RenderedChar b (Vec2 x y) adv <- charToBitmap font size c
-            let (w,h) = bitmapSize b
-                offset = Vec2 (pen + x + fromIntegral w / 2) (y + fromIntegral h / 2)
-            (Translate offset (BitmapPicture b):)
-                <$> render cs (pen + adv)
+renderCharacters font pixel str = render str 0 where
+    render [] _ = return []
+    render (c:cs) pen = do
+        RenderedChar b (Vec2 x y) adv <- charToBitmap font pixel c
+        let (w,h) = bitmapSize b
+            offset = Vec2 (pen + x + fromIntegral w / 2) (y + fromIntegral h / 2)
+        (Translate offset (BitmapPicture b):) <$> render cs (pen + adv)

@@ -73,4 +73,7 @@         | KeyPadDecimal
         | KeyPadEqual
         | KeyPadEnter
+        | MouseLeft
+        | MouseRight
+        | MouseMiddle
         deriving (Show, Eq, Ord)

@@ -0,0 +1,17 @@+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Graphics.FreeGame.Types
+-- Copyright   :  (C) 2013 Fumiaki Kinoshita
+-- License     :  BSD-style (see the file LICENSE)
+--
+-- Maintainer  :  Fumiaki Kinsohita <fumiexcel@gmail.com>
+-- Stability   :  provisional
+-- Portability :  non-portable
+--
+----------------------------------------------------------------------------
+module Graphics.FreeGame.Types (BoundingBox(..)) where
+import Data.Vect
+data BoundingBox = BoundingBox
+    { topLeft :: Vec2
+    , bottomRight :: Vec2
+    } deriving (Show)

@@ -13,7 +13,6 @@ 
 module Graphics.FreeGame.Util (untickGame, randomness, degrees, radians, loadPictureFromFile) where
 import Control.Monad.Free
-import qualified Control.Monad.Trans.Free as T
 import Graphics.FreeGame.Base
 import Graphics.FreeGame.Data.Bitmap
 import System.Random

@@ -5,11 +5,12 @@ 
 main = do
     font <- loadFont "VL-PGothic-Regular.ttf"
+    print $ fontBoundingBox font
     runSimple defaultGameParam 0 $ \n -> do
-        drawPicture $ Translate (Vec2 30 120) $ Colored (halfD red) $ text font 7 ("Counter: " ++ show n)
+        drawPicture $ Translate (Vec2 30 120) $ Colored (halfD red) $ text font 14 ("Counter: " ++ show n)
 
-        drawPicture $ Translate (Vec2 30 240) $ Colored (halfD blue) $ text font 9 "日本語も、美しくレンダリング。"
+        drawPicture $ Translate (Vec2 30 240) $ Colored (halfD blue) $ text font 20 "日本語も、美しくレンダリング。"
 
-        withRenderString font 12 "★☆★☆★☆★☆" $ drawPicture . Translate (Vec2 30 360) . Colored yellow
+        -- drawPicture $ Translate (Vec2 30 (240 +  * 20)) $ Colored (halfD green) $ text font 20 "___"
 
         return $! n + 1

@@ -59,4 +59,4 @@     bmp <- loadBitmapFromFile "logo.png"
     let ?pic = BitmapPicture bmp
 
-    runSimple defaultGameParam (replicate 10 initial) $ mapM untickGame
+    runSimple defaultGameParam (replicate 100 initial) $ mapM untickGame

@@ -1,7 +1,7 @@ name:                free-game
-version:             0.3.1.4
+version:             0.3.2.0
 synopsis:            Create graphical applications for free.
-description:         Cross-platform GUI library based on free monads.
+description:         Cross-platform GUI library based on free monads
 homepage:            https://github.com/fumieval/free-game
 bug-reports:         https://github.com/fumieval/free-game/issues
 license:             BSD3
@@ -30,13 +30,15 @@     , Graphics.FreeGame.Util
     , Graphics.FreeGame.Input
     , Graphics.FreeGame.Base
+    , Graphics.FreeGame.Types
     , Graphics.FreeGame.Backends.GLFW
     , Graphics.FreeGame.Data.Color
     , Graphics.FreeGame.Data.Bitmap
     , Graphics.FreeGame.Data.Font
-  ghc-options:         -fexcess-precision
+  ghc-options: -Wall -fexcess-precision -O2
   build-depends: base == 4.*
     , mtl >= 2.1
+    , transformers
     , containers >= 0.4
     , free == 3.*
     , random == 1.*