graphics-drawingcombinators 1.4.4.1 → 1.5
raw patch · 3 files changed
+37/−36 lines, 3 filesdep ~OpenGLdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: OpenGL, base
API changes (from Hackage documentation)
Files
- demo/example.hs +13/−11
- graphics-drawingcombinators.cabal +3/−4
- src/Graphics/DrawingCombinators/Bitmap.hs +21/−21
demo/example.hs view
@@ -2,8 +2,10 @@ import Data.IORef import Data.Monoid import Graphics.DrawingCombinators ((%%))-import qualified Graphics.DrawingCombinators as Draw-import qualified Graphics.UI.GLFW as GLFW+import qualified Graphics.DrawingCombinators as Draw+import qualified Graphics.UI.GLFW as GLFW+import Graphics.Rendering.OpenGL.GL.StateVar+import qualified Graphics.Rendering.OpenGL.GL.CoordTrans as GL(Size(..)) import System.Environment(getArgs) @@ -14,10 +16,10 @@ initScreen :: IO () initScreen = do True <- GLFW.initialize- True <- GLFW.openWindow GLFW.defaultDisplayOptions {- GLFW.displayOptions_width = resX,- GLFW.displayOptions_height = resY- }+ True <- GLFW.openWindow (GL.Size (fromIntegral resX) (fromIntegral resY))+ [GLFW.DisplayRGBBits 8 8 8,+ GLFW.DisplayDepthBits 8]+ GLFW.Window return () @@ -50,18 +52,18 @@ doneRef <- newIORef False- GLFW.setWindowCloseCallback $ do+ GLFW.windowCloseCallback $= do writeIORef doneRef True return True- waitClose doneRef $ quadrants (circleText font "Hello, World!")+ waitClose font doneRef 0 GLFW.terminate return () where - waitClose doneRef image = do+ waitClose font doneRef rotation = do isDone <- readIORef doneRef unless isDone $ do- Draw.clearRender image+ Draw.clearRender $ Draw.rotate rotation %% quadrants (circleText font "Hello, World!") GLFW.swapBuffers GLFW.pollEvents- waitClose doneRef $ Draw.rotate (-0.01) %% image+ waitClose font doneRef $ rotation - 0.01
graphics-drawingcombinators.cabal view
@@ -4,7 +4,7 @@ have to go into the deep, dark world of imperative stateful programming just to draw stuff. It supports 2D only (for now), with support drawing geometry, images, and text.-Version: 1.4.4.1+Version: 1.5 Stability: experimental Synopsis: A functional interface to 2D drawing in OpenGL License: BSD3@@ -24,7 +24,7 @@ Description: Does the system have FTGL, thus we could use not sucky fonts Library- Build-Depends: base == 4.*, OpenGL >= 2.2 && < 2.9, stb-image == 0.2.*, bitmap >= 0.0.2+ Build-Depends: base == 4.*, OpenGL >= 2.9 && < 2.10, stb-image == 0.2.*, bitmap >= 0.0.2 hs-Source-Dirs: src Exposed-Modules: Graphics.DrawingCombinators, Graphics.DrawingCombinators.Affine Other-Modules: Graphics.DrawingCombinators.Bitmap@@ -46,6 +46,5 @@ Buildable: False else Buildable: True- Build-depends: base >= 3 && < 5,- GLFW-b, OpenGL >= 2.2 && < 2.7, graphics-drawingcombinators+ Build-depends: base, GLFW-b, OpenGL, graphics-drawingcombinators ghc-options: -Wall
src/Graphics/DrawingCombinators/Bitmap.hs view
@@ -30,7 +30,7 @@ -------------------------------------------------------------------------------- -- | This function guesses the pixel format from the number of channels:--- +-- -- * 1 ~> Alpha -- -- * 2 ~> Luminance, Alpha@@ -42,47 +42,47 @@ -- For more control, use 'makeTextureFromBitmap'. makeSimpleBitmapTexture :: forall t. PixelComponent t => Bitmap t -> IO TextureObject makeSimpleBitmapTexture bm = do- let (pf,pif) = case pixelComponentType (undefined::t) of + let (pf,pif) = case pixelComponentType (undefined::t) of PctWord8 -> case bitmapNChannels bm of 1 -> (Alpha, Alpha8) 2 -> (LuminanceAlpha, Luminance8Alpha8) 3 -> (RGB, RGB8)- 4 -> (RGBA, RGBA8) + 4 -> (RGBA, RGBA8) n -> error $ "Invalid bitmap channel count: " ++ show n _ -> case bitmapNChannels bm of 1 -> (Alpha, Alpha') 2 -> (LuminanceAlpha, LuminanceAlpha') 3 -> (RGB, RGB')- 4 -> (RGBA, RGBA') + 4 -> (RGBA, RGBA') n -> error $ "Invalid bitmap channel count: " ++ show n- makeTextureFromBitmap bm Nothing 0 pf pif 0 - + makeTextureFromBitmap bm Texture2D 0 pf pif 0+ -- | Creates a new OpenGL texture from a bitmap-makeTextureFromBitmap - :: PixelComponent t - => Bitmap t -> Maybe CubeMapTarget -> Level -> PixelFormat -> PixelInternalFormat -> Border -> IO TextureObject-makeTextureFromBitmap bm cubemap level pf pif border = do+makeTextureFromBitmap+ :: (PixelComponent t, TwoDimensionalTextureTarget target)+ => Bitmap t -> target -> Level -> PixelFormat -> PixelInternalFormat -> Border -> IO TextureObject+makeTextureFromBitmap bm target level pf pif border = do old_binding <- get (textureBinding Texture2D)- [tex] <- genObjectNames 1 - textureBinding Texture2D $= Just tex + [tex] <- genObjectNames 1+ textureBinding Texture2D $= Just tex textureFilter Texture2D $= ((Linear',Nothing),Linear')- texImageFromBitmap bm cubemap level pf pif border + texImageFromBitmap bm target level pf pif border textureBinding Texture2D $= old_binding return tex texImageFromBitmap- :: forall t. PixelComponent t - => Bitmap t -> Maybe CubeMapTarget -> Level -> PixelFormat -> PixelInternalFormat -> Border -> IO ()-texImageFromBitmap bm cubemap level pf pif border = do+ :: forall target t. (PixelComponent t, TwoDimensionalTextureTarget target)+ => Bitmap t -> target -> Level -> PixelFormat -> PixelInternalFormat -> Border -> IO ()+texImageFromBitmap bm target level pf pif border = do withBitmap bm $ \(width,height) _nchn _pad ptr -> do -- old_rowlength <- get (rowLength Unpack) old_alignment <- get (rowAlignment Unpack)- let pdata = PixelData pf (dataType (undefined::t)) ptr - size = TextureSize2D (fromIntegral width) (fromIntegral height) + let pdata = PixelData pf (dataType (undefined::t)) ptr+ size = TextureSize2D (fromIntegral width) (fromIntegral height) -- rowLength Unpack $= fromIntegral (bitmapPaddedRowSizeInBytes bm) rowAlignment Unpack $= fromIntegral (bitmapRowAlignment bm)- texImage2D cubemap NoProxy level pif size border pdata--- rowLength Unpack $= old_rowlength + texImage2D target NoProxy level pif size border pdata+-- rowLength Unpack $= old_rowlength rowAlignment Unpack $= old_alignment- + --------------------------------------------------------------------------------