gloss-rendering 1.13.0.2 → 1.13.1.1
raw patch · 4 files changed
+45/−45 lines, 4 filesdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- Graphics/Gloss/Internals/Data/Color.hs +2/−1
- Graphics/Gloss/Internals/Rendering/Circle.hs +25/−20
- Graphics/Gloss/Internals/Rendering/Picture.hs +15/−21
- gloss-rendering.cabal +3/−3
Graphics/Gloss/Internals/Data/Color.hs view
@@ -112,6 +112,7 @@ clampColor :: Color -> Color clampColor cc = let (r, g, b, a) = rgbaOfColor cc- in RGBA (min 1 r) (min 1 g) (min 1 b) (min 1 a)+ clamp x = (min (max x 0.0) 1.0)+ in RGBA (clamp r) (clamp g) (clamp b) (clamp a)
Graphics/Gloss/Internals/Rendering/Circle.hs view
@@ -12,11 +12,11 @@ import qualified Graphics.Rendering.OpenGL.GL as GL +------------------------------------------------------------------------------- -- | 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 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.--- circleSteps :: Float -> Int circleSteps sDiam | sDiam < 8 = 8@@ -81,11 +81,12 @@ -- Arc ------------------------------------------------------------------------ -- | Render an arc with the given thickness.-renderArc :: Float -> Float -> Float -> Float -> Float -> Float -> Float -> IO ()+renderArc+ :: Float -> Float -> Float -> Float -> Float -> Float -> Float -> IO () renderArc posX posY scaleFactor radius_ a1 a2 thickness_ = go (abs radius_) (abs thickness_)- where go radius thickness-+ where+ go radius thickness -- Render zero thickness arcs with lines. | thickness == 0 , radScreen <- scaleFactor * radius@@ -99,7 +100,8 @@ -- | Render an arc as a line.-renderArcLine :: Float -> Float -> Int -> Float -> Float -> Float -> IO ()+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@@ -116,13 +118,17 @@ -- | Render an arc with a given thickness as a triangle strip-renderArcStrip :: Float -> Float -> Int -> Float -> Float -> Float -> Float -> IO ()+renderArcStrip+ :: Float -> Float -> Int -> Float -> Float -> Float -> Float -> IO () renderArcStrip (F# posX) (F# posY) steps r a1 a2 width = let n = fromIntegral steps tStep = (2 * pi) / n t1 = normalizeAngle $ degToRad a1- t2 = normalizeAngle $ degToRad a2++ a2' = normalizeAngle $ degToRad a2+ t2 = if a2' == 0 then 2*pi else a2'+ (tStart, tStop) = if t1 <= t2 then (t1, t2) else (t2, t1) tDiff = tStop - tStart tMid = tStart + tDiff / 2@@ -137,24 +143,23 @@ !(F# r2') = r + width / 2 in GL.renderPrimitive GL.TriangleStrip- $ do- -- start vector- addPointOnCircle posX posY r1' tStart'- addPointOnCircle posX posY r2' tStart'+ $ do -- start vector+ addPointOnCircle posX posY r1' tStart'+ addPointOnCircle posX posY r2' tStart' - -- If we don't have a complete step then just drop a point- -- between the two ending lines.- if tDiff < tStep- then do+ -- If we don't have a complete step then just drop a point+ -- between the two ending lines.+ if tDiff < tStep+ then do addPointOnCircle posX posY r1' tMid' -- end vectors addPointOnCircle posX posY r2' tStop' addPointOnCircle posX posY r1' tStop' -- else do- renderCircleStrip_step posX posY tStep' tCut' r1' tStart' r2'+ else do+ renderCircleStrip_step posX posY+ tStep' tCut' r1' tStart' r2' (tStart' `plusFloat#` tStep2') -- end vectors@@ -214,17 +219,17 @@ -- | Convert degrees to radians-{-# INLINE degToRad #-} degToRad :: Float -> Float degToRad d = d * pi / 180+{-# INLINE degToRad #-} -- | Normalise an angle to be between 0 and 2*pi radians-{-# INLINE normalizeAngle #-} normalizeAngle :: Float -> Float normalizeAngle f = f - 2 * pi * floor' (f / (2 * pi)) where floor' :: Float -> Float floor' x = fromIntegral (floor x :: Int)+{-# INLINE normalizeAngle #-} {- Unused sector drawing code.
Graphics/Gloss/Internals/Rendering/Picture.hs view
@@ -58,7 +58,6 @@ -> GL.renderPrimitive GL.LineStrip $ vertexPFs path - -- polygon (where?) Polygon path | stateWireframe state@@ -132,7 +131,6 @@ $ do GL.translate (GL.Vector3 (gf tx) (gf ty) 0) drawPicture state circScale p - -- Rotation ----------------------------- -- Easy rotations are done directly to avoid calling GL.perserveMatrix. Rotate _ (Circle radius)@@ -153,7 +151,6 @@ $ do GL.rotate (gf deg) (GL.Vector3 0 0 (-1)) drawPicture state circScale p - -- Scale -------------------------------- Scale sx sy p -> GL.preservingMatrix@@ -175,8 +172,7 @@ { bitmapSize = (width, height) , bitmapCacheMe = cacheMe } ->- -- width height imgData cacheMe imgSectionPos imgSectionSize ->- do+ do let rowInfo = -- calculate texture coordinates -- remark:@@ -228,14 +224,15 @@ -- 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 $- forM_ (bitmapPath (fromIntegral $ fst imgSectionSize) (fromIntegral $ snd imgSectionSize) `zip` rowInfo) $+ forM_ (bitmapPath (fromIntegral $ fst imgSectionSize)+ (fromIntegral $ snd imgSectionSize) `zip` rowInfo) $ \((polygonCoordX, polygonCoordY), (textureCoordX,textureCoordY)) -> do GL.texCoord $ GL.TexCoord2 (gf textureCoordX) (gf textureCoordY)- GL.vertex $ GL.Vertex2 (gf polygonCoordX) (gf polygonCoordY)+ GL.vertex $ GL.Vertex2 (gf polygonCoordX) (gf polygonCoordY) -- Restore color GL.currentColor $= oldColor@@ -289,13 +286,12 @@ -- Textures ---------------------------------------------------------------------- | Load a texture.--- If we've seen it before then use the pre-installed one from the texture--- cache, otherwise load it into OpenGL.+-- | Load a texture into the OpenGL context, or retrieve the existing handle+-- from our own cache. loadTexture- :: IORef [Texture]- -> BitmapData- -> Bool+ :: IORef [Texture] -- ^ Existing texture cache.+ -> BitmapData -- ^ Texture data.+ -> Bool -- ^ Force cache for newly loaded textures. -> IO Texture loadTexture refTextures imgData@BitmapData{ bitmapSize=(width,height) } cacheMe@@ -314,17 +310,15 @@ -> return tex Nothing- -> do tex <- installTexture imgData+ -> do tex <- installTexture imgData when cacheMe $ writeIORef refTextures (tex : textures) return tex --- | Install a texture into OpenGL.-installTexture- :: BitmapData- -> IO Texture-+-- | Install a texture into the OpenGL context,+-- returning the new texture handle.+installTexture :: BitmapData -> IO Texture installTexture bitmapData@(BitmapData _ fmt (width,height) cacheMe fptr) = do let glFormat@@ -374,7 +368,6 @@ | otherwise = GL.deleteObjectNames [texObject tex] - -- Utils ---------------------------------------------------------------------- -- | Turn alpha blending on or off setBlendAlpha :: Bool -> IO ()@@ -386,6 +379,7 @@ | otherwise = do GL.blend $= GL.Disabled GL.blendFunc $= (GL.One, GL.Zero)+ -- | Turn line smoothing on or off setLineSmooth :: Bool -> IO ()
gloss-rendering.cabal view
@@ -1,5 +1,5 @@ name: gloss-rendering-version: 1.13.0.2+version: 1.13.1.1 license: MIT license-file: LICENSE author: Elise Huard@@ -37,10 +37,10 @@ Graphics.Gloss.Internals.Rendering.State build-depends:- base >= 4.8 && < 4.12+ base >= 4.8 && < 4.13 , bmp == 1.2.* , bytestring == 0.10.*- , containers == 0.5.*+ , containers >= 0.5 && < 0.7 , GLUT == 2.7.* , OpenGL >= 2.12 && < 3.1