diff --git a/Graphics/FreeGame/Backends/GLFW.hs b/Graphics/FreeGame/Backends/GLFW.hs --- a/Graphics/FreeGame/Backends/GLFW.hs +++ b/Graphics/FreeGame/Backends/GLFW.hs @@ -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 #-} diff --git a/Graphics/FreeGame/Base.hs b/Graphics/FreeGame/Base.hs --- a/Graphics/FreeGame/Base.hs +++ b/Graphics/FreeGame/Base.hs @@ -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'. diff --git a/Graphics/FreeGame/Data/Font.hs b/Graphics/FreeGame/Data/Font.hs --- a/Graphics/FreeGame/Data/Font.hs +++ b/Graphics/FreeGame/Data/Font.hs @@ -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) diff --git a/Graphics/FreeGame/Input.hs b/Graphics/FreeGame/Input.hs --- a/Graphics/FreeGame/Input.hs +++ b/Graphics/FreeGame/Input.hs @@ -73,4 +73,7 @@ | KeyPadDecimal | KeyPadEqual | KeyPadEnter + | MouseLeft + | MouseRight + | MouseMiddle deriving (Show, Eq, Ord) diff --git a/Graphics/FreeGame/Types.hs b/Graphics/FreeGame/Types.hs new file mode 100644 --- /dev/null +++ b/Graphics/FreeGame/Types.hs @@ -0,0 +1,17 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Graphics.FreeGame.Types +-- Copyright : (C) 2013 Fumiaki Kinoshita +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Fumiaki Kinsohita +-- Stability : provisional +-- Portability : non-portable +-- +---------------------------------------------------------------------------- +module Graphics.FreeGame.Types (BoundingBox(..)) where +import Data.Vect +data BoundingBox = BoundingBox + { topLeft :: Vec2 + , bottomRight :: Vec2 + } deriving (Show) diff --git a/Graphics/FreeGame/Util.hs b/Graphics/FreeGame/Util.hs --- a/Graphics/FreeGame/Util.hs +++ b/Graphics/FreeGame/Util.hs @@ -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 diff --git a/examples/font.hs b/examples/font.hs --- a/examples/font.hs +++ b/examples/font.hs @@ -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 diff --git a/examples/test.hs b/examples/test.hs --- a/examples/test.hs +++ b/examples/test.hs @@ -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 diff --git a/free-game.cabal b/free-game.cabal --- a/free-game.cabal +++ b/free-game.cabal @@ -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.*