gloss-rendering 1.11.1.1 → 1.12.0.0
raw patch · 8 files changed
+124/−118 lines, 8 filesdep ~basenew-uploaderPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- Graphics/Gloss/Internals/Data/Color.hs +10/−9
- Graphics/Gloss/Internals/Data/Picture.hs +22/−26
- Graphics/Gloss/Internals/Rendering/Bitmap.hs +4/−3
- Graphics/Gloss/Internals/Rendering/Circle.hs +16/−14
- Graphics/Gloss/Internals/Rendering/Common.hs +7/−7
- Graphics/Gloss/Internals/Rendering/Picture.hs +39/−38
- Graphics/Gloss/Rendering.hs +4/−3
- gloss-rendering.cabal +22/−18
Graphics/Gloss/Internals/Data/Color.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveDataTypeable #-} {-# OPTIONS_HADDOCK hide #-} -- | Data type for representing colors.@@ -42,7 +43,7 @@ signum (RGBA r1 g1 b1 _) = RGBA (signum r1) (signum g1) (signum b1) 1 {-# INLINE signum #-}- + fromInteger i = let f = fromInteger i in RGBA f f f 1@@ -50,7 +51,7 @@ -- | Make a custom color. All components are clamped to the range [0..1].-makeColor +makeColor :: Float -- ^ Red component. -> Float -- ^ Green component. -> Float -- ^ Blue component.@@ -58,7 +59,7 @@ -> Color makeColor r g b a- = clampColor + = clampColor $ RGBA r g b a {-# INLINE makeColor #-} @@ -66,20 +67,20 @@ -- | Make a custom color. All components are clamped to the range [0..255]. makeColorI :: Int -> Int -> Int -> Int -> Color makeColorI r g b a- = clampColor - $ RGBA (fromIntegral r / 255) + = clampColor+ $ RGBA (fromIntegral r / 255) (fromIntegral g / 255) (fromIntegral b / 255) (fromIntegral a / 255) {-# INLINE makeColorI #-} --- | Make a custom color. +-- | Make a custom color. -- -- Using this function over `makeColor` avoids clamping the components, -- which saves time. However, if the components are out of range then -- this will result in integer overflow at rendering time, and the actual--- picture you get will be implementation dependent. +-- picture you get will be implementation dependent. -- -- You'll only need to use this function when using the @gloss-raster@ -- package that builds a new color for every pixel. If you're just working@@ -94,7 +95,7 @@ -- | Make a custom color, taking pre-clamped components. makeRawColorI :: Int -> Int -> Int -> Int -> Color makeRawColorI r g b a- = RGBA (fromIntegral r / 255) + = RGBA (fromIntegral r / 255) (fromIntegral g / 255) (fromIntegral b / 255) (fromIntegral a / 255)@@ -105,7 +106,7 @@ rgbaOfColor :: Color -> (Float, Float, Float, Float) rgbaOfColor (RGBA r g b a) = (r, g, b, a) {-# INLINE rgbaOfColor #-}- + -- | Clamp components of a raw color into the required range. clampColor :: Color -> Color
Graphics/Gloss/Internals/Data/Picture.hs view
@@ -1,5 +1,6 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-} {-# OPTIONS_HADDOCK hide #-}-{-# OPTIONS -fno-warn-orphans #-} -- | Data types for representing pictures. module Graphics.Gloss.Internals.Data.Picture@@ -30,25 +31,13 @@ import qualified Data.ByteString.Unsafe as BSU import Prelude hiding (map) +#if __GLASGOW_HASKELL__ >= 800+import Data.Semigroup+import Data.List.NonEmpty+#endif -- | A point on the x-y plane.-type Point = (Float, Float) ----- | Pretend a point is a number.--- Vectors aren't real numbers according to Haskell, because they don't--- support the multiply and divide field operators. We can pretend they--- are though, and use the (+) and (-) operators as component-wise--- addition and subtraction.----instance Num Point where- (+) (x1, y1) (x2, y2) = (x1 + x2, y1 + y2)- (-) (x1, y1) (x2, y2) = (x1 - x2, y1 - y2)- (*) (x1, y1) (x2, y2) = (x1 * x2, y1 * y2)- signum (x, y) = (signum x, signum y)- abs (x, y) = (abs x, abs y)- negate (x, y) = (negate x, negate y) - fromInteger x = (fromInteger x, fromInteger x)+type Point = (Float, Float) -- | A vector can be treated as a point, and vis-versa.@@ -56,7 +45,7 @@ -- | A path through the x-y plane.-type Path = [Point] +type Path = [Point] -- | A 2D picture@@ -68,7 +57,7 @@ -- | A convex polygon filled with a solid color. | Polygon Path- + -- | A line along an arbitrary path. | Line Path @@ -79,11 +68,11 @@ -- 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@@ -97,7 +86,7 @@ -- The boolean flag controls whether Gloss should cache the data -- in GPU memory between frames. If you are programatically generating -- the image for each frame then use @False@. If you have loaded it- -- from a file then use @True@. + -- from a file then use @True@. -- Setting @False@ for static images will make rendering slower -- than it needs to be. -- Setting @True@ for dynamically generated images will cause a@@ -126,9 +115,16 @@ -- 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++#if __GLASGOW_HASKELL__ >= 800+instance Semigroup Picture where+ a <> b = Pictures [a, b]+ sconcat = Pictures . toList+ stimes = stimesIdempotent+#endif -- Bitmaps --------------------------------------------------------------------
Graphics/Gloss/Internals/Rendering/Bitmap.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveDataTypeable #-} {-# OPTIONS_HADDOCK hide #-} -- | Helper functions for rendering bitmaps@@ -16,7 +17,7 @@ = BitmapData { bitmapDataLength :: Int -- length (in bytes) , bitmapFormat :: BitmapFormat- , bitmapPointer :: (ForeignPtr Word8) } + , bitmapPointer :: (ForeignPtr Word8) } deriving (Eq, Data, Typeable) @@ -25,7 +26,7 @@ -- * Prior version of Gloss assumed `BitmapFormat BottomToTop PxAGBR` -- data BitmapFormat- = BitmapFormat + = BitmapFormat { rowOrder :: RowOrder , pixelFormat :: PixelFormat } deriving (Eq, Data, Typeable, Show, Ord)@@ -37,7 +38,7 @@ -- * `BottomToTop` - the bottom row followed by the next-higher row and so on. -- data RowOrder- = TopToBottom + = TopToBottom | BottomToTop deriving (Eq, Data, Typeable, Show, Ord, Enum, Bounded)
Graphics/Gloss/Internals/Rendering/Circle.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-} {-# OPTIONS_HADDOCK hide #-} -- | Fast(ish) rendering of circles.@@ -11,7 +13,7 @@ -- | Decide how many line segments to use to render the circle.--- The number of segments we should use to get a nice picture depends on +-- The number of segments we should use to get a nice picture depends on -- the size of the circle on the screen, not its intrinsic radius. -- If the viewport has been zoomed-in then we need to use more segments. --@@ -72,7 +74,7 @@ !(F# r2) = r + width / 2 in GL.renderPrimitive GL.TriangleStrip- $ renderCircleStrip_step posX posY tStep tStop r1 0.0# r2 + $ renderCircleStrip_step posX posY tStep tStop r1 0.0# r2 (tStep `divideFloat#` 2.0#) {-# INLINE renderCircleStrip #-} @@ -94,8 +96,8 @@ | radScreen <- scaleFactor * (radius + thickness / 2) , steps <- circleSteps radScreen = renderArcStrip posX posY steps radius a1 a2 thickness- + -- | Render an arc as a line. renderArcLine :: Float -> Float -> Int -> Float -> Float -> Float -> IO () renderArcLine (F# posX) (F# posY) steps (F# rad) a1 a2@@ -133,9 +135,9 @@ !(F# tMid') = tMid !(F# r1') = r - width / 2 !(F# r2') = r + width / 2- + in GL.renderPrimitive GL.TriangleStrip- $ do + $ do -- start vector addPointOnCircle posX posY r1' tStart' addPointOnCircle posX posY r2' tStart'@@ -165,34 +167,34 @@ renderCircleLine_step :: Float# -> Float# -> Float# -> Float#- -> Float# -> Float# + -> Float# -> Float# -> IO () renderCircleLine_step posX posY tStep tStop rad tt | 1# <- tt `geFloat#` tStop = return ()- + | otherwise = do addPointOnCircle posX posY rad tt- renderCircleLine_step posX posY tStep tStop rad + renderCircleLine_step posX posY tStep tStop rad (tt `plusFloat#` tStep) {-# INLINE renderCircleLine_step #-} -renderCircleStrip_step - :: Float# -> Float# - -> Float# -> Float# +renderCircleStrip_step+ :: 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 addPointOnCircle posX posY r2 t2- renderCircleStrip_step posX posY tStep tStop r1 + renderCircleStrip_step posX posY tStep tStop r1 (t1 `plusFloat#` tStep) r2 (t2 `plusFloat#` tStep) {-# INLINE renderCircleStrip_step #-} @@ -227,7 +229,7 @@ {- Unused sector drawing code. Sectors are currently drawn as compound Pictures,- but we might want this if we end up implementing the ThickSector + but we might want this if we end up implementing the ThickSector version as well. -- | Render a sector as a line.
Graphics/Gloss/Internals/Rendering/Common.hs view
@@ -1,6 +1,6 @@ {-# OPTIONS_HADDOCK hide #-} -module Graphics.Gloss.Internals.Rendering.Common +module Graphics.Gloss.Internals.Rendering.Common ( gf, gsizei , withModelview , withClearBuffer)@@ -14,7 +14,7 @@ -- | 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. +-- under the covers. -- -- Using realToFrac is too slow, as it doesn't get fused in at -- least GHC 6.12.1@@ -46,25 +46,25 @@ 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 --- | Clear the OpenGL buffer with the given background color and run +-- | Clear the OpenGL buffer with the given background color and run -- an action to draw the model.-withClearBuffer +withClearBuffer :: Color -- ^ Background color -> IO () -- ^ Action to perform -> IO () withClearBuffer clearColor action- = do + = do -- initialization (done every time in this case) -- we don't need the depth buffer for 2d. GL.depthFunc GL.$= Just GL.Always
Graphics/Gloss/Internals/Rendering/Picture.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveDataTypeable #-} {-# OPTIONS_HADDOCK hide #-} module Graphics.Gloss.Internals.Rendering.Picture@@ -32,18 +33,18 @@ -> IO () renderPicture state circScale picture- = do + = do -- Setup render state for world 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@@ -53,8 +54,8 @@ -> return () -- line- Line path - -> GL.renderPrimitive GL.LineStrip + Line path+ -> GL.renderPrimitive GL.LineStrip $ vertexPFs path @@ -63,7 +64,7 @@ | stateWireframe state -> GL.renderPrimitive GL.LineLoop $ vertexPFs path- + | otherwise -> GL.renderPrimitive GL.Polygon $ vertexPFs path@@ -71,21 +72,21 @@ -- 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- + 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 + Text str -> do GL.blend $= GL.Disabled GL.preservingMatrix $ GLUT.renderString GLUT.Roman str@@ -100,7 +101,7 @@ GL.currentColor $= GL.Color4 (gf r) (gf g) (gf b) (gf a) drawPicture state circScale p- GL.currentColor $= oldColor + GL.currentColor $= oldColor | otherwise -> drawPicture state circScale p@@ -119,7 +120,7 @@ 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)@@ -146,7 +147,7 @@ Rotate deg (ThickArc a1 a2 radius thickness) -> 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))@@ -159,10 +160,10 @@ $ 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 + -> do let rowInfo = case rowOrder (bitmapFormat imgData) of BottomToTop -> [(0,0), (1,0), (1,1), (0,1)]@@ -171,23 +172,23 @@ -- 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 oldColor <- get GL.currentColor GL.currentColor $= GL.Color4 1.0 1.0 1.0 1.0- + -- Draw textured polygon GL.renderPrimitive GL.Polygon $ zipWithM_@@ -206,11 +207,11 @@ -- Free uncachable texture objects. freeTexture tex- + Pictures ps -> mapM_ (drawPicture state circScale) ps- + -- Errors --------------------------------------------------------------------- checkErrors :: String -> IO () checkErrors place@@ -222,7 +223,7 @@ handleError place err = case err of GLU.Error GLU.StackOverflow _- -> error $ unlines + -> error $ unlines [ "Gloss / OpenGL Stack Overflow " ++ show place , " This program uses the Gloss vector graphics library, which tried to" , " draw a picture using more nested transforms (Translate/Rotate/Scale)"@@ -238,13 +239,13 @@ , " transforms used when defining the Picture given to Gloss. Sorry." ] -- Issue #32: Spurious "Invalid Operation" errors under Windows 7 64-bit.- -- When using GLUT under Windows 7 it complains about InvalidOperation, - -- but doesn't provide any other details. All the examples look ok, so + -- When using GLUT under Windows 7 it complains about InvalidOperation,+ -- but doesn't provide any other details. All the examples look ok, so -- we're just ignoring the error for now. GLU.Error GLU.InvalidOperation _ -> return ()- _ - -> error $ unlines + _+ -> error $ unlines [ "Gloss / OpenGL Internal Error " ++ show place , " Please report this on haskell-gloss@googlegroups.com." , show err ]@@ -265,16 +266,16 @@ -- Try and find this same texture in the cache. name <- makeStableName imgData- let mTexCached + let mTexCached = find (\tex -> texName tex == name && texWidth tex == width && texHeight tex == height) textures- + case mTexCached of Just tex -> return tex- + Nothing -> do tex <- installTexture width height imgData cacheMe when cacheMe@@ -283,15 +284,15 @@ -- | Install a texture into OpenGL.-installTexture +installTexture :: Int -> Int -> BitmapData -> Bool -> IO Texture installTexture width height bitmapData@(BitmapData _ fmt fptr) cacheMe- = do - let glFormat + = do+ let glFormat = case pixelFormat fmt of PxABGR -> GL.ABGR PxRGBA -> GL.RGBA@@ -301,7 +302,7 @@ 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, + -- 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 ->@@ -330,7 +331,7 @@ , texCacheMe = cacheMe } --- | If this texture does not have its `cacheMe` flag set then delete it from +-- | If this texture does not have its `cacheMe` flag set then delete it from -- OpenGL and free the GPU memory. freeTexture :: Texture -> IO () freeTexture tex@@ -343,13 +344,13 @@ -- | Turn alpha blending on or off setBlendAlpha :: Bool -> IO () setBlendAlpha state- | state + | state = do GL.blend $= GL.Enabled GL.blendFunc $= (GL.SrcAlpha, GL.OneMinusSrcAlpha) | otherwise = do GL.blend $= GL.Disabled- GL.blendFunc $= (GL.One, GL.Zero) + GL.blendFunc $= (GL.One, GL.Zero) -- | Turn line smoothing on or off setLineSmooth :: Bool -> IO ()
Graphics/Gloss/Rendering.hs view
@@ -1,5 +1,5 @@ -module Graphics.Gloss.Rendering +module Graphics.Gloss.Rendering ( -- * Picture data type Picture (..) , Point, Vector, Path@@ -38,11 +38,11 @@ -- | Set up the OpenGL context, clear the buffer, and render the given picture--- into it. +-- into it. -- -- This is the same as `renderPicture` composed with `withModelview` -- and `withClearBuffer`. If you want to manage your own OpenGL context then--- you can just call `renderPicture`. +-- you can just call `renderPicture`. -- -- Using this function assumes that you've already opened a window -- and set that to the active context. If you don't want to do your own window@@ -60,3 +60,4 @@ = withModelview windowSize $ withClearBuffer colorClear $ renderPicture state scale picture+
gloss-rendering.cabal view
@@ -1,5 +1,5 @@ name: gloss-rendering-version: 1.11.1.1+version: 1.12.0.0 license: MIT license-file: LICENSE author: Elise Huard@@ -7,17 +7,26 @@ category: Graphics build-type: Simple cabal-version: >=1.10-synopsis: Gloss picture data types and rendering functions. -description: +synopsis: Gloss picture data types and rendering functions.+description: Gloss picture data types and rendering functions. These functions don't do any window management. If you want gloss to setup your window as well then use the plain @gloss@ package. +source-repository head+ type: git+ location: https://github.com/benl23x5/gloss++source-repository this+ type: git+ tag: v1.12.0.0+ location: https://github.com/benl23x5/gloss+ library exposed-modules: Graphics.Gloss.Rendering - other-modules: + other-modules: Graphics.Gloss.Internals.Data.Color Graphics.Gloss.Internals.Data.Picture Graphics.Gloss.Internals.Rendering.Bitmap@@ -27,23 +36,18 @@ Graphics.Gloss.Internals.Rendering.Picture Graphics.Gloss.Internals.Rendering.State - build-depends: - base >= 4.8 && < 4.10,- containers == 0.5.*,- bytestring == 0.10.*,- OpenGL >= 2.12 && < 3.1,- GLUT == 2.7.*,- bmp == 1.2.*+ build-depends:+ base >= 4.8 && < 4.12+ , bmp == 1.2.*+ , bytestring == 0.10.*+ , containers == 0.5.*+ , GLUT == 2.7.*+ , OpenGL >= 2.12 && < 3.1 ghc-options: -Wall -O2 - default-language: + default-language: Haskell2010 - default-extensions: - BangPatterns- MagicHash- TypeSynonymInstances- FlexibleInstances- DeriveDataTypeable+-- vim: nospell