gloss 1.6.2.1 → 1.7.0.1

raw patch · 31 files changed

+814/−368 lines, 31 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Graphics/Gloss.hs +17/−5
• Graphics/Gloss/Algorithms/RayCast.hs +4/−4
• Graphics/Gloss/Data/Extent.hs +9/−5
• Graphics/Gloss/Data/Picture.hs +144/−47
• Graphics/Gloss/Data/Point.hs +2/−1
• Graphics/Gloss/Geometry/Line.hs +16/−14
• Graphics/Gloss/Interface/Animate.hs +0/−12
• Graphics/Gloss/Interface/Display.hs +0/−12
• Graphics/Gloss/Interface/Game.hs +0/−18
• Graphics/Gloss/Interface/IO/Animate.hs +29/−0
• Graphics/Gloss/Interface/IO/Game.hs +31/−0
• Graphics/Gloss/Interface/IO/Simulate.hs +36/−0
• Graphics/Gloss/Interface/Pure/Animate.hs +29/−0
• Graphics/Gloss/Interface/Pure/Display.hs +33/−0
• Graphics/Gloss/Interface/Pure/Game.hs +42/−0
• Graphics/Gloss/Interface/Pure/Simulate.hs +50/−0
• Graphics/Gloss/Interface/Simulate.hs +0/−19
• Graphics/Gloss/Internals/Interface/Animate.hs +12/−26
• Graphics/Gloss/Internals/Interface/Animate/State.hs +7/−5
• Graphics/Gloss/Internals/Interface/Animate/Timing.hs +20/−16
• Graphics/Gloss/Internals/Interface/Backend/GLFW.hs +14/−4
• Graphics/Gloss/Internals/Interface/Backend/GLUT.hs +1/−2
• Graphics/Gloss/Internals/Interface/Display.hs +1/−25
• Graphics/Gloss/Internals/Interface/Game.hs +19/−29
• Graphics/Gloss/Internals/Interface/Simulate.hs +6/−25
• Graphics/Gloss/Internals/Interface/Simulate/Idle.hs +15/−9
• Graphics/Gloss/Internals/Render/Bitmap.hs +1/−1
• Graphics/Gloss/Internals/Render/Circle.hs +208/−53
• Graphics/Gloss/Internals/Render/Picture.hs +59/−30
• LICENSE +1/−1
• gloss.cabal +8/−5

@@ -25,11 +25,23 @@ --   `simulate`. -- --   If you want to manage your own key\/mouse events then use `play`.---+--  --   Gloss uses OpenGL under the hood, but you don't have to worry about any of that. --+--   Gloss programs should be compiled with @-threaded@, otherwise the GHC runtime+--   will limit the frame-rate to around 20Hz.+--+-- -- @Release Notes: --+-- For 1.7.0:+--   * Tweaked circle level-of-detail reduction code.+--   * Increased frame rate cap to 100hz.+--   Thanks to Doug Burke+--   * Primitives for drawing arcs and sectors.+--   Thanks to Thomas DuBuisson+--   * IO versions of animate, simplate and play.+-- -- For 1.6.0: --   Thanks to Anthony Cowley --   * Full screen display mode.@@ -61,7 +73,7 @@ import Graphics.Gloss.Data.Display import Graphics.Gloss.Data.Picture import Graphics.Gloss.Data.Color-import Graphics.Gloss.Internals.Interface.Display-import Graphics.Gloss.Internals.Interface.Animate-import Graphics.Gloss.Internals.Interface.Simulate-import Graphics.Gloss.Internals.Interface.Game+import Graphics.Gloss.Interface.Pure.Display+import Graphics.Gloss.Interface.Pure.Animate+import Graphics.Gloss.Interface.Pure.Simulate+import Graphics.Gloss.Interface.Pure.Game

@@ -74,9 +74,9 @@ 	TNode nw ne sw se 	 | touchesSegExtent p1 p2 extent  	 -> concat-	 	[ traceSegIntoCellularQuadTree p1 p2 (cutQuadOfExtent NW extent) nw-		, traceSegIntoCellularQuadTree p1 p2 (cutQuadOfExtent NE extent) ne-		, traceSegIntoCellularQuadTree p1 p2 (cutQuadOfExtent SW extent) sw-		, traceSegIntoCellularQuadTree p1 p2 (cutQuadOfExtent SE extent) se ]+             [ traceSegIntoCellularQuadTree p1 p2 (cutQuadOfExtent NW extent) nw+             , traceSegIntoCellularQuadTree p1 p2 (cutQuadOfExtent NE extent) ne+             , traceSegIntoCellularQuadTree p1 p2 (cutQuadOfExtent SW extent) sw+             , traceSegIntoCellularQuadTree p1 p2 (cutQuadOfExtent SE extent) se ] 	 	_ -> []

@@ -1,7 +1,8 @@ {-# LANGUAGE PatternGuards #-}  -- | Represents an integral rectangular area of the 2D plane.---   Using `Int`s (instead of `Float`s) for the bounds means we can safely compare extents for equality.+--   Using `Int`s (instead of `Float`s) for the bounds means we can safely+--   compare extents for equality. module Graphics.Gloss.Data.Extent 	( Extent 	, Coord@@ -26,7 +27,8 @@   -- | A rectangular area of the 2D plane.---   We keep the type abstract to ensure that invalid extents cannot be constructed.+--   We keep the type abstract to ensure that invalid extents cannot be+--   constructed. data Extent 	= Extent Int Int Int Int 	deriving (Eq, Show)@@ -136,8 +138,9 @@ 		return	$ quad : rest  --- | If a line segment (P1-P2) intersects the outer edge of an extent then return the intersection point, ---   that is closest to P1, if any. If P1 is inside the extent then `Nothing`.+-- | If a line segment (P1-P2) intersects the outer edge of an extent then+--   return the intersection point, that is closest to P1, if any.+--   If P1 is inside the extent then `Nothing`. -- --   @ --                   P2@@ -182,7 +185,8 @@ 		w	= fromIntegral w'  --- | Check whether a line segment's endpoints are inside an extent, or if it intersects with the boundary.+-- | Check whether a line segment's endpoints are inside an extent, or if it+--   intersects with the boundary. touchesSegExtent :: Point -> Point -> Extent -> Bool touchesSegExtent p1 p2 extent 	=   pointInExtent extent p1

@@ -8,27 +8,40 @@ 	, BitmapData  	-- * Aliases for Picture constructors-	, blank, polygon, line, circle, thickCircle, text, bitmap-	, color, translate, rotate, scale+	, blank+        , polygon+        , line+        , circle, thickCircle+        , arc,    thickArc+        , text+        , bitmap+	, color+        , translate, rotate, scale 	, pictures +	-- * Compound shapes+ 	, lineLoop+ 	, circleSolid+        , arcSolid+        , sectorWire+	, rectanglePath+        , rectangleWire+        , rectangleSolid+	, rectangleUpperPath+        , rectangleUpperWire+        , rectangleUpperSolid+         -- * Loading Bitmaps         , bitmapOfForeignPtr-	, bitmapOfByteString-	, bitmapOfBMP-	, loadBMP+        , bitmapOfByteString+        , bitmapOfBMP+        , loadBMP) -	-- * Miscellaneous- 	, lineLoop- 	, circleSolid-	-	-- * Rectangles-	, rectanglePath, 	rectangleWire, 		rectangleSolid-	, rectangleUpperPath,	rectangleUpperWire, 	rectangleUpperSolid) where import Graphics.Gloss.Data.Color import Graphics.Gloss.Data.Point import Graphics.Gloss.Data.Vector+import Graphics.Gloss.Geometry.Angle import Graphics.Gloss.Internals.Render.Bitmap import Codec.BMP import Foreign.ForeignPtr@@ -40,7 +53,7 @@ import Data.ByteString import System.IO.Unsafe import qualified Data.ByteString.Unsafe as BSU-+import Prelude hiding (map)  -- | A path through the x-y plane. type Path	= [Point]				@@ -64,16 +77,27 @@  	-- | A circle with the given thickness and radius. 	--   If the thickness is 0 then this is equivalent to `Circle`.-	| ThickCircle	Float		Float+	| ThickCircle	Float Float +	-- | 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 +        --  (in degrees), with the given radius  and thickness.+	--   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 -	-- | A bitmap image with a width, height and a Vector holding the 32 bit RGBA bitmap data.+	-- | A bitmap image with a width, height and some 32-bit RGBA+        --   bitmap 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`.+	--  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  	-- Color ------------------------------------------@@ -84,7 +108,7 @@ 	-- | A picture translated by the given x and y coordinates. 	| Translate	Float Float	Picture -	-- | A picture rotated by the given angle (in degrees).+	-- | A picture rotated clockwise by the given angle (in degrees). 	| Rotate	Float		Picture  	-- | A picture scaled by the given x and y factors.@@ -96,53 +120,92 @@ 	deriving (Show, Eq)  --- Instances -------------------------------------------------------------------------------------+-- Instances ------------------------------------------------------------------ instance Monoid Picture where 	mempty		= blank 	mappend a b	= Pictures [a, b] 	mconcat		= Pictures  --- Constructors ----------------------------------------------------------------------------------+-- Constructors ----------------------------------------------------------------+-- NOTE: The docs here should be identical to the ones on the constructors.++-- | A blank picture, with nothing in it. blank :: Picture blank	= Blank +-- | A convex polygon filled with a solid color. polygon :: Path -> Picture polygon = Polygon +-- | A line along an arbitrary path. line :: Path -> Picture line 	= Line -circle :: Float -> Picture+-- | A circle with the given radius.+circle  :: Float  -> Picture circle 	= Circle -thickCircle :: Float -> Float -> Picture+-- | A circle with the given thickness and radius.+--   If the thickness is 0 then this is equivalent to `Circle`.+thickCircle  :: Float -> Float -> Picture thickCircle = ThickCircle +-- | A circular arc drawn counter-clockwise between two angles (in degrees) +--   at the given radius.+arc     :: Float -> Float -> Float -> Picture+arc = Arc++-- | 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 -> Picture+thickArc = ThickArc++-- | Some text to draw with a vector font. text :: String -> Picture text = Text -bitmap :: Int -> Int -> BitmapData -> Bool -> Picture+-- | A bitmap image with a width, height and a Vector holding the +--   32-bit RGBA bitmap 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 -> Picture bitmap = Bitmap +-- | A picture drawn with this color. color :: Color -> Picture -> Picture color = Color +-- | A picture translated by the given x and y coordinates. translate :: Float -> Float -> Picture -> Picture translate = Translate -rotate :: Float -> Picture -> Picture+-- | A picture rotated clockwise by the given angle (in degrees).+rotate  :: Float -> Picture -> Picture rotate = Rotate -scale :: Float -> Float -> Picture -> Picture+-- | A picture scaled by the given x and y factors.+scale   :: Float -> Float -> Picture -> Picture scale = Scale +-- | A picture consisting of several others. pictures :: [Picture] -> Picture pictures = Pictures   -- Bitmaps ----------------------------------------------------------------------- | O(1). Use a `ForeignPtr` of RGBA data as a bitmap.+-- | O(1). Use a `ForeignPtr` of RGBA data as a bitmap with the given+--   width and height.++--   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`. bitmapOfForeignPtr :: Int -> Int -> ForeignPtr Word8 -> Bool -> Picture bitmapOfForeignPtr width height fptr cacheMe  = let  len     = width * height * 4@@ -150,7 +213,13 @@    in   Bitmap width height bdata cacheMe   --- | O(size). Copy a `ByteString` of RGBA data into a bitmap.+-- | O(size). Copy a `ByteString` of RGBA data into a bitmap with the given+--   width and height.+--+--   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`. {-# NOINLINE bitmapOfByteString #-} bitmapOfByteString :: Int -> Int -> ByteString -> Bool -> Picture bitmapOfByteString width height bs cacheMe@@ -196,58 +265,86 @@          Right bmp      -> return $ bitmapOfBMP bmp  --- Shapes ------------------------------------------------------------------------------------------- | A closed loop along this path.+-- Other Shapes ---------------------------------------------------------------+-- | A closed loop along a path. lineLoop :: Path -> Picture lineLoop []	= Line [] lineLoop (x:xs)	= Line ((x:xs) ++ [x])  --- | A path representing a rectangle centered about the origin,---	with the given width and height.-rectanglePath :: Float -> Float -> Path+-- Circles and Arcs -----------------------------------------------------------+-- | A solid circle with the given radius.+circleSolid :: Float -> Picture+circleSolid r +        = thickCircle (r/2) r+++-- | A solid arc, drawn counter-clockwise between two angles at the given radius.+arcSolid  :: Float -> Float -> Float -> Picture+arcSolid a1 a2 r +        = thickArc a1 a2 (r/2) r +++-- | A wireframe sector of a circle. +--   An arc is draw counter-clockwise from the first to the second angle at+--   the given radius. Lines are drawn from the origin to the ends of the arc.+---+--   NOTE: We take the absolute value of the radius incase it's negative.+--   It would also make sense to draw the sector flipped around the +--   origin, but I think taking the absolute value will be less surprising+--   for the user.+-- +sectorWire :: Float -> Float -> Float -> Picture+sectorWire a1 a2 r_+ = let r        = abs r_+   in  Pictures +        [ Arc a1 a2 r+        , Line [(0, 0), (r * cos (degToRad a1), r * sin (degToRad a1))]+        , Line [(0, 0), (r * cos (degToRad a2), r * sin (degToRad a2))] ]+++-- Rectangles -----------------------------------------------------------------+-- NOTE: Only the first of these rectangle functions has haddocks on the+--       arguments to reduce the amount of noise in the extracted docs.++-- | A path representing a rectangle centered about the origin+rectanglePath +        :: Float        -- ^ width of rectangle+        -> Float        -- ^ height of rectangle+        -> Path rectanglePath sizeX sizeY			  = let	sx	= sizeX / 2 	sy	= sizeY / 2    in	[(-sx, -sy), (-sx, sy), (sx, sy), (sx, -sy)]  --- | A wireframe rectangle centered about the origin,---	with the given width and height.+-- | A wireframe rectangle centered about the origin. rectangleWire :: Float -> Float -> Picture rectangleWire sizeX sizeY 	= lineLoop $ rectanglePath sizeX sizeY  --- | A wireframe rectangle in the y > 0 half of the x-y plane,---	with the given width and height.+-- | A wireframe rectangle in the y > 0 half of the x-y plane. rectangleUpperWire :: Float -> Float -> Picture rectangleUpperWire sizeX sizeY 	= lineLoop $ rectangleUpperPath sizeX sizeY  --- | A path representing a rectangle in the y > 0 half of the x-y plane,---	with the given width and height+-- | A path representing a rectangle in the y > 0 half of the x-y plane. rectangleUpperPath :: Float -> Float -> Path rectangleUpperPath sizeX sy  = let 	sx	= sizeX / 2    in  	[(-sx, 0), (-sx, sy), (sx, sy), (sx, 0)]  --- | A solid rectangle centered about the origin, ---	with the given width and height.+-- | A solid rectangle centered about the origin. rectangleSolid :: Float -> Float -> Picture rectangleSolid sizeX sizeY 	= Polygon $ rectanglePath sizeX sizeY  --- | A solid rectangle in the y > 0 half of the x-y plane,---	with the given width and height.+-- | A solid rectangle in the y > 0 half of the x-y plane. rectangleUpperSolid :: Float -> Float -> Picture rectangleUpperSolid sizeX sizeY 	= Polygon  $ rectangleUpperPath sizeX sizeY---- | A solid circle with the given radius.-circleSolid :: Float -> Picture-circleSolid r = thickCircle (r/2) r 

@@ -6,7 +6,8 @@ where  -- | A point on the x-y plane.---   Points can also be treated as `Vector`s, so "Graphics.Gloss.Data.Vector" may also be useful.+--   Points can also be treated as `Vector`s, so "Graphics.Gloss.Data.Vector"+--   may also be useful. type Point	= (Float, Float)			  

@@ -2,7 +2,8 @@  -- | Geometric functions concerning lines and segments. -----   A @Line@ is taken to be infinite in length, while a @Seg@ is finite length line segment represented by its two endpoints. +--   A @Line@ is taken to be infinite in length, while a @Seg@ is finite length+--   line segment represented by its two endpoints.  module Graphics.Gloss.Geometry.Line 	( segClearsBox @@ -94,11 +95,11 @@   --- Line-Line intersection -------------------------------------------------------------------------+-- Line-Line intersection ----------------------------------------------------- --- | Given four points specifying two lines, get the point where the two lines cross, if any.---   Note that the lines extend off to infinity, so the intersection point might not lie---   between either of the two pairs of points.+-- | Given four points specifying two lines, get the point where the two lines+--   cross, if any. Note that the lines extend off to infinity, so the+--   intersection point might not line between either of the two pairs of points. -- -- @ --     \\      /@@ -137,9 +138,9 @@ 	     in	Just (numx / den, numy / den)  --- Segment-Line intersection -------------------------------------------------------------------------- | Get the point where a segment @P1-P2@ crosses an infinite line @P3-P4@, if any.+-- Segment-Line intersection --------------------------------------------------+-- | Get the point where a segment @P1-P2@ crosses an infinite line @P3-P4@,+--   if any. -- intersectSegLine 	:: Point	-- ^ `P1`@@ -237,9 +238,10 @@ 	       , (x0 - x1) * (y2 - y1) / (x2 - x1) + y1)  --- Segment-Segment intersection -------------------------------------------------------------------+-- Segment-Segment intersection ----------------------------------------------- --- | Get the point where a segment @P1-P2@ crosses another segement @P3-P4@, if any.+-- | Get the point where a segment @P1-P2@ crosses another segement @P3-P4@,+--   if any. intersectSegSeg 	:: Point	-- ^ `P1` 	-> Point	-- ^ `P2`@@ -286,8 +288,8 @@ 	| x0 > xb	= Nothing 	| otherwise	= Just (x0, y0) 		-	where x0 | (y2 - y1) == 0 	= x1-		 | otherwise		= (y0 - y1) * (x2 - x1) / (y2 - y1) + x1+	where x0 | (y2 - y1) == 0 = x1+		 | otherwise	  = (y0 - y1) * (x2 - x1) / (y2 - y1) + x1   -- | Check if an arbitrary segment intersects a vertical segment.@@ -318,7 +320,7 @@ 	| y0 > yb	= Nothing 	| otherwise	= Just (x0, y0) 	-	where y0 | (x2 - x1) == 0	= y1-		 | otherwise		= (x0 - x1) * (y2 - y1) / (x2 - x1) + y1+	where y0 | (x2 - x1) == 0 = y1+		 | otherwise	  = (x0 - x1) * (y2 - y1) / (x2 - x1) + y1  

@@ -1,12 +0,0 @@---- | Display mode is for drawing a static picture.-module Graphics.Gloss.Interface.Animate- 	( module Graphics.Gloss.Data.Display-        , module Graphics.Gloss.Data.Picture-	, module Graphics.Gloss.Data.Color-	, animate)-where-import Graphics.Gloss.Data.Display-import Graphics.Gloss.Data.Picture-import Graphics.Gloss.Data.Color-import Graphics.Gloss.Internals.Interface.Animate

@@ -1,12 +0,0 @@---- | Display mode is for drawing a static picture.-module Graphics.Gloss.Interface.Display- 	( module Graphics.Gloss.Data.Display-        , module Graphics.Gloss.Data.Picture-	, module Graphics.Gloss.Data.Color-	, display)-where-import Graphics.Gloss.Data.Display-import Graphics.Gloss.Data.Picture-import Graphics.Gloss.Data.Color-import Graphics.Gloss.Internals.Interface.Display

@@ -1,18 +0,0 @@---- We export this stuff separately so we don't clutter up the --- API of the Graphics.Gloss module.---- | This game mode lets you manage your own input. Pressing ESC will still abort the program,---   but you don't get automatic pan and zoom controls like with `displayInWindow`.-module Graphics.Gloss.Interface.Game- 	( module Graphics.Gloss.Data.Display-        , module Graphics.Gloss.Data.Picture-	, module Graphics.Gloss.Data.Color-	, play-	, Event(..), Key(..), SpecialKey(..), MouseButton(..), KeyState(..), Modifiers(..))-where-import Graphics.Gloss.Data.Display-import Graphics.Gloss.Data.Picture-import Graphics.Gloss.Data.Color-import Graphics.Gloss.Internals.Interface.Game-import Graphics.Gloss.Internals.Interface.Backend

@@ -0,0 +1,29 @@++-- | Display mode is for drawing a static picture.+module Graphics.Gloss.Interface.IO.Animate+        ( module Graphics.Gloss.Data.Display+        , module Graphics.Gloss.Data.Picture+        , module Graphics.Gloss.Data.Color+        , animateIO)+where+import Graphics.Gloss.Data.Display+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import Graphics.Gloss.Internals.Interface.Animate+import Graphics.Gloss.Internals.Interface.Backend+++-- | Open a new window and display the given animation.+--+--   Once the window is open you can use the same commands as with @display@.+--+animateIO :: Display              -- ^ Display mode.+        -> Color                  -- ^ Background color.+        -> (Float -> IO Picture)  -- ^ Function to produce the next frame of animation. +                                  --      It is passed the time in seconds since the program started.+        -> IO ()++animateIO display backColor frameFunIO+        = animateWithBackendIO +                defaultBackendState display backColor+                frameFunIO

@@ -0,0 +1,31 @@+{-# LANGUAGE ExplicitForAll #-}++-- | This game mode lets you manage your own input. Pressing ESC will still abort the program,+--   but you don't get automatic pan and zoom controls like with `displayInWindow`.+module Graphics.Gloss.Interface.IO.Game+        ( module Graphics.Gloss.Data.Display+        , module Graphics.Gloss.Data.Picture+        , module Graphics.Gloss.Data.Color+        , playIO+        , Event(..), Key(..), SpecialKey(..), MouseButton(..))+where+import Graphics.Gloss.Data.Display+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import Graphics.Gloss.Internals.Interface.Game+import Graphics.Gloss.Internals.Interface.Backend+++-- | Play a game in a window, using IO actions to build the pictures. +playIO  :: forall world+        .  Display                      -- ^ Display mode.+        -> Color                        -- ^ Background color.+        -> Int                          -- ^ Number of simulation steps to take for each second of real time.+        -> world                        -- ^ The initial world.+        -> (world -> IO Picture)        -- ^ An action to convert the world a picture.+        -> (Event -> world -> IO world) -- ^ A function to handle input events.+        -> (Float -> world -> IO world) -- ^ A function to step the world one iteration.+                                        --   It is passed the period of time (in seconds) needing to be advanced.+        -> IO ()++playIO = playWithBackendIO defaultBackendState

@@ -0,0 +1,36 @@+{-# LANGUAGE RankNTypes #-}++-- We export this stuff separately so we don't clutter up the +-- API of the Graphics.Gloss module.++-- | Simulate mode is for producing an animation of some model who's picture+--   changes over finite time steps. The behavior of the model can also depent+--   on the current `ViewPort`.+module Graphics.Gloss.Interface.IO.Simulate+        ( module Graphics.Gloss.Data.Display+        , module Graphics.Gloss.Data.Picture+        , module Graphics.Gloss.Data.Color+        , simulateIO+        , ViewPort(..))+where+import Graphics.Gloss.Data.Display+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import Graphics.Gloss.Internals.Interface.ViewPort+import Graphics.Gloss.Internals.Interface.Simulate+import Graphics.Gloss.Internals.Interface.Backend+++simulateIO :: forall model+        .  Display               -- ^ Display mode.+        -> Color                 -- ^ Background color.+        -> Int                   -- ^ Number of simulation steps to take for each second of real time.+        -> model                 -- ^ The initial model.+        -> (model -> IO Picture) -- ^ A function to convert the model to a picture.+        -> (ViewPort -> Float -> model -> IO model) +                                 -- ^ A function to step the model one iteration. It is passed the +                                 --     current viewport and the amount of time for this simulation+                                 --     step (in seconds).+        -> IO ()++simulateIO = simulateWithBackendIO defaultBackendState

@@ -0,0 +1,29 @@++-- | Display mode is for drawing a static picture.+module Graphics.Gloss.Interface.Pure.Animate+ 	( module Graphics.Gloss.Data.Display+        , module Graphics.Gloss.Data.Picture+	, module Graphics.Gloss.Data.Color+	, animate)+where+import Graphics.Gloss.Data.Display+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import Graphics.Gloss.Internals.Interface.Animate+import Graphics.Gloss.Internals.Interface.Backend+++-- | Open a new window and display the given animation.+--+--   Once the window is open you can use the same commands as with @display@.+--+animate :: Display              -- ^ Display mode.+        -> Color                -- ^ Background color.+        -> (Float -> Picture)   -- ^ Function to produce the next frame of animation. +                                --      It is passed the time in seconds since the program started.+        -> IO ()++animate display backColor frameFun+        = animateWithBackendIO +                defaultBackendState display backColor+                (return . frameFun) 

@@ -0,0 +1,33 @@++-- | Display mode is for drawing a static picture.+module Graphics.Gloss.Interface.Pure.Display+ 	( module Graphics.Gloss.Data.Display+        , module Graphics.Gloss.Data.Picture+	, module Graphics.Gloss.Data.Color+	, display)+where+import Graphics.Gloss.Data.Display+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import Graphics.Gloss.Internals.Interface.Display+import Graphics.Gloss.Internals.Interface.Backend+++-- | Open a new window and display the given picture.+--+--   Use the following commands once the window is open:+--+--      * Quit - esc-key.+--+--      * Move Viewport - left-click drag, arrow keys.+--+--      * Rotate Viewport - right-click drag, control-left-click drag, or home\/end-keys.+--+--      * Zoom Viewport - mouse wheel, or page up\/down-keys.+--+display :: Display          -- ^ Display mode.+        -> Color            -- ^ Background color.+        -> Picture          -- ^ The picture to draw.+        -> IO ()++display = displayWithBackend defaultBackendState

@@ -0,0 +1,42 @@+{-# LANGUAGE ExplicitForAll #-}++-- We export this stuff separately so we don't clutter up the +-- API of the Graphics.Gloss module.++-- | This game mode lets you manage your own input. Pressing ESC will still abort the program,+--   but you don't get automatic pan and zoom controls like with `displayInWindow`.+module Graphics.Gloss.Interface.Pure.Game+ 	( module Graphics.Gloss.Data.Display+        , module Graphics.Gloss.Data.Picture+	, module Graphics.Gloss.Data.Color+	, play+	, Event(..), Key(..), SpecialKey(..), MouseButton(..), KeyState(..), Modifiers(..))+where+import Graphics.Gloss.Data.Display+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import Graphics.Gloss.Internals.Interface.Game+import Graphics.Gloss.Internals.Interface.Backend+++-- | Play a game in a window. +play    :: forall world+        .  Display                      -- ^ Display mode.+        -> Color                        -- ^ Background color.+        -> Int                          -- ^ Number of simulation steps to take for each second of real time.+        -> world                        -- ^ The initial world.+        -> (world -> Picture)           -- ^ A function to convert the world a picture.+        -> (Event -> world -> world)    -- ^ A function to handle input events.+        -> (Float -> world -> world)    -- ^ A function to step the world one iteration.+                                        --   It is passed the period of time (in seconds) needing to be advanced.+        -> IO ()++play    display backColor simResolution+        worldStart worldToPicture worldHandleEvent worldAdvance++ = playWithBackendIO defaultBackendState +        display backColor simResolution+        worldStart +        (return . worldToPicture)+        (\event world -> return $ worldHandleEvent event world)+        (\time  world -> return $ worldAdvance     time  world)

@@ -0,0 +1,50 @@+{-# LANGUAGE RankNTypes #-}++-- We export this stuff separately so we don't clutter up the +-- API of the Graphics.Gloss module.++-- | Simulate mode is for producing an animation of some model who's picture+--   changes over finite time steps. The behavior of the model can also depent+--   on the current `ViewPort`.+module Graphics.Gloss.Interface.Pure.Simulate+ 	( module Graphics.Gloss.Data.Display+        , module Graphics.Gloss.Data.Picture+	, module Graphics.Gloss.Data.Color+	, simulate+        , ViewPort(..))+where+import Graphics.Gloss.Data.Display+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import Graphics.Gloss.Internals.Interface.ViewPort+import Graphics.Gloss.Internals.Interface.Simulate+import Graphics.Gloss.Internals.Interface.Backend+++-- | Run a finite-time-step simulation in a window. You decide how the model is represented,+--      how to convert the model to a picture, and how to advance the model for each unit of time. +--      This function does the rest.+--+--   Once the window is open you can use the same commands as with @display@.+--+simulate :: forall model+        .  Display                      -- ^ Display mode.+        -> Color                        -- ^ Background color.+        -> Int                          -- ^ Number of simulation steps to take for each second of real time.+        -> model                        -- ^ The initial model.+        -> (model -> Picture)           -- ^ A function to convert the model to a picture.+        -> (ViewPort -> Float -> model -> model) -- ^ A function to step the model one iteration. It is passed the +                                                 --     current viewport and the amount of time for this simulation+                                                 --     step (in seconds).+        -> IO ()++simulate display backColor simResolution +         modelStart modelToPicture modelStep++ = simulateWithBackendIO defaultBackendState+         display backColor simResolution+         modelStart+         (return . modelToPicture)+         (\view time model -> return $ modelStep view time model)++        

@@ -1,19 +0,0 @@---- We export this stuff separately so we don't clutter up the --- API of the Graphics.Gloss module.---- | Simulate mode is for producing an animation of some model who's picture---   changes over finite time steps. The behavior of the model can also depent---   on the current `ViewPort`.-module Graphics.Gloss.Interface.Simulate- 	( module Graphics.Gloss.Data.Display-        , module Graphics.Gloss.Data.Picture-	, module Graphics.Gloss.Data.Color-	, simulate-        , ViewPort(..))-where-import Graphics.Gloss.Data.Display-import Graphics.Gloss.Data.Picture-import Graphics.Gloss.Data.Color-import Graphics.Gloss.Internals.Interface.ViewPort-import Graphics.Gloss.Internals.Interface.Simulate

@@ -1,7 +1,6 @@  module Graphics.Gloss.Internals.Interface.Animate-	( animate-	, animateWithBackend)+	(animateWithBackendIO) where	 import Graphics.Gloss.Data.Color import Graphics.Gloss.Data.Picture@@ -19,36 +18,23 @@ import qualified Graphics.Gloss.Internals.Interface.ViewPort.ControlState	as VPC import qualified Graphics.Gloss.Internals.Interface.Animate.State		as AN import qualified Graphics.Gloss.Internals.Interface.Callback			as Callback- import Data.IORef import Control.Monad import System.Mem import GHC.Float (double2Float) --- | Open a new window and display the given animation.------   Once the window is open you can use the same commands as with @display@.----animate :: Display              -- ^ Display mode.-	-> Color		-- ^ Background color.-	-> (Float -> Picture)	-- ^ Function to produce the next frame of animation. -				--	It is passed the time in seconds since the program started.-	-> IO ()--animate = animateWithBackend defaultBackendState---animateWithBackend+animateWithBackendIO 	:: Backend a-	=> a			-- ^ Initial State of the backend-        -> Display              -- ^ Display mode.-	-> Color		-- ^ Background color.-	-> (Float -> Picture)	-- ^ Function to produce the next frame of animation.-				--	It is passed the time in seconds since the program started.+	=> a                     -- ^ Initial State of the backend+        -> Display               -- ^ Display mode.+	-> Color                 -- ^ Background color.+	-> (Float -> IO Picture) -- ^ Function to produce the next frame of animation.+                                 --     It is passed the time in seconds since the program started. 	-> IO () -animateWithBackend backend display backColor frameFun+animateWithBackendIO backend display backColor frameOp  = do	+        --  	viewSR		<- newIORef viewPortInit 	viewControlSR	<- newIORef VPC.stateInit 	animateSR	<- newIORef AN.stateInit@@ -57,10 +43,10 @@   	let displayFun backendRef = do 		-- extract the current time from the state-  	 	timeS		<- animateSR `getsIORef` AN.stateAnimateTime+		timeS		<- animateSR `getsIORef` AN.stateAnimateTime -		-- call the user function to get the animation frame-		let picture	= frameFun (double2Float timeS)+		-- call the user action to get the animation frame+		picture		<- frameOp (double2Float timeS)  		renderS		<- readIORef renderSR 		viewS		<- readIORef viewSR

@@ -12,6 +12,9 @@ 	-- | Whether the animation is running. 	  stateAnimate			:: Bool +        -- | How many times we've entered the animation loop.+        , stateAnimateCount             :: Integer+ 	-- | Whether this is the first frame of the animation. 	, stateAnimateStart		:: Bool @@ -22,10 +25,8 @@ 	, stateDisplayTime		:: Double 	, stateDisplayTimeLast		:: Double -	-- | Clamp the minimum time between frames to this value (in msec)-	--	Most LCD monitors refresh at around 50Hz so setting-	--	this to < 20msec probably isn't worthwhile.-	--+	-- | Clamp the minimum time between frames to this value (in seconds)+        --      Setting this to < 10ms probably isn't worthwhile. 	, stateDisplayTimeClamp		:: Double 							 	-- | The time when the last call to the users render function finished.@@ -42,11 +43,12 @@ stateInit 	= State 	{ stateAnimate			= True+        , stateAnimateCount             = 0 	, stateAnimateStart		= True 	, stateAnimateTime		= 0 	, stateDisplayTime		= 0 	, stateDisplayTimeLast		= 0 -	, stateDisplayTimeClamp		= 0.02+	, stateDisplayTimeClamp		= 0.01 	, stateGateTimeStart		= 0 	, stateGateTimeEnd		= 0  	, stateGateTimeElapsed		= 0 }

@@ -32,25 +32,30 @@ 		{ stateDisplayTime	= displayTime  		, stateDisplayTimeLast	= displayTimeLast } -{-	putStr 	$  "  displayTime        = " ++ show displayTime 		++ "\n"-	 	++ "  displayTimeLast    = " ++ show displayTimeLast 		++ "\n"-		++ "  displayTimeElapsed = " ++ show displayTimeElapsed 	++ "\n"--}- 	-- increment the animation time-	animate			<- stateRef `getsIORef` stateAnimate-	animateTime		<- stateRef `getsIORef` stateAnimateTime-	animateStart		<- stateRef `getsIORef` stateAnimateStart-	+	animate		<- stateRef `getsIORef` stateAnimate+        animateCount    <- stateRef `getsIORef` stateAnimateCount+	animateTime	<- stateRef `getsIORef` stateAnimateTime+	animateStart	<- stateRef `getsIORef` stateAnimateStart++{-+        when (animateCount `mod` 5 == 0)+         $  putStr  $  "  displayTime        = " ++ show displayTime                ++ "\n"+                    ++ "  displayTimeLast    = " ++ show displayTimeLast            ++ "\n"+                    ++ "  displayTimeElapsed = " ++ show displayTimeElapsed         ++ "\n"+                    ++ "  fps                = " ++ show (truncate $ 1 / displayTimeElapsed)   ++ "\n"+-}	 	when (animate && not animateStart)-	 $ do	stateRef `modifyIORef` \s -> s-			{ stateAnimateTime	= animateTime + displayTimeElapsed }+	 $ stateRef `modifyIORef` \s -> s+	       { stateAnimateTime	= animateTime + displayTimeElapsed } 			 	when animate-	 $ do	stateRef `modifyIORef` \s -> s-	 		{ stateAnimateStart	= False }+	 $ stateRef `modifyIORef` \s -> s+	       { stateAnimateCount      = animateCount + 1+               , stateAnimateStart	= False  }  + -- | Handles animation timing details. --	Call this function at the end of each frame. animateEnd :: IORef State -> DisplayCallback@@ -61,9 +66,8 @@  	gateTimeStart	<- elapsedTime backendRef			-- the start of this gate 	gateTimeEnd	<- stateRef `getsIORef` stateGateTimeEnd	-- end of the previous gate-	let gateTimeElapsed	-			= gateTimeStart - gateTimeEnd-	+	let gateTimeElapsed = gateTimeStart - gateTimeEnd+ 	when (gateTimeElapsed < timeClamp) 	 $ do	sleep backendRef (timeClamp - gateTimeElapsed) 

@@ -12,7 +12,7 @@ import Graphics.UI.GLFW                    (WindowValue(..)) import qualified Graphics.UI.GLFW          as GLFW import qualified Graphics.Rendering.OpenGL as GL-+import qualified Control.Excpetion         as X  -- [Note: FreeGlut] -- ~~~~~~~~~~~~~~~~@@ -434,9 +434,19 @@         -> IO ()  runMainLoopGLFW stateRef - = do   windowIsOpen <- GLFW.windowIsOpen-        when windowIsOpen -         $ do   dirty <- fmap dirtyScreen $ readIORef stateRef+ = X.catch go recover+ where+ recover :: SomeException -> IO ()x+ recover = do+#ifdef linux_HOST_OS+-- See [Note: FreeGlut] for why we need this.+        GLUT.exit+#endif+        return True + go :: IO ()+ go = do windowIsOpen <- GLFW.windowIsOpen+         when windowIsOpen +          $ do  dirty <- fmap dirtyScreen $ readIORef stateRef                  when dirty                  $ do   s <- readIORef stateRef

@@ -59,7 +59,7 @@                 return $ (fromIntegral t) / 1000          sleep _ sec-         = do   threadDelay (round $ sec * 100000)+         = do   threadDelay (round $ sec * 1000000)   -- Initialise -----------------------------------------------------------------@@ -318,7 +318,6 @@         GLUT.MouseButton GLUT.WheelUp              -> MouseButton WheelUp         GLUT.MouseButton GLUT.WheelDown            -> MouseButton WheelDown         GLUT.MouseButton (GLUT.AdditionalButton i) -> MouseButton (AdditionalButton i)-  -- | Convert GLUTs key states to our internal ones. glutKeyStateToKeyState :: GLUT.KeyState -> KeyState

@@ -1,7 +1,6 @@  module Graphics.Gloss.Internals.Interface.Display-	( display-	, displayWithBackend)+	(displayWithBackend) where	 import Graphics.Gloss.Data.Color import Graphics.Gloss.Data.Picture@@ -20,26 +19,7 @@  import Data.IORef --- | Open a new window and display the given picture.------   Use the following commands once the window is open:------ 	* Quit - esc-key.------	* Move Viewport - left-click drag, arrow keys.------	* Rotate Viewport - right-click drag, control-left-click drag, or home\/end-keys.------	* Zoom Viewport - mouse wheel, or page up\/down-keys.----display :: Display          -- ^ Display mode.-	-> Color            -- ^ Background color.-	-> Picture          -- ^ The picture to draw.-	-> IO () -display = displayWithBackend defaultBackendState-- displayWithBackend 	:: Backend a 	=> a                -- ^ Initial state of the backend.@@ -65,10 +45,6 @@  	let callbacks 	     =	[ Callback.Display renderFun --		-- Delay the thread for a bit to give the runtime-		--	a chance to switch back to the OS.-		, Callback.Idle	   (\stateRef -> sleep stateRef 0.001 >> postRedisplay stateRef)  		-- Escape exits the program 		, callback_exit () 

@@ -1,8 +1,7 @@ {-# LANGUAGE RankNTypes #-}  module Graphics.Gloss.Internals.Interface.Game-	( play-	, playWithBackend+	( playWithBackendIO 	, Event(..)) where import Graphics.Gloss.Data.Color@@ -29,21 +28,8 @@ 	| EventMotion (Float, Float) 	deriving (Eq, Show) --- | Play a game in a window. -play    :: forall world-        .  Display                      -- ^ Display mode.-        -> Color                        -- ^ Background color.-	-> Int				-- ^ Number of simulation steps to take for each second of real time.-	-> world 			-- ^ The initial world.-	-> (world -> Picture)	 	-- ^ A function to convert the world a picture.-	-> (Event -> world -> world)	-- ^ A function to handle input events.-	-> (Float -> world -> world)   	-- ^ A function to step the world one iteration.-					--   It is passed the period of time (in seconds) needing to be advanced.-	-> IO () -play    = playWithBackend defaultBackendState--playWithBackend+playWithBackendIO 	:: forall world a 	.  Backend a 	=> a				-- ^ Initial state of the backend@@ -51,13 +37,13 @@ 	-> Color			-- ^ Background color. 	-> Int				-- ^ Number of simulation steps to take for each second of real time. 	-> world 			-- ^ The initial world.-	-> (world -> Picture)	 	-- ^ A function to convert the world a picture.-	-> (Event -> world -> world)	-- ^ A function to handle input events.-	-> (Float -> world -> world)   	-- ^ A function to step the world one iteration.+	-> (world -> IO Picture)	-- ^ A function to convert the world to a picture.+	-> (Event -> world -> IO world)	-- ^ A function to handle input events.+	-> (Float -> world -> IO world)	-- ^ A function to step the world one iteration. 					--   It is passed the period of time (in seconds) needing to be advanced. 	-> IO () -playWithBackend+playWithBackendIO 	backend         display 	backgroundColor@@ -85,7 +71,7 @@ 	     = do 		-- convert the world to a picture 		world		<- readIORef worldSR-		let picture	= worldToPicture world+		picture		<- worldToPicture world 	 		-- display the picture in the current view 		renderS		<- readIORef renderSR@@ -120,7 +106,7 @@ callback_keyMouse  	:: IORef world	 		-- ^ ref to world state 	-> IORef ViewPort-	-> (Event -> world -> world)	-- ^ fn to handle input events+	-> (Event -> world -> IO world)	-- ^ fn to handle input events 	-> Callback  callback_keyMouse worldRef viewRef eventFn@@ -130,18 +116,20 @@ handle_keyMouse  	:: IORef a 	-> t-	-> (Event -> a -> a)+	-> (Event -> a -> IO a) 	-> KeyboardMouseCallback  handle_keyMouse worldRef _ eventFn backendRef key keyState keyMods pos- = do	pos' <- convertPoint backendRef pos-	worldRef `modifyIORef` \world -> eventFn (EventKey key keyState keyMods pos') world+ = do	pos'       <- convertPoint backendRef pos+        world      <- readIORef worldRef+        world'     <- eventFn (EventKey key keyState keyMods pos') world+        writeIORef worldRef world'   -- | Callback for Motion events. callback_motion 	:: IORef world	 		-- ^ ref to world state-	-> (Event -> world -> world)	-- ^ fn to handle input events+	-> (Event -> world -> IO world)	-- ^ fn to handle input events 	-> Callback  callback_motion worldRef eventFn@@ -150,12 +138,14 @@  handle_motion  	:: IORef a-	-> (Event -> a -> a)+	-> (Event -> a -> IO a) 	-> MotionCallback  handle_motion worldRef eventFn backendRef pos- = do pos' <- convertPoint backendRef pos-      worldRef `modifyIORef` \world -> eventFn (EventMotion pos') world+ = do   pos'     <- convertPoint backendRef pos+        world    <- readIORef worldRef+        world'   <- eventFn (EventMotion pos') world+        writeIORef worldRef world'   convertPoint ::

@@ -1,8 +1,7 @@ {-# LANGUAGE RankNTypes #-}  module Graphics.Gloss.Internals.Interface.Simulate-	( simulate-	, simulateWithBackend)+	(simulateWithBackendIO) where import Graphics.Gloss.Data.Display import Graphics.Gloss.Data.Color@@ -26,26 +25,8 @@ import Data.IORef import System.Mem --- | Run a finite-time-step simulation in a window. You decide how the model is represented,---	how to convert the model to a picture, and how to advance the model for each unit of time. ---	This function does the rest.------   Once the window is open you can use the same commands as with @display@.----simulate :: forall model-        .  Display                      -- ^ Display mode.-	-> Color			-- ^ Background color.-	-> Int				-- ^ Number of simulation steps to take for each second of real time.-	-> model 			-- ^ The initial model.-	-> (model -> Picture)	 	-- ^ A function to convert the model to a picture.-	-> (ViewPort -> Float -> model -> model) -- ^ A function to step the model one iteration. It is passed the -						 --	current viewport and the amount of time for this simulation-						 --     step (in seconds).-	-> IO () -simulate = simulateWithBackend defaultBackendState--simulateWithBackend+simulateWithBackendIO 	:: forall model a 	.  Backend a 	=> a				-- ^ Initial state of the backend@@ -53,13 +34,13 @@ 	-> Color			-- ^ Background color. 	-> Int				-- ^ Number of simulation steps to take for each second of real time. 	-> model 			-- ^ The initial model.-	-> (model -> Picture)	 	-- ^ A function to convert the model to a picture.-	-> (ViewPort -> Float -> model -> model) -- ^ A function to step the model one iteration. It is passed the+	-> (model -> IO Picture)	 	-- ^ A function to convert the model to a picture.+	-> (ViewPort -> Float -> model -> IO model) -- ^ A function to step the model one iteration. It is passed the 						 --	current viewport and the amount of time for this simulation 						 --     step (in seconds). 	-> IO () -simulateWithBackend+simulateWithBackendIO 	backend         display 	backgroundColor@@ -87,7 +68,7 @@ 	     = do 		-- convert the world to a picture 		world		<- readIORef worldSR-		let picture	= worldToPicture world+		picture	        <- worldToPicture world 	 		-- display the picture in the current view 		renderS		<- readIORef renderSR

@@ -21,7 +21,7 @@ 	-> IORef ViewPort				-- ^ the viewport state 	-> IORef world					-- ^ the current world 	-> world					-- ^ the initial world-	-> (ViewPort -> Float -> world -> world) 	-- ^ fn to advance the world+	-> (ViewPort -> Float -> world -> IO world) 	-- ^ fn to advance the world 	-> Float					-- ^ how much time to advance world by  							--	in single step mode 	-> IdleCallback@@ -64,7 +64,7 @@ 	-> IORef AN.State 	-> IORef ViewPort 	-> IORef world-	-> (ViewPort -> Float -> world -> world)+	-> (ViewPort -> Float -> world -> IO world) 	-> IdleCallback 	 simulate_run simSR _ viewSR worldSR worldAdvance backendRef@@ -103,11 +103,10 @@ 	let nFinal 	= nStart + thisSteps  	-- keep advancing the world until we get to the final iteration number-	let (_, world')	= -		until 	(\(n, _) 	-> n >= nFinal)-			(\(n, w)	-> (n+1, worldAdvance viewS timePerStep w))-			(nStart, worldS)-	+	(_,world') <- untilM 	(\(n, _) 	-> n >= nFinal)+				(\(n, w)	-> liftM (\w' -> (n+1,w')) ( worldAdvance viewS timePerStep w))+				(nStart, worldS)+ 	-- write the world back into its IORef 	-- We need to seq on the world to avoid space leaks when the window is not showing. 	world' `seq` writeIORef worldSR world'@@ -127,7 +126,7 @@ 	:: IORef SM.State 	-> IORef ViewPort 	-> IORef world-	-> (ViewPort -> Float -> world -> world) +	-> (ViewPort -> Float -> world -> IO world)  	-> Float 	-> IdleCallback @@ -135,7 +134,7 @@  = do 	viewS		<- readIORef viewSR  	world		<- readIORef worldSR-	let world'	= worldAdvance viewS singleStepTime world+	world'		<- worldAdvance viewS singleStepTime world 	 	writeIORef worldSR world' 	simSR `modifyIORef` \c -> c 	@@ -148,3 +147,10 @@ getsIORef :: IORef a -> (a -> r) -> IO r getsIORef ref fun  = liftM fun $ readIORef ref++untilM :: (Monad m) => (a -> Bool) -> (a -> m a) -> a -> m a+untilM test op i = go i+  where+  go x | test x    = return x+       | otherwise = op x >>= go+	

@@ -11,7 +11,7 @@ import Foreign  --- | Abstract bitmap data.+-- | Abstract 32-bit RGBA bitmap data. data BitmapData          = BitmapData                  Int                     -- length (in bytes)

@@ -2,90 +2,245 @@ {-# OPTIONS_HADDOCK hide #-}  -- | Fast(ish) rendering of circles.-module Graphics.Gloss.Internals.Render.Circle  where-+module Graphics.Gloss.Internals.Render.Circle+        ( renderCircle+        , renderArc)+where import 	Graphics.Gloss.Internals.Render.Common+import  Graphics.Gloss.Geometry.Angle import	qualified Graphics.Rendering.OpenGL.GL		as GL import	GHC.Exts --- | Render a circle with the given thickness-renderCircle :: Float -> Float -> Float -> Float -> Float -> IO ()-renderCircle posX posY scaleFactor radius thickness- 	| radScreen	<- scaleFactor * radius-	, steps		<- circleSteps (2 * radScreen)-	= if thickness == 0 -		then renderCircleLine posX posY steps radius-		else renderCircleStrip posX posY steps radius thickness ---- | Decide how many line segments to use to render the circle+-- | 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.+--+{-# INLINE circleSteps #-} circleSteps :: Float -> Int circleSteps sDiam-	| sDiam < 1	= 1-	| sDiam < 2	= 4-	| sDiam < 10	= 8-	| sDiam < 20	= 16-	| sDiam < 30	= 32-	| otherwise	= 40+        | sDiam < 8     = 8+        | sDiam < 16    = 16+        | sDiam < 32    = 32+        | otherwise     = 64  -renderCircleLine_step :: Float# -> Float# -> Float# -> Float# -> Float# -> Float# -> IO ()-renderCircleLine_step posX posY tStep tStop rad tt-	| tt `geFloat#` tStop-	= return ()-	-	| otherwise-	= do	GL.vertex -		 $ GL.Vertex2 -			(gf $ F# (posX `plusFloat#` (rad `timesFloat#` (cosFloat# tt))))-			(gf $ F# (posY `plusFloat#` (rad `timesFloat#` (sinFloat# tt))))+-- Circle ---------------------------------------------------------------------+-- | Render a circle with the given thickness+renderCircle :: Float -> Float -> Float -> Float -> Float -> IO ()+renderCircle posX posY scaleFactor radius_ thickness_+ = go (abs radius_) (abs thickness_)+ where go radius thickness -		renderCircleLine_step posX posY tStep tStop rad (tt `plusFloat#` tStep)+        -- If the circle is smaller than a pixel, render it as a point.+        | thickness     == 0+        , radScreen     <- scaleFactor * (radius + thickness / 2)+        , radScreen     <= 1+        = GL.renderPrimitive GL.Points+            $ GL.vertex $ GL.Vertex2 (gf posX) (gf posY) +        -- Render zero thickness circles with lines.+        | thickness == 0+        , radScreen	<- scaleFactor * radius+	, steps		<- circleSteps radScreen+        = renderCircleLine  posX posY steps radius++        -- Some thick circle.+        | radScreen     <- scaleFactor * (radius + thickness / 2)+        , steps         <- circleSteps radScreen+        = renderCircleStrip posX posY steps radius thickness++ -- | Render a circle as a line. renderCircleLine :: Float -> Float -> Int -> Float -> IO () renderCircleLine (F# posX) (F# posY) steps (F# rad)- = let 	n		= fromIntegral steps-	!(F# tStep)	= (2 * pi) / n-	!(F# tStop)	= (2 * pi)+ = let  n               = fromIntegral steps+        !(F# tStep)     = (2 * pi) / n+        !(F# tStop)     = (2 * pi) -   in	GL.renderPrimitive GL.LineLoop-   		$ renderCircleLine_step posX posY tStep tStop rad 0.0#+   in   GL.renderPrimitive GL.LineLoop+         $ renderCircleLine_step posX posY tStep tStop rad 0.0#+{-# INLINE renderCircleLine #-}   -- | Render a circle with a given thickness as a triangle strip renderCircleStrip :: Float -> Float -> Int -> Float -> Float -> IO () renderCircleStrip (F# posX) (F# posY) steps r width- = let	n		= fromIntegral steps+ = let  n               = fromIntegral steps+        !(F# tStep)     = (2 * pi) / n+        !(F# tStop)     = (2 * pi) + (F# tStep) / 2+        !(F# r1)        = r - width / 2+        !(F# r2)        = r + width / 2++   in   GL.renderPrimitive GL.TriangleStrip+         $ renderCircleStrip_step posX posY tStep tStop r1 0.0# r2 +                (tStep `divideFloat#` 2.0#)+{-# INLINE renderCircleStrip #-}+++-- Arc ------------------------------------------------------------------------+-- | Render an arc with the given thickness.+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++        -- Render zero thickness arcs with lines.+        | thickness == 0+        , radScreen     <- scaleFactor * radius+        , steps         <- circleSteps radScreen+        = renderArcLine posX posY steps radius a1 a2++        -- Some thick arc.+        | 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+ = let 	n		= fromIntegral steps 	!(F# tStep)	= (2 * pi) / n-	!(F# tStop)	= (2 * pi) + (F# tStep) / 2-	!(F# r1)	= r - width / 2-	!(F# r2)	= r + width / 2+        !(F# tStart)    = degToRad a1+	!(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+                endVertex+{-# INLINE renderArcLine #-}+++-- | 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+        tStep           = (2 * pi) / n++        t1              = normaliseAngle $ degToRad a1+        t2              = normaliseAngle $ degToRad a2+        (tStart, tStop) = if t1 <= t2 then (t1, t2) else (t2, t1)+        tDiff           = tStop - tStart+        tMid            = tStart + tDiff / 2++ 	!(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+                    in	GL.renderPrimitive GL.TriangleStrip-   		$ renderCircleStrip_step posX posY tStep tStop r1 0.0# r2 -			(tStep `divideFloat#` 2.0#)-   +   	 $ 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+                        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'+                                (tStart' `plusFloat#` tStep2')++                        -- end vectors+                        addPointOnCircle posX posY r1' tStop'+                        addPointOnCircle posX posY r2' tStop'+{-# INLINE renderArcStrip #-}+++-- Step functions -------------------------------------------------------------+renderCircleLine_step+        :: Float# -> Float#+        -> Float# -> Float#+        -> Float# -> Float# +        -> IO ()++renderCircleLine_step posX posY tStep tStop rad tt+        | tt `geFloat#` tStop+        = return ()+        +        | otherwise+        = do    addPointOnCircle posX posY rad tt+                renderCircleLine_step posX posY tStep tStop rad +                        (tt `plusFloat#` tStep)+{-# INLINE renderCircleLine_step #-}++ renderCircleStrip_step  	:: Float# -> Float#  	-> Float# -> Float# -	-> Float# -> Float# -> Float# -> Float# -> IO ()+	-> Float# -> Float#+        -> Float# -> Float# -> IO ()  renderCircleStrip_step posX posY tStep tStop r1 t1 r2 t2 	| t1 `geFloat#` tStop 	= return () 	 	| otherwise-	= do	GL.vertex -	 	 $ GL.Vertex2 -			(gf $ F# (posX `plusFloat#` (r1 `timesFloat#` (cosFloat# t1)))) -			(gf $ F# (posY `plusFloat#` (r1 `timesFloat#` (sinFloat# t1))))--		GL.vertex -		 $ GL.Vertex2 -			(gf $ F# (posX `plusFloat#` (r2 `timesFloat#` (cosFloat# t2))))-			(gf $ F# (posY `plusFloat#` (r2 `timesFloat#` (sinFloat# t2))))-		+	= 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)-	+{-# INLINE renderCircleStrip_step #-}+++addPoint :: Float# -> Float# -> IO ()+addPoint x y =+  GL.vertex $ GL.Vertex2 (gf (F# x)) (gf (F# y))+{-# INLINE addPoint #-}+++addPointOnCircle :: Float# -> Float# -> Float# -> Float# -> IO ()+addPointOnCircle posX posY rad tt =+  addPoint+    (posX `plusFloat#` (rad `timesFloat#` (cosFloat# tt)))+    (posY `plusFloat#` (rad `timesFloat#` (sinFloat# tt)))+{-# INLINE addPointOnCircle #-}++++{- Unused sector drawing code.+   Sectors are currently drawn as compound Pictures,+   but we might want this if we end up implementing the ThickSector +   version as well.++-- | Render a sector as a line.+renderSectorLine :: Float -> Float -> Int -> Float -> Float -> Float -> IO ()+renderSectorLine pX@(F# posX) pY@(F# posY) steps (F# rad) a1 a2+ = 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++        -- need to set up the edges of the start/end triangles+        startVertex     = GL.vertex $ GL.Vertex2 (gf pX) (gf pY)+        endVertex       = addPointOnCircle posX posY rad tStop++   in   GL.renderPrimitive GL.LineLoop+         $ do   startVertex+                renderCircleLine_step posX posY tStep tStop rad tStart+                endVertex++-- | Render a sector.+renderSector :: Float -> Float -> Float -> Float -> Float -> Float -> IO ()+renderSector posX posY scaleFactor radius a1 a2+        | radScreen     <- scaleFactor * radius+        , steps         <- circleSteps (2 * radScreen)+        = renderSectorLine posX posY steps radius a1 a2+-}+

@@ -3,27 +3,27 @@ {-# LANGUAGE ImplicitParams, ScopedTypeVariables #-}  module Graphics.Gloss.Internals.Render.Picture-	( renderPicture )+	(renderPicture) where-import	Graphics.Gloss.Data.Picture-import	Graphics.Gloss.Data.Color-import	Graphics.Gloss.Internals.Interface.Backend-import	Graphics.Gloss.Internals.Interface.ViewPort-import	Graphics.Gloss.Internals.Render.State-import	Graphics.Gloss.Internals.Render.Common-import	Graphics.Gloss.Internals.Render.Circle-import	Graphics.Gloss.Internals.Render.Bitmap-import  System.Mem.StableName-import  Foreign.ForeignPtr-import	Data.IORef-import  Data.List-import  Control.Monad-import	Graphics.Rendering.OpenGL		(($=), get)-import	qualified Graphics.Rendering.OpenGL.GL	as GL-import	qualified Graphics.UI.GLUT		as GLUT+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import Graphics.Gloss.Internals.Interface.Backend+import Graphics.Gloss.Internals.Interface.ViewPort+import Graphics.Gloss.Internals.Render.State+import Graphics.Gloss.Internals.Render.Common+import Graphics.Gloss.Internals.Render.Circle+import Graphics.Gloss.Internals.Render.Bitmap+import System.Mem.StableName+import Foreign.ForeignPtr+import Data.IORef+import Data.List+import Control.Monad+import Graphics.Rendering.OpenGL		(($=), get)+import qualified Graphics.Rendering.OpenGL.GL	as GL+import qualified Graphics.UI.GLUT		as GLUT  --- ^ Render a picture using the given render options and viewport.+-- | Render a picture using the given render options and viewport. renderPicture 	:: forall a . Backend a 	=> IORef a@@ -41,7 +41,7 @@ 	-- This GL state doesn't change during rendering,  	--	so we can just read it once here 	(matProj_  :: GL.GLmatrix GL.GLdouble)	-			<- get $ GL.matrix (Just $ GL.Projection)+			<- get $ GL.matrix (Just GL.Projection) 	viewport_  	<- get $ GL.viewport 	windowSize_	<- getWindowDimensions backendRef @@ -57,8 +57,9 @@ 	setLineSmooth	(stateLineSmooth renderS) 	setBlendAlpha	(stateBlendAlpha renderS) 	-	drawPicture (viewPortScale viewS) picture+        drawPicture (viewPortScale viewS) picture + drawPicture 	:: ( ?modeWireframe     :: Bool 	   , ?modeColor         :: Bool@@ -96,6 +97,13 @@ 	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.@@ -108,8 +116,7 @@ 	-- colors with float components. 	Color col p 	 |  ?modeColor-	 ->  {-# SCC "draw.color" #-}-   	     do	oldColor 	 <- get GL.currentColor+	 ->  do	oldColor 	 <- get GL.currentColor  		let (r, g, b, a) = rgbaOfColor col @@ -121,39 +128,61 @@ 	 -> 	drawPicture circScale p  -	-- ease up on GL.preservingMatrix-	--	This is an important optimisation for the Eden example,-	--	as it draws lots of translated circles.+        -- 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 (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 (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))+		GL.rotate    (gf deg) (GL.Vector3 0 0 (-1)) 		drawPicture circScale p -	----- 	Translate tx ty	p 	 -> GL.preservingMatrix 	  $ do	GL.translate (GL.Vector3 (gf tx) (gf ty) 0) 		drawPicture circScale p ++        -- Rotation -----------------------------+        -- Easy rotations are done directly to avoid calling GL.perserveMatrix.+        Rotate _   (Circle radius)+         -> renderCircle   0 0 circScale radius 0++        Rotate _   (ThickCircle radius thickness)+         -> renderCircle   0 0 circScale radius thickness++        Rotate deg (Arc a1 a2 radius)+         -> renderArc      0 0 circScale radius (a1-deg) (a2-deg) 0++        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)) 		drawPicture circScale p ++        -- Scale -------------------------------- 	Scale sx sy p 	 -> GL.preservingMatrix 	  $ do	GL.scale (gf sx) (gf sy) 1 		let mscale	= max sx sy 		drawPicture (circScale * mscale) p 			-	-----+	-- Bitmap ------------------------------- 	Bitmap width height imgData cacheMe 	 -> do	                 -- Load the image data into a texture,@@ -177,7 +206,7 @@ 		 		-- Draw textured polygon 		GL.renderPrimitive GL.Polygon-		 $ do zipWithM_+		 $ zipWithM_ 		        (\(pX, pY) (tX, tY) 			  -> do GL.texCoord $ GL.TexCoord2 (gf tX) (gf tY) 		           	GL.vertex   $ GL.Vertex2   (gf pX) (gf pY))@@ -214,7 +243,7 @@                 = find (\tex -> texName   tex == name                              && texWidth  tex == width                              && texHeight tex == height)-                $ textures+                textures                          case mTexCached of          Just tex

@@ -1,4 +1,4 @@-Copyright (c) 2010-2011 Benjamin Lippmeier +Copyright (c) 2010-2012 Benjamin Lippmeier    Permission is hereby granted, free of charge, to any person  obtaining a copy of this software and associated documentation

@@ -1,5 +1,5 @@ Name:                gloss-Version:             1.6.2.1+Version:             1.7.0.1 License:             MIT License-file:        LICENSE Author:              Ben Lippmeier@@ -59,10 +59,13 @@         Graphics.Gloss.Data.Color         Graphics.Gloss.Data.Picture         Graphics.Gloss.Algorithms.RayCast-        Graphics.Gloss.Interface.Display-        Graphics.Gloss.Interface.Animate-        Graphics.Gloss.Interface.Simulate-        Graphics.Gloss.Interface.Game+        Graphics.Gloss.Interface.Pure.Display+        Graphics.Gloss.Interface.Pure.Animate+        Graphics.Gloss.Interface.Pure.Simulate+        Graphics.Gloss.Interface.Pure.Game+        Graphics.Gloss.Interface.IO.Animate+        Graphics.Gloss.Interface.IO.Simulate+        Graphics.Gloss.Interface.IO.Game    Other-modules:         Graphics.Gloss.Internals.Color