diff --git a/Graphics/Gloss/Internals/Data/Picture.hs b/Graphics/Gloss/Internals/Data/Picture.hs --- a/Graphics/Gloss/Internals/Data/Picture.hs +++ b/Graphics/Gloss/Internals/Data/Picture.hs @@ -3,10 +3,10 @@ -- | Data types for representing pictures. module Graphics.Gloss.Internals.Data.Picture - ( Point - , Vector - , Path - , Picture(..) + ( Point + , Vector + , Path + , Picture(..) -- * Bitmaps , BitmapData @@ -56,75 +56,75 @@ -- | A path through the x-y plane. -type Path = [Point] +type Path = [Point] -- | A 2D picture data Picture - -- Primitives ------------------------------------- + -- Primitives ------------------------------------- - -- | A blank picture, with nothing in it. - = Blank + -- | A blank picture, with nothing in it. + = Blank - -- | A convex polygon filled with a solid color. - | Polygon Path - - -- | A line along an arbitrary path. - | Line Path + -- | A convex polygon filled with a solid color. + | Polygon Path + + -- | A line along an arbitrary path. + | Line Path - -- | A circle with the given radius. - | Circle Float + -- | A circle with the given radius. + | Circle Float - -- | A circle with the given thickness and radius. - -- If the thickness is 0 then this is equivalent to `Circle`. - | ThickCircle Float Float + -- | A circle with the given thickness and radius. + -- If the thickness is 0 then this is equivalent to `Circle`. + | ThickCircle Float Float - -- | A circular arc drawn counter-clockwise between two angles + -- | A circular arc drawn counter-clockwise between two angles -- (in degrees) at the given radius. | Arc Float Float Float - -- | A circular arc drawn counter-clockwise between two angles + -- | A circular arc drawn counter-clockwise between two angles -- (in degrees), with the given radius and thickness. - -- If the thickness is 0 then this is equivalent to `Arc`. - | ThickArc Float Float Float Float + -- If the thickness is 0 then this is equivalent to `Arc`. + | ThickArc Float Float Float Float - -- | Some text to draw with a vector font. - | Text String + -- | Some text to draw with a vector font. + | Text String - -- | A bitmap image with a width, height and some 32-bit RGBA + -- | A bitmap image with a width, height and some 32-bit RGBA -- bitmap data. - -- - -- The boolean flag controls whether Gloss should cache the data + -- + -- The boolean flag controls whether Gloss should cache the data -- between frames for speed. If you are programatically generating -- the image for each frame then use `False`. If you have loaded it -- from a file then use `True`. - | Bitmap Int Int BitmapData Bool + | Bitmap Int Int BitmapData Bool - -- Color ------------------------------------------ - -- | A picture drawn with this color. - | Color Color Picture + -- Color ------------------------------------------ + -- | A picture drawn with this color. + | Color Color Picture - -- Transforms ------------------------------------- - -- | A picture translated by the given x and y coordinates. - | Translate Float Float Picture + -- Transforms ------------------------------------- + -- | A picture translated by the given x and y coordinates. + | Translate Float Float Picture - -- | A picture rotated clockwise by the given angle (in degrees). - | Rotate Float Picture + -- | A picture rotated clockwise by the given angle (in degrees). + | Rotate Float Picture - -- | A picture scaled by the given x and y factors. - | Scale Float Float Picture + -- | A picture scaled by the given x and y factors. + | Scale Float Float Picture - -- More Pictures ---------------------------------- - -- | A picture consisting of several others. - | Pictures [Picture] - deriving (Show, Eq, Data, Typeable) + -- More Pictures ---------------------------------- + -- | A picture consisting of several others. + | Pictures [Picture] + deriving (Show, Eq, Data, Typeable) -- Instances ------------------------------------------------------------------ instance Monoid Picture where - mempty = Blank - mappend a b = Pictures [a, b] - mconcat = Pictures + mempty = Blank + mappend a b = Pictures [a, b] + mconcat = Pictures -- Bitmaps -------------------------------------------------------------------- diff --git a/Graphics/Gloss/Internals/Rendering/Bitmap.hs b/Graphics/Gloss/Internals/Rendering/Bitmap.hs --- a/Graphics/Gloss/Internals/Rendering/Bitmap.hs +++ b/Graphics/Gloss/Internals/Rendering/Bitmap.hs @@ -2,11 +2,11 @@ -- | Helper functions for rendering bitmaps module Graphics.Gloss.Internals.Rendering.Bitmap - ( BitmapData(..) - , reverseRGBA - , bitmapPath - , freeBitmapData - ) + ( BitmapData(..) + , reverseRGBA + , bitmapPath + , freeBitmapData + ) where import Data.Data import Foreign @@ -28,8 +28,8 @@ bitmapPath :: Float -> Float -> [(Float, Float)] bitmapPath width height = [(-width', -height'), (width', -height'), (width', height'), (-width', height')] - where width' = width / 2 - height' = height / 2 + where width' = width / 2 + height' = height / 2 -- | Destructively reverse the byte order in an array. @@ -47,13 +47,13 @@ go :: Int -> Ptr Word32 -> Int -> IO () go len ptr count | count < len - = do curr <- peekElemOff ptr count - let byte0 = shift (isolateByte0 curr) 24 - let byte1 = shift (isolateByte1 curr) 8 - let byte2 = shift (isolateByte2 curr) (-8) - let byte3 = shift (isolateByte3 curr) (-24) - pokeElemOff ptr count (byte0 .|. byte1 .|. byte2 .|. byte3) - go len ptr (count + 1) + = do curr <- peekElemOff ptr count + let byte0 = shift (isolateByte0 curr) 24 + let byte1 = shift (isolateByte1 curr) 8 + let byte2 = shift (isolateByte2 curr) (-8) + let byte3 = shift (isolateByte3 curr) (-24) + pokeElemOff ptr count (byte0 .|. byte1 .|. byte2 .|. byte3) + go len ptr (count + 1) | otherwise = return () diff --git a/Graphics/Gloss/Internals/Rendering/Circle.hs b/Graphics/Gloss/Internals/Rendering/Circle.hs --- a/Graphics/Gloss/Internals/Rendering/Circle.hs +++ b/Graphics/Gloss/Internals/Rendering/Circle.hs @@ -5,8 +5,8 @@ ( renderCircle , renderArc) where -import Graphics.Gloss.Internals.Rendering.Common -import GHC.Exts +import Graphics.Gloss.Internals.Rendering.Common +import GHC.Exts import qualified Graphics.Rendering.OpenGL.GL as GL @@ -40,8 +40,8 @@ -- Render zero thickness circles with lines. | thickness == 0 - , radScreen <- scaleFactor * radius - , steps <- circleSteps radScreen + , radScreen <- scaleFactor * radius + , steps <- circleSteps radScreen = renderCircleLine posX posY steps radius -- Some thick circle. @@ -99,16 +99,16 @@ -- | Render an arc as a line. renderArcLine :: Float -> Float -> Int -> Float -> Float -> Float -> IO () renderArcLine (F# posX) (F# posY) steps (F# rad) a1 a2 - = let n = fromIntegral steps - !(F# tStep) = (2 * pi) / n + = let n = fromIntegral steps + !(F# tStep) = (2 * pi) / n !(F# tStart) = degToRad a1 - !(F# tStop) = degToRad a2 + if a1 >= a2 then 2 * pi else 0 + !(F# tStop) = degToRad a2 + if a1 >= a2 then 2 * pi else 0 -- force the line to end at the desired angle endVertex = addPointOnCircle posX posY rad tStop - in GL.renderPrimitive GL.LineStrip - $ do renderCircleLine_step posX posY tStep tStop rad tStart + in GL.renderPrimitive GL.LineStrip + $ do renderCircleLine_step posX posY tStep tStop rad tStart endVertex {-# INLINE renderArcLine #-} @@ -116,7 +116,7 @@ -- | Render an arc with a given thickness as a triangle strip renderArcStrip :: Float -> Float -> Int -> Float -> Float -> Float -> Float -> IO () renderArcStrip (F# posX) (F# posY) steps r a1 a2 width - = let n = fromIntegral steps + = let n = fromIntegral steps tStep = (2 * pi) / n t1 = normalizeAngle $ degToRad a1 @@ -125,17 +125,17 @@ tDiff = tStop - tStart tMid = tStart + tDiff / 2 - !(F# tStep') = tStep + !(F# tStep') = tStep !(F# tStep2') = tStep / 2 !(F# tStart') = tStart !(F# tStop') = tStop !(F# tCut') = tStop - tStep !(F# tMid') = tMid - !(F# r1') = r - width / 2 - !(F# r2') = r + width / 2 + !(F# r1') = r - width / 2 + !(F# r2') = r + width / 2 - in GL.renderPrimitive GL.TriangleStrip - $ do + in GL.renderPrimitive GL.TriangleStrip + $ do -- start vector addPointOnCircle posX posY r1' tStart' addPointOnCircle posX posY r2' tStart' @@ -180,20 +180,20 @@ renderCircleStrip_step - :: Float# -> Float# - -> Float# -> Float# - -> Float# -> Float# + :: Float# -> Float# + -> Float# -> Float# + -> Float# -> Float# -> Float# -> Float# -> IO () renderCircleStrip_step posX posY tStep tStop r1 t1 r2 t2 - | 1# <- t1 `geFloat#` tStop - = return () - - | otherwise - = do addPointOnCircle posX posY r1 t1 + | 1# <- t1 `geFloat#` tStop + = return () + + | otherwise + = do addPointOnCircle posX posY r1 t1 addPointOnCircle posX posY r2 t2 - renderCircleStrip_step posX posY tStep tStop r1 - (t1 `plusFloat#` tStep) r2 (t2 `plusFloat#` tStep) + renderCircleStrip_step posX posY tStep tStop r1 + (t1 `plusFloat#` tStep) r2 (t2 `plusFloat#` tStep) {-# INLINE renderCircleStrip_step #-} diff --git a/Graphics/Gloss/Internals/Rendering/Color.hs b/Graphics/Gloss/Internals/Rendering/Color.hs --- a/Graphics/Gloss/Internals/Rendering/Color.hs +++ b/Graphics/Gloss/Internals/Rendering/Color.hs @@ -3,17 +3,17 @@ module Graphics.Gloss.Internals.Rendering.Color where import Graphics.Gloss.Internals.Data.Color import Unsafe.Coerce -import qualified Graphics.Rendering.OpenGL.GL as GL +import qualified Graphics.Rendering.OpenGL.GL as GL -- | Convert one of our Colors to OpenGL's representation. glColor4OfColor :: Fractional a => Color -> GL.Color4 a glColor4OfColor color = case color of - RGBA r g b a - -> let rF = unsafeCoerce r - gF = unsafeCoerce g - bF = unsafeCoerce b - aF = unsafeCoerce a - in GL.Color4 rF gF bF aF + RGBA r g b a + -> let rF = unsafeCoerce r + gF = unsafeCoerce g + bF = unsafeCoerce b + aF = unsafeCoerce a + in GL.Color4 rF gF bF aF {-# INLINE glColor4OfColor #-} diff --git a/Graphics/Gloss/Internals/Rendering/Common.hs b/Graphics/Gloss/Internals/Rendering/Common.hs --- a/Graphics/Gloss/Internals/Rendering/Common.hs +++ b/Graphics/Gloss/Internals/Rendering/Common.hs @@ -13,11 +13,11 @@ -- | The OpenGL library doesn't seem to provide a nice way convert --- a Float to a GLfloat, even though they're the same thing --- under the covers. +-- a Float to a GLfloat, even though they're the same thing +-- under the covers. -- -- Using realToFrac is too slow, as it doesn't get fused in at --- least GHC 6.12.1 +-- least GHC 6.12.1 -- gf :: Float -> GL.GLfloat gf x = unsafeCoerce x @@ -33,27 +33,27 @@ -- | Set up the OpenGL rendering context for orthographic projection and run an -- action to draw the model. withModelview - :: (Int, Int) -- ^ Width and height of window. - -> IO () -- ^ Action to perform. - -> IO () + :: (Int, Int) -- ^ Width and height of window. + -> IO () -- ^ Action to perform. + -> IO () withModelview (sizeX, sizeY) action = do - GL.matrixMode $= GL.Projection - GL.preservingMatrix - $ do - -- setup the co-ordinate system - GL.loadIdentity - let (sx, sy) = (fromIntegral sizeX / 2, fromIntegral sizeY / 2) - GL.ortho (-sx) sx (-sy) sy 0 (-100) - - -- draw the world - GL.matrixMode $= GL.Modelview 0 - action + GL.matrixMode $= GL.Projection + GL.preservingMatrix + $ do + -- setup the co-ordinate system + GL.loadIdentity + let (sx, sy) = (fromIntegral sizeX / 2, fromIntegral sizeY / 2) + GL.ortho (-sx) sx (-sy) sy 0 (-100) + + -- draw the world + GL.matrixMode $= GL.Modelview 0 + action - GL.matrixMode $= GL.Projection - - GL.matrixMode $= GL.Modelview 0 + GL.matrixMode $= GL.Projection + + GL.matrixMode $= GL.Modelview 0 -- | Clear the OpenGL buffer with the given background color and run diff --git a/Graphics/Gloss/Internals/Rendering/Picture.hs b/Graphics/Gloss/Internals/Rendering/Picture.hs --- a/Graphics/Gloss/Internals/Rendering/Picture.hs +++ b/Graphics/Gloss/Internals/Rendering/Picture.hs @@ -1,7 +1,7 @@ {-# OPTIONS_HADDOCK hide #-} module Graphics.Gloss.Internals.Rendering.Picture - (renderPicture) + (renderPicture) where import Graphics.Gloss.Internals.Rendering.State import Graphics.Gloss.Internals.Rendering.Common @@ -14,10 +14,10 @@ import Data.IORef import Data.List import Control.Monad -import Graphics.Rendering.OpenGL (($=), get) -import qualified Graphics.Rendering.OpenGL.GL as GL +import Graphics.Rendering.OpenGL (($=), get) +import qualified Graphics.Rendering.OpenGL.GL as GL import qualified Graphics.Rendering.OpenGL.GLU.Errors as GLU -import qualified Graphics.UI.GLUT as GLUT +import qualified Graphics.UI.GLUT as GLUT -- | Render a picture into the current OpenGL context. @@ -25,56 +25,56 @@ -- Assumes that the OpenGL matrix mode is set to @Modelview@ -- renderPicture - :: State -- ^ Current rendering state. - -> Float -- ^ View port scale, which controls the level of detail. + :: State -- ^ Current rendering state. + -> Float -- ^ View port scale, which controls the level of detail. -- Use 1.0 to start with. - -> Picture -- ^ Picture to render. - -> IO () + -> Picture -- ^ Picture to render. + -> IO () renderPicture state circScale picture = do -- Setup render state for world - setLineSmooth (stateLineSmooth state) - setBlendAlpha (stateBlendAlpha state) - - -- Draw the picture + setLineSmooth (stateLineSmooth state) + setBlendAlpha (stateBlendAlpha state) + + -- Draw the picture checkErrors "before drawPicture." drawPicture state circScale picture checkErrors "after drawPicture." -drawPicture :: State -> Float -> Picture -> IO () +drawPicture :: State -> Float -> Picture -> IO () drawPicture state circScale picture = {-# SCC "drawComponent" #-} case picture of - -- nothin' - Blank - -> return () + -- nothin' + Blank + -> return () - -- line - Line path - -> GL.renderPrimitive GL.LineStrip - $ vertexPFs path + -- line + Line path + -> GL.renderPrimitive GL.LineStrip + $ vertexPFs path - -- polygon (where?) - Polygon path - | stateWireframe state - -> GL.renderPrimitive GL.LineLoop - $ vertexPFs path - - | otherwise - -> GL.renderPrimitive GL.Polygon - $ vertexPFs path + -- polygon (where?) + Polygon path + | stateWireframe state + -> GL.renderPrimitive GL.LineLoop + $ vertexPFs path + + | otherwise + -> GL.renderPrimitive GL.Polygon + $ vertexPFs path - -- circle - Circle radius - -> renderCircle 0 0 circScale radius 0 - - ThickCircle radius thickness - -> renderCircle 0 0 circScale radius thickness - + -- circle + Circle radius + -> renderCircle 0 0 circScale radius 0 + + ThickCircle radius thickness + -> renderCircle 0 0 circScale radius thickness + -- arc Arc a1 a2 radius -> renderArc 0 0 circScale radius a1 a2 0 @@ -82,54 +82,54 @@ ThickArc a1 a2 radius thickness -> renderArc 0 0 circScale radius a1 a2 thickness - -- stroke text - -- text looks weird when we've got blend on, - -- so disable it during the renderString call. - Text str - -> do - GL.blend $= GL.Disabled + -- stroke text + -- text looks weird when we've got blend on, + -- so disable it during the renderString call. + Text str + -> do + GL.blend $= GL.Disabled GL.preservingMatrix $ GLUT.renderString GLUT.Roman str - GL.blend $= GL.Enabled + GL.blend $= GL.Enabled - -- colors with float components. - Color col p - | stateColor state - -> do oldColor <- get GL.currentColor + -- colors with float components. + Color col p + | stateColor state + -> do oldColor <- get GL.currentColor - let RGBA r g b a = col + let RGBA r g b a = col - GL.currentColor $= GL.Color4 (gf r) (gf g) (gf b) (gf a) - drawPicture state circScale p - GL.currentColor $= oldColor + GL.currentColor $= GL.Color4 (gf r) (gf g) (gf b) (gf a) + drawPicture state circScale p + GL.currentColor $= oldColor - | otherwise - -> drawPicture state circScale p + | otherwise + -> drawPicture state circScale p -- Translation -------------------------- -- Easy translations are done directly to avoid calling GL.perserveMatrix. - Translate posX posY (Circle radius) - -> renderCircle posX posY circScale radius 0 + Translate posX posY (Circle radius) + -> renderCircle posX posY circScale radius 0 - Translate posX posY (ThickCircle radius thickness) - -> renderCircle posX posY circScale radius thickness + Translate posX posY (ThickCircle radius thickness) + -> renderCircle posX posY circScale radius thickness - Translate posX posY (Arc a1 a2 radius) - -> renderArc posX posY circScale radius a1 a2 0 + Translate posX posY (Arc a1 a2 radius) + -> renderArc posX posY circScale radius a1 a2 0 - Translate posX posY (ThickArc a1 a2 radius thickness) - -> renderArc posX posY circScale radius a1 a2 thickness + Translate posX posY (ThickArc a1 a2 radius thickness) + -> renderArc posX posY circScale radius a1 a2 thickness - Translate tx ty (Rotate deg p) - -> GL.preservingMatrix - $ do GL.translate (GL.Vector3 (gf tx) (gf ty) 0) - GL.rotate (gf deg) (GL.Vector3 0 0 (-1)) - drawPicture state circScale p + Translate tx ty (Rotate deg p) + -> GL.preservingMatrix + $ do GL.translate (GL.Vector3 (gf tx) (gf ty) 0) + GL.rotate (gf deg) (GL.Vector3 0 0 (-1)) + drawPicture state circScale p - Translate tx ty p - -> GL.preservingMatrix - $ do GL.translate (GL.Vector3 (gf tx) (gf ty) 0) - drawPicture state circScale p + Translate tx ty p + -> GL.preservingMatrix + $ do GL.translate (GL.Vector3 (gf tx) (gf ty) 0) + drawPicture state circScale p -- Rotation ----------------------------- @@ -147,61 +147,65 @@ -> renderArc 0 0 circScale radius (a1-deg) (a2-deg) thickness - Rotate deg p - -> GL.preservingMatrix - $ do GL.rotate (gf deg) (GL.Vector3 0 0 (-1)) - drawPicture state circScale p + Rotate deg p + -> GL.preservingMatrix + $ do GL.rotate (gf deg) (GL.Vector3 0 0 (-1)) + drawPicture state circScale p -- Scale -------------------------------- - Scale sx sy p - -> GL.preservingMatrix - $ do GL.scale (gf sx) (gf sy) 1 - let mscale = max sx sy - drawPicture state (circScale * mscale) p - - -- Bitmap ------------------------------- - Bitmap width height imgData cacheMe - -> do + Scale sx sy p + -> GL.preservingMatrix + $ do GL.scale (gf sx) (gf sy) 1 + let mscale = max sx sy + drawPicture state (circScale * mscale) p + + -- Bitmap ------------------------------- + Bitmap width height imgData cacheMe + -> do -- Load the image data into a texture, -- or grab it from the cache if we've already done that before. - tex <- loadTexture (stateTextures state) width height imgData cacheMe - - -- Set up wrap and filtering mode - GL.textureWrapMode GL.Texture2D GL.S $= (GL.Repeated, GL.Repeat) - GL.textureWrapMode GL.Texture2D GL.T $= (GL.Repeated, GL.Repeat) - GL.textureFilter GL.Texture2D $= ((GL.Nearest, Nothing), GL.Nearest) - - -- Enable texturing - GL.texture GL.Texture2D $= GL.Enabled - GL.textureFunction $= GL.Combine - - -- Set current texture - GL.textureBinding GL.Texture2D $= Just (texObject tex) - - -- Set to opaque - GL.currentColor $= GL.Color4 1.0 1.0 1.0 1.0 - - -- Draw textured polygon - GL.renderPrimitive GL.Polygon - $ zipWithM_ - (\(pX, pY) (tX, tY) - -> do GL.texCoord $ GL.TexCoord2 (gf tX) (gf tY) - GL.vertex $ GL.Vertex2 (gf pX) (gf pY)) + tex <- loadTexture (stateTextures state) width height imgData cacheMe + + -- Set up wrap and filtering mode + GL.textureWrapMode GL.Texture2D GL.S $= (GL.Repeated, GL.Repeat) + GL.textureWrapMode GL.Texture2D GL.T $= (GL.Repeated, GL.Repeat) + GL.textureFilter GL.Texture2D $= ((GL.Nearest, Nothing), GL.Nearest) + + -- Enable texturing + GL.texture GL.Texture2D $= GL.Enabled + GL.textureFunction $= GL.Combine + + -- Set current texture + GL.textureBinding GL.Texture2D $= Just (texObject tex) + + -- Set to opaque + oldColor <- get GL.currentColor + GL.currentColor $= GL.Color4 1.0 1.0 1.0 1.0 + + -- Draw textured polygon + GL.renderPrimitive GL.Polygon + $ zipWithM_ + (\(pX, pY) (tX, tY) + -> do GL.texCoord $ GL.TexCoord2 (gf tX) (gf tY) + GL.vertex $ GL.Vertex2 (gf pX) (gf pY)) - (bitmapPath (fromIntegral width) (fromIntegral height)) - [(0,0), (1.0,0), (1.0,1.0), (0,1.0)] + (bitmapPath (fromIntegral width) (fromIntegral height)) + [(0,0), (1.0,0), (1.0,1.0), (0,1.0)] - -- Disable texturing - GL.texture GL.Texture2D $= GL.Disabled + -- Restore color + GL.currentColor $= oldColor + -- Disable texturing + GL.texture GL.Texture2D $= GL.Disabled + -- Free uncachable texture objects. freeTexture tex - Pictures ps - -> mapM_ (drawPicture state circScale) ps - + Pictures ps + -> mapM_ (drawPicture state circScale) ps + -- Errors --------------------------------------------------------------------- checkErrors :: String -> IO () checkErrors place @@ -282,25 +286,25 @@ installTexture width height bitmapData@(BitmapData _ fptr) cacheMe = do - -- Allocate texture handle for texture - [tex] <- GL.genObjectNames 1 - GL.textureBinding GL.Texture2D $= Just tex + -- Allocate texture handle for texture + [tex] <- GL.genObjectNames 1 + GL.textureBinding GL.Texture2D $= Just tex - -- Sets the texture in imgData as the current texture - -- This copies the data from the pointer into OpenGL texture memory, - -- so it's ok if the foreignptr gets garbage collected after this. + -- Sets the texture in imgData as the current texture + -- This copies the data from the pointer into OpenGL texture memory, + -- so it's ok if the foreignptr gets garbage collected after this. withForeignPtr fptr $ \ptr -> - GL.texImage2D - GL.Texture2D - GL.NoProxy - 0 - GL.RGBA8 - (GL.TextureSize2D - (gsizei width) - (gsizei height)) - 0 - (GL.PixelData GL.RGBA GL.UnsignedInt8888 ptr) + GL.texImage2D + GL.Texture2D + GL.NoProxy + 0 + GL.RGBA8 + (GL.TextureSize2D + (gsizei width) + (gsizei height)) + 0 + (GL.PixelData GL.RGBA GL.UnsignedInt8888 ptr) -- Make a stable name that we can use to identify this data again. -- If the user gives us the same texture data at the same size then we @@ -329,27 +333,27 @@ -- | Turn alpha blending on or off setBlendAlpha :: Bool -> IO () setBlendAlpha state - | state - = do GL.blend $= GL.Enabled - GL.blendFunc $= (GL.SrcAlpha, GL.OneMinusSrcAlpha) + | state + = do GL.blend $= GL.Enabled + GL.blendFunc $= (GL.SrcAlpha, GL.OneMinusSrcAlpha) - | otherwise - = do GL.blend $= GL.Disabled - GL.blendFunc $= (GL.One, GL.Zero) + | otherwise + = do GL.blend $= GL.Disabled + GL.blendFunc $= (GL.One, GL.Zero) -- | Turn line smoothing on or off setLineSmooth :: Bool -> IO () setLineSmooth state - | state = GL.lineSmooth $= GL.Enabled - | otherwise = GL.lineSmooth $= GL.Disabled + | state = GL.lineSmooth $= GL.Enabled + | otherwise = GL.lineSmooth $= GL.Disabled -vertexPFs :: [(Float, Float)] -> IO () +vertexPFs :: [(Float, Float)] -> IO () {-# INLINE vertexPFs #-} -vertexPFs [] = return () +vertexPFs [] = return () vertexPFs ((x, y) : rest) - = do GL.vertex $ GL.Vertex2 (gf x) (gf y) - vertexPFs rest + = do GL.vertex $ GL.Vertex2 (gf x) (gf y) + vertexPFs rest diff --git a/Graphics/Gloss/Internals/Rendering/State.hs b/Graphics/Gloss/Internals/Rendering/State.hs --- a/Graphics/Gloss/Internals/Rendering/State.hs +++ b/Graphics/Gloss/Internals/Rendering/State.hs @@ -2,9 +2,9 @@ -- | Rendering options module Graphics.Gloss.Internals.Rendering.State - ( State (..) - , initState - , Texture (..)) + ( State (..) + , initState + , Texture (..)) where import Graphics.Gloss.Internals.Data.Picture import Foreign.ForeignPtr @@ -16,23 +16,23 @@ -- | Render options settings data State - = State - { -- | Whether to use color - stateColor :: !Bool + = State + { -- | Whether to use color + stateColor :: !Bool - -- | Whether to force wireframe mode only - , stateWireframe :: !Bool + -- | Whether to force wireframe mode only + , stateWireframe :: !Bool - -- | Whether to use alpha blending - , stateBlendAlpha :: !Bool + -- | Whether to use alpha blending + , stateBlendAlpha :: !Bool - -- | Whether to use line smoothing - , stateLineSmooth :: !Bool - - -- | Cache of Textures that we've sent to OpenGL. - , stateTextures :: !(IORef [Texture]) - } - + -- | Whether to use line smoothing + , stateLineSmooth :: !Bool + + -- | Cache of Textures that we've sent to OpenGL. + , stateTextures :: !(IORef [Texture]) + } + -- | A texture that we've sent to OpenGL. data Texture @@ -62,11 +62,11 @@ initState :: IO State initState = do textures <- newIORef [] - return State - { stateColor = True - , stateWireframe = False - , stateBlendAlpha = True - , stateLineSmooth = False - , stateTextures = textures } - + return State + { stateColor = True + , stateWireframe = False + , stateBlendAlpha = True + , stateLineSmooth = False + , stateTextures = textures } + diff --git a/Graphics/Gloss/Rendering.hs b/Graphics/Gloss/Rendering.hs --- a/Graphics/Gloss/Rendering.hs +++ b/Graphics/Gloss/Rendering.hs @@ -25,7 +25,8 @@ , renderPicture , withModelview , withClearBuffer - , RS.initState) + , RS.initState + , RS.State) where import Graphics.Gloss.Internals.Rendering.Common diff --git a/gloss-rendering.cabal b/gloss-rendering.cabal --- a/gloss-rendering.cabal +++ b/gloss-rendering.cabal @@ -1,5 +1,5 @@ name: gloss-rendering -version: 1.9.2.1 +version: 1.9.3.1 license: MIT license-file: LICENSE author: Elise Huard @@ -28,15 +28,15 @@ Graphics.Gloss.Internals.Rendering.State build-depends: - base == 4.7.*, + base == 4.8.*, containers == 0.5.*, bytestring == 0.10.*, - OpenGL == 2.9.*, - GLUT == 2.5.*, + OpenGL == 2.12.*, + GLUT == 2.7.*, bmp == 1.2.* ghc-options: - -Wall + -Wall -O2 default-language: Haskell2010