diff --git a/demo/example.hs b/demo/example.hs --- a/demo/example.hs +++ b/demo/example.hs @@ -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 diff --git a/graphics-drawingcombinators.cabal b/graphics-drawingcombinators.cabal --- a/graphics-drawingcombinators.cabal +++ b/graphics-drawingcombinators.cabal @@ -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 diff --git a/src/Graphics/DrawingCombinators/Bitmap.hs b/src/Graphics/DrawingCombinators/Bitmap.hs --- a/src/Graphics/DrawingCombinators/Bitmap.hs +++ b/src/Graphics/DrawingCombinators/Bitmap.hs @@ -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 - + --------------------------------------------------------------------------------