gloss 1.9.1.1 → 1.9.2.1

raw patch · 22 files changed

+1117/−280 lines, 22 filesdep ~gloss-renderingPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: gloss-rendering

API changes (from Hackage documentation)

Files

• Graphics/Gloss.hs +3/−1
• Graphics/Gloss/Algorithms/RayCast.hs +0/−82
• Graphics/Gloss/Data/Bitmap.hs +11/−0
• Graphics/Gloss/Data/Color.hs +137/−0
• Graphics/Gloss/Data/Display.hs +13/−0
• Graphics/Gloss/Data/Picture.hs +187/−0
• Graphics/Gloss/Data/Point.hs +31/−0
• Graphics/Gloss/Data/Vector.hs +88/−0
• Graphics/Gloss/Data/ViewPort.hs +75/−0
• Graphics/Gloss/Data/ViewState.hs +1/−4
• Graphics/Gloss/Geometry/Angle.hs +25/−0
• Graphics/Gloss/Geometry/Line.hs +325/−0
• Graphics/Gloss/Interface/IO/Simulate.hs +1/−1
• Graphics/Gloss/Interface/Pure/Animate.hs +1/−1
• Graphics/Gloss/Interface/Pure/Display.hs +0/−3
• Graphics/Gloss/Interface/Pure/Game.hs +11/−10
• Graphics/Gloss/Interface/Pure/Simulate.hs +12/−10
• Graphics/Gloss/Internals/Interface/Animate.hs +10/−7
• Graphics/Gloss/Internals/Interface/Display.hs +17/−10
• Graphics/Gloss/Internals/Interface/Game.hs +90/−85
• Graphics/Gloss/Internals/Interface/Simulate.hs +68/−63
• gloss.cabal +11/−3

@@ -51,7 +51,7 @@ --   Thanks to Doug Burke --   * Primitives for drawing arcs and sectors. --   Thanks to Thomas DuBuisson---   * IO versions of animate, simplate and play.+--   * IO versions of animate, simulate and play. -- -- For 1.6: --   Thanks to Anthony Cowley@@ -68,6 +68,7 @@ module Graphics.Gloss  	( module Graphics.Gloss.Data.Picture 	, module Graphics.Gloss.Data.Color+        , module Graphics.Gloss.Data.Bitmap         , Display(..) 	, display 	, animate@@ -77,6 +78,7 @@ import Graphics.Gloss.Data.Display import Graphics.Gloss.Data.Picture import Graphics.Gloss.Data.Color+import Graphics.Gloss.Data.Bitmap import Graphics.Gloss.Interface.Pure.Display import Graphics.Gloss.Interface.Pure.Animate import Graphics.Gloss.Interface.Pure.Simulate

@@ -1,82 +0,0 @@-{-# LANGUAGE PatternGuards, RankNTypes #-}---- | Various ray casting algorithms.-module Graphics.Gloss.Algorithms.RayCast-	( castSegIntoCellularQuadTree-	, traceSegIntoCellularQuadTree)-where-import Graphics.Gloss.Data.Picture-import Graphics.Gloss.Data.Quad-import Graphics.Gloss.Data.Extent-import Graphics.Gloss.Data.QuadTree-import Data.List-import Data.Function----- | The quadtree contains cells of unit extent (NetHack style).---   Given a line segement (P1-P2) through the tree, get the cell ---   closest to P1 that intersects the segment, if any.---   ---   TODO: This currently uses a naive algorithm. It just calls ---         `traceSegIntoCellularQuadTree` and sorts the results---         to get the one closest to P1. It'd be better to do a ---         proper walk over the tree in the direction of the ray.---         -castSegIntoCellularQuadTree -	:: forall a-	.  Point 			-- ^ (P1) Starting point of seg.-	-> Point 			-- ^ (P2) Final point of seg.-	-> Extent 			-- ^ Extent convering the whole tree.-	-> QuadTree a 			-- ^ The tree.-	-> Maybe (Point, Extent, a)	-- ^ Intersection point, extent of cell, value of cell (if any).--castSegIntoCellularQuadTree p1 p2 extent tree-	| cells@(_:_)	<- traceSegIntoCellularQuadTree p1 p2 extent tree-	, c : _		<- sortBy ((compareDistanceTo p1) `on` (\(a, _, _) -> a) ) cells-	= Just c-	-	| otherwise-	= Nothing-	-compareDistanceTo :: Point -> Point -> Point -> Ordering-compareDistanceTo p0 p1 p2- = let	d1	= distance p0 p1-	d2	= distance p0 p2-   in	compare d1 d2--distance :: Point -> Point -> Float-distance (x1, y1) (x2, y2)	- = let	xd	= x2 - x1-	yd	= y2 - y1-   in	sqrt (xd * xd + yd * yd)----- | The quadtree contains cells of unit extent (NetHack style).---   Given a line segment (P1-P2) through the tree, return the list of cells ---   that intersect the segment.---  -traceSegIntoCellularQuadTree 	-	:: forall a-	.  Point 			-- ^ (P1) Starting point of seg.-	-> Point 			-- ^ (P2) Final point of seg.-	-> Extent 			-- ^ Extent covering the whole tree.-	-> QuadTree a 			-- ^ The tree.-	-> [(Point, Extent, a)]		-- ^ Intersection point, extent of cell, value of cell.-	-traceSegIntoCellularQuadTree p1 p2 extent tree - = case tree of-	TNil	-> []-	TLeaf a-	 -> case intersectSegExtent p1 p2 extent of-		Just pos	-> [(pos, extent, a)]-		Nothing		-> []-					-	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 ]-	-	_ -> []

@@ -0,0 +1,11 @@++-- | Functions to load bitmap data from various places.+module Graphics.Gloss.Data.Bitmap+        ( BitmapData+        , bitmapOfForeignPtr+        , bitmapOfByteString+        , bitmapOfBMP+        , loadBMP)+where+import Graphics.Gloss.Rendering+

@@ -0,0 +1,137 @@++-- | Predefined and custom colors.+module Graphics.Gloss.Data.Color+	( -- ** Color data type+	  Color+        , makeColor+        , makeColorI+        , rgbaOfColor++  	  -- ** Color functions+	, mixColors+	, addColors+	, dim,   bright+	, light, dark++	  -- ** Pre-defined colors+	, greyN,  black,  white++	  -- *** Primary+	, red,    green,  blue++	  -- *** Secondary+	, yellow,     cyan,       magenta+	+	  -- *** Tertiary+	, rose,   violet, azure, aquamarine, chartreuse, orange+	)+where+import Graphics.Gloss.Rendering+++-- | Normalise a color to the value of its largest RGB component.+normalizeColor :: Color -> Color+normalizeColor cc+ = let  (r, g, b, a)    = rgbaOfColor cc+        m               = maximum [r, g, b]+   in   makeColor (r / m) (g / m) (b / m) a+++-- Color functions ------------------------------------------------------------++-- | Mix two colors with the given ratios.+mixColors +	:: Float 	-- ^ Ratio of first color.+	-> Float 	-- ^ Ratio of second color.+	-> Color 	-- ^ First color.+	-> Color 	-- ^ Second color.+	-> Color	-- ^ Resulting color.++mixColors ratio1 ratio2 c1 c2+ = let	(r1, g1, b1, a1) = rgbaOfColor c1+	(r2, g2, b2, a2) = rgbaOfColor c2++	total	= ratio1 + ratio2+	m1	= ratio1 / total+	m2	= ratio2 / total++   in	makeColor +                (m1 * r1 + m2 * r2)+		(m1 * g1 + m2 * g2)+		(m1 * b1 + m2 * b2)+		(m1 * a1 + m2 * a2)+++-- | Add RGB components of a color component-wise, then normalise+--	them to the highest resulting one. The alpha components are averaged.+addColors :: Color -> Color -> Color+addColors c1 c2+ = let	(r1, g1, b1, a1) = rgbaOfColor c1+	(r2, g2, b2, a2) = rgbaOfColor c2++   in	normalizeColor +	 $ makeColor +                (r1 + r2)+		(g1 + g2)+		(b1 + b2)+		((a1 + a2) / 2)+++-- | Make a dimmer version of a color, scaling towards black.+dim :: Color -> Color+dim c+ = let  (r, g, b, a)    = rgbaOfColor c+   in   makeColor (r / 1.2) (g / 1.2) (b / 1.2) a++	+-- | Make a brighter version of a color, scaling towards white.+bright :: Color -> Color+bright c+ = let  (r, g, b, a)    = rgbaOfColor c+   in   makeColor (r * 1.2) (g * 1.2) (b * 1.2) a+++-- | Lighten a color, adding white.+light :: Color -> Color+light c+ = let  (r, g, b, a)    = rgbaOfColor c+   in   makeColor (r + 0.2) (g + 0.2) (b + 0.2) a+	+	+-- | Darken a color, adding black.+dark :: Color -> Color+dark c+ = let  (r, g, b, a)    = rgbaOfColor c+   in   makeColor (r - 0.2) (g - 0.2) (b - 0.2) a+++-- Pre-defined Colors ---------------------------------------------------------+-- | A greyness of a given order.+greyN 	:: Float 	-- ^ Range is 0 = black, to 1 = white.+	-> Color+greyN n		= makeRawColor n   n   n   1.0++black, white :: Color+black		= makeRawColor 0.0 0.0 0.0 1.0+white		= makeRawColor 1.0 1.0 1.0 1.0++-- Colors from the additive color wheel.+red, green, blue :: Color+red		= makeRawColor 1.0 0.0 0.0 1.0+green		= makeRawColor 0.0 1.0 0.0 1.0+blue		= makeRawColor 0.0 0.0 1.0 1.0++-- secondary+yellow, cyan, magenta :: Color+yellow		= addColors red   green+cyan		= addColors green blue+magenta		= addColors red   blue++-- tertiary+rose, violet, azure, aquamarine, chartreuse, orange :: Color+rose		= addColors red     magenta+violet		= addColors magenta blue+azure		= addColors blue    cyan+aquamarine	= addColors cyan    green+chartreuse	= addColors green   yellow+orange		= addColors yellow  red

@@ -0,0 +1,13 @@++module Graphics.Gloss.Data.Display+        (Display(..))+where++-- | Describes how Gloss should display its output.+data Display+        -- | Display in a window with the given name, size and position.+        = InWindow   String (Int, Int) (Int, Int)++        -- | Display full screen with a drawing area of the given size.+        | FullScreen (Int, Int) +        deriving (Eq, Read, Show)

@@ -0,0 +1,187 @@++module Graphics.Gloss.Data.Picture+        ( Picture       (..)+        , Point, Vector, Path++        -- * Aliases for Picture constructors+        , 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)+where+import Graphics.Gloss.Rendering+import Graphics.Gloss.Geometry.Angle+++-- 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++-- | A circle with the given radius.+circle  :: Float  -> Picture+circle  = Circle++-- | 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++-- | 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++-- | A picture rotated clockwise by the given angle (in degrees).+rotate  :: Float -> Picture -> Picture+rotate = Rotate++-- | 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+++-- Other Shapes ---------------------------------------------------------------+-- | A closed loop along a path.+lineLoop :: Path -> Picture+lineLoop []     = Line []+lineLoop (x:xs) = Line ((x:xs) ++ [x])+++-- 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.+rectangleWire :: Float -> Float -> Picture+rectangleWire sizeX sizeY+        = lineLoop $ rectanglePath sizeX sizeY+++-- | 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.+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.+rectangleSolid :: Float -> Float -> Picture+rectangleSolid sizeX sizeY+        = Polygon $ rectanglePath sizeX sizeY+++-- | A solid rectangle in the y > 0 half of the x-y plane.+rectangleUpperSolid :: Float -> Float -> Picture+rectangleUpperSolid sizeX sizeY+        = Polygon  $ rectangleUpperPath sizeX sizeY+

@@ -0,0 +1,31 @@+{-# OPTIONS -fno-warn-missing-methods -fno-warn-orphans #-}+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}+module Graphics.Gloss.Data.Point+	( Point, Path+	, pointInBox)+where+import Graphics.Gloss.Data.Picture+++-- | Test whether a point lies within a rectangular box that is oriented+--   on the x-y plane. The points P1-P2 are opposing points of the box,+--   but need not be in a particular order.+--+-- @+--    P2 +-------++--       |       |+--       | + P0  |+--       |       |+--       +-------+ P1+-- @+--+pointInBox +	:: Point +	-> Point +	-> Point -> Bool+	+pointInBox (x0, y0) (x1, y1) (x2, y2)+ 	=  x0 >= min x1 x2+ 	&& x0 <= max x1 x2+	&& y0 >= min y1 y2+	&& y0 <= max y1 y2

@@ -0,0 +1,88 @@+{-# OPTIONS -fno-warn-missing-methods #-}+{-# LANGUAGE TypeSynonymInstances #-}++-- | Geometric functions concerning vectors.+module Graphics.Gloss.Data.Vector+	( Vector+	, magV+	, argV+	, dotV+	, detV+	, mulSV+	, rotateV+	, angleVV+	, normalizeV+	, unitVectorAtAngle )+where+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Geometry.Angle+++-- | The magnitude of a vector.+magV :: Vector -> Float+magV (x, y) 	+	= sqrt (x * x + y * y)+{-# INLINE magV #-}+++-- | The angle of this vector, relative to the +ve x-axis.+argV :: Vector -> Float+argV (x, y)+	= normalizeAngle $ atan2 y x+{-# INLINE argV #-}+++-- | The dot product of two vectors.+dotV :: Vector -> Vector -> Float+dotV (x1, x2) (y1, y2)+	= x1 * y1 + x2 * y2+{-# INLINE dotV #-}+++-- | The determinant of two vectors.+detV :: Vector -> Vector -> Float+detV (x1, y1) (x2, y2)+	= x1 * y2 - y1 * x2+{-# INLINE detV #-}+++-- | Multiply a vector by a scalar.+mulSV :: Float -> Vector -> Vector+mulSV s (x, y)		+	= (s * x, s * y)+{-# INLINE mulSV #-}+++-- | Rotate a vector by an angle (in radians). +ve angle is counter-clockwise.+rotateV :: Float -> Vector -> Vector+rotateV r (x, y)+ = 	(  x * cos r - y * sin r+        ,  x * sin r + y * cos r)+{-# INLINE rotateV #-}+++-- | Compute the inner angle (in radians) between two vectors.+angleVV :: Vector -> Vector -> Float+angleVV p1 p2+ = let 	m1	= magV p1+ 	m2	= magV p2+	d	= p1 `dotV` p2+	aDiff	= acos $ d / (m1 * m2)++   in	aDiff	+{-# INLINE angleVV #-}+++-- | Normalise a vector, so it has a magnitude of 1.+normalizeV :: Vector -> Vector+normalizeV v	= mulSV (1 / magV v) v+{-# INLINE normalizeV #-}+++-- | Produce a unit vector at a given angle relative to the +ve x-axis.+--	The provided angle is in radians.+unitVectorAtAngle :: Float -> Vector+unitVectorAtAngle r+	= (cos r, sin r)+{-# INLINE unitVectorAtAngle #-}+

@@ -0,0 +1,75 @@++module Graphics.Gloss.Data.ViewPort+        ( ViewPort(..)+        , viewPortInit+        , applyViewPortToPicture+        , invertViewPort )+where+import Graphics.Gloss.Data.Picture+++-- | The 'ViewPort' represents the global transformation applied to the displayed picture.+--      When the user pans, zooms, or rotates the display then this changes the 'ViewPort'.+data ViewPort+        = ViewPort { +        -- | Global translation.+          viewPortTranslate     :: !(Float, Float)++        -- | Global rotation (in degrees).+        , viewPortRotate        :: !Float               ++        -- | Global scaling (of both x and y coordinates).+        , viewPortScale         :: !Float               +        }+        +        +-- | The initial state of the viewport.+viewPortInit :: ViewPort+viewPortInit+        = ViewPort+        { viewPortTranslate     = (0, 0) +        , viewPortRotate        = 0+        , viewPortScale         = 1 +        }+++-- | Translates, rotates, and scales an image according to the 'ViewPort'.+applyViewPortToPicture :: ViewPort  -> Picture -> Picture+applyViewPortToPicture+        ViewPort { viewPortScale        = vscale+                 , viewPortTranslate    = (transX, transY)+                 , viewPortRotate       = vrotate }+        = Scale vscale vscale . Rotate vrotate . Translate transX transY+++-- | Takes a point using screen coordinates, and uses the `ViewPort` to convert+--   it to Picture coordinates. This is the inverse of `applyViewPortToPicture` +--   for points.+invertViewPort :: ViewPort -> Point -> Point+invertViewPort+        ViewPort { viewPortScale        = vscale+                 , viewPortTranslate    = vtrans+                 , viewPortRotate       = vrotate }+        pos+        = rotateV (degToRad vrotate) (mulSV (1 / vscale) pos) - vtrans+++-- | Convert degrees to radians+{-# INLINE degToRad #-}+degToRad :: Float -> Float+degToRad d      = d * pi / 180+++-- | Multiply a vector by a scalar.+mulSV :: Float -> Vector -> Vector+mulSV s (x, y)          +        = (s * x, s * y)+{-# INLINE mulSV #-}+++-- | Rotate a vector by an angle (in radians). +ve angle is counter-clockwise.+rotateV :: Float -> Vector -> Vector+rotateV r (x, y)+ =      (  x * cos r - y * sin r+        ,  x * sin r + y * cos r)+{-# INLINE rotateV #-}

@@ -3,13 +3,10 @@         , CommandConfig         , defaultCommandConfig         , ViewState     (..)-        , ViewPort      (..)         , viewStateInit         , viewStateInitWithConfig         , updateViewStateWithEvent-        , updateViewStateWithEventMaybe-        , applyViewPortToPicture-        , invertViewPort )+        , updateViewStateWithEventMaybe) where import Graphics.Gloss.Data.Vector import Graphics.Gloss.Data.ViewPort

@@ -0,0 +1,25 @@+-- | Geometric functions concerning angles. If not otherwise specified, all angles are in radians.+module Graphics.Gloss.Geometry.Angle+	( degToRad+	, radToDeg+	, normalizeAngle )+where++-- | Convert degrees to radians+degToRad :: Float -> Float+degToRad d	= d * pi / 180+{-# INLINE degToRad #-}+++-- | Convert radians to degrees+radToDeg :: Float -> Float+radToDeg r	= r * 180 / pi+{-# INLINE radToDeg #-}+++-- | Normalize an angle to be between 0 and 2*pi radians+normalizeAngle :: Float -> Float+normalizeAngle f = f - 2 * pi * floor' (f / (2 * pi))+ where  floor' :: Float -> Float+        floor' x = fromIntegral (floor x :: Int)+{-# INLINE normalizeAngle #-}

@@ -0,0 +1,325 @@+{-# LANGUAGE PatternGuards #-}++-- | 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. +module Graphics.Gloss.Geometry.Line+	( segClearsBox++	-- * Closest points+	, closestPointOnLine+	, closestPointOnLineParam ++	-- * Line-Line intersection+	, intersectLineLine++	-- * Seg-Line intersection+	, intersectSegLine+	, intersectSegHorzLine+	, intersectSegVertLine++	-- * Seg-Seg intersection+	, intersectSegSeg+	, intersectSegHorzSeg+	, intersectSegVertSeg)+	+where+import Graphics.Gloss.Data.Point+import Graphics.Gloss.Data.Vector+++-- | Check if line segment (P1-P2) clears a box (P3-P4) by being well outside it.+segClearsBox +	:: Point	-- ^ P1 First point of segment. +	-> Point 	-- ^ P2 Second point of segment.+	-> Point 	-- ^ P3 Lower left point of box.+	-> Point	-- ^ P4 Upper right point of box.+	-> Bool++segClearsBox (x1, y1) (x2, y2) (xa, ya) (xb, yb)+	| x1 < xa, x2 < xa	= True+	| x1 > xb, x2 > xb	= True+	| y1 < ya, y2 < ya	= True+	| y1 > yb, y2 > yb	= True+	| otherwise		= False+++-- | Given an infinite line which intersects `P1` and `P1`,+--	return the point on that line that is closest to `P3`+closestPointOnLine+	:: Point 	-- ^ `P1`+	-> Point	-- ^ `P2`+	-> Point	-- ^ `P3`+	-> Point	-- ^ the point on the line P1-P2 that is closest to `P3`++{-# INLINE closestPointOnLine #-}++closestPointOnLine p1 p2 p3+ 	= p1 + (u `mulSV` (p2 - p1))+	where	u	= closestPointOnLineParam p1 p2 p3+++-- | Given an infinite line which intersects P1 and P2,+--	let P4 be the point on the line that is closest to P3.+--+--	Return an indication of where on the line P4 is relative to P1 and P2.+--+-- @+--      if P4 == P1 then 0+--      if P4 == P2 then 1+--      if P4 is halfway between P1 and P2 then 0.5+-- @+--+-- @+--        |+--       P1+--        | +--     P4 +---- P3      +--        |+--       P2+--        |+-- @+--+{-# INLINE closestPointOnLineParam #-}+closestPointOnLineParam+	:: Point 	-- ^ `P1`+	-> Point 	-- ^ `P2`+	-> Point 	-- ^ `P3`+	-> Float++closestPointOnLineParam p1 p2 p3+ 	= (p3 - p1) `dotV` (p2 - p1) + 	/ (p2 - p1) `dotV` (p2 - p1)++++-- 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 line between either of the two pairs of points.+--+-- @+--     \\      /+--      P1  P4+--       \\ /+--        ++--       / \\+--      P3  P2+--     /     \\+-- @+--+intersectLineLine +	:: Point	-- ^ `P1`+	-> Point	-- ^ `P2`+	-> Point	-- ^ `P3`+	-> Point	-- ^ `P4`+	-> Maybe Point++intersectLineLine (x1, y1) (x2, y2) (x3, y3) (x4, y4)+ = let	dx12	= x1 - x2+	dx34	= x3 - x4++	dy12	= y1 - y2+	dy34	= y3 - y4+	+	den	= dx12 * dy34  - dy12 * dx34++   in if den == 0+	then Nothing+	else let+		det12	= x1*y2 - y1*x2+		det34	= x3*y4 - y3*x4	++		numx	= det12 * dx34 - dx12 * det34+		numy	= det12 * dy34 - dy12 * det34+	     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.+--+intersectSegLine+	:: Point	-- ^ `P1`+	-> Point	-- ^ `P2`+	-> Point	-- ^ `P3`+	-> Point	-- ^ `P4`+	-> Maybe Point++intersectSegLine p1 p2 p3 p4+	-- TODO: merge closest point check with intersection, reuse subterms.+	| Just p0	<- intersectLineLine p1 p2 p3 p4+	, t12		<- closestPointOnLineParam p1 p2 p0+	, t12 >= 0 && t12 <= 1+	= Just p0+	+	| otherwise+	= Nothing+	++-- | Get the point where a segment crosses a horizontal line, if any.+--+-- @ +--                + P1+--               /+--       -------+---------+--             /        y0+--         P2 ++-- @+--+intersectSegHorzLine +	:: Point 	-- ^ P1 First point of segment.+	-> Point 	-- ^ P2 Second point of segment.+	-> Float 	-- ^ y value of line.+	-> Maybe Point+intersectSegHorzLine (x1, y1) (x2, y2) y0+	+	-- seg is on line+	| y1 == y0, y2 == y0	= Nothing+	+	-- seg is above line+	| y1 > y0,  y2 > y0	= Nothing+	+	-- seg is below line+	| y1 < y0,  y2 < y0	= Nothing+	+	-- seg is a single point on the line.+	-- this should be caught by the first case, +	-- but we'll test for it anyway.+	| y2 - y1 == 0		+	= Just (x1, y1)+	+	| otherwise		+	= Just ( (y0 - y1) * (x2 - x1) / (y2 - y1) + x1+	       , y0)++++-- | Get the point where a segment crosses a vertical line, if any.+--+-- @+--              |+--              |   + P1+--              | /+--              ++--            / |+--       P2 +   |+--              | x0+-- @+--+intersectSegVertLine +	:: Point 	-- ^ P1 First point of segment.+	-> Point 	-- ^ P2 Second point of segment.+	-> Float 	-- ^ x value of line.+	-> Maybe Point++intersectSegVertLine (x1, y1) (x2, y2) x0+	+	-- seg is on line+	| x1 == x0, x2 == x0	= Nothing+	+	-- seg is to right of line+	| x1 > x0,  x2 > x0	= Nothing+	+	-- seg is to left of line+	| x1 < x0,  x2 < x0	= Nothing+	+	-- seg is a single point on the line.+	-- this should be caught by the first case, +	-- but we'll test for it anyway.+	| x2 - x1 == 0		+	= Just (x1, y1)+	+	| otherwise		+	= Just (  x0+	       , (x0 - x1) * (y2 - y1) / (x2 - x1) + y1)+++-- Segment-Segment intersection -----------------------------------------------++-- | Get the point where a segment @P1-P2@ crosses another segement @P3-P4@,+--   if any.+intersectSegSeg+	:: Point	-- ^ `P1`+	-> Point	-- ^ `P2`+	-> Point	-- ^ `P3`+	-> Point	-- ^ `P4`+	-> Maybe Point++intersectSegSeg p1 p2 p3 p4+	-- TODO: merge closest point checks with intersection, reuse subterms.+	| Just p0	<- intersectLineLine p1 p2 p3 p4+	, t12		<- closestPointOnLineParam p1 p2 p0+	, t23		<- closestPointOnLineParam p3 p4 p0+	, t12 >= 0 && t12 <= 1+	, t23 >= 0 && t23 <= 1+	= Just p0+	+	| otherwise+	= Nothing+++-- | Check if an arbitrary segment intersects a horizontal segment.+--+-- @+--                 + P2+--                /+-- (xa, y3)  +---+----+ (xb, y3)+--              /+--          P1 ++-- @ ++intersectSegHorzSeg+	:: Point 	-- ^ P1 First point of segment.+	-> Point 	-- ^ P2 Second point of segment.+	-> Float 	-- ^ (y3) y value of horizontal segment.+	-> Float        -- ^ (xa) Leftmost x value of horizontal segment.+	-> Float 	-- ^ (xb) Rightmost x value of horizontal segment.+	-> Maybe Point	-- ^ (x3, y3) Intersection point, if any.+	+intersectSegHorzSeg p1@(x1, y1) p2@(x2, y2) y0 xa xb+	| segClearsBox p1 p2 (xa, y0) (xb, y0)+	= Nothing++	| x0 < xa	= Nothing+	| x0 > xb	= Nothing+	| otherwise	= Just (x0, y0)+		+	where x0 | (y2 - y1) == 0 = x1+		 | otherwise	  = (y0 - y1) * (x2 - x1) / (y2 - y1) + x1+++-- | Check if an arbitrary segment intersects a vertical segment.+--+-- @+--      (x3, yb) ++--               |   + P1+--               | /+--               ++--             / |+--        P2 +   |+--               + (x3, ya)+-- @ ++intersectSegVertSeg+	:: Point	-- ^ P1 First point of segment.+	-> Point 	-- ^ P2 Second point of segment.+	-> Float 	-- ^ (x3) x value of vertical segment+	-> Float	-- ^ (ya) Lowest y value of vertical segment.+	-> Float	-- ^ (yb) Highest y value of vertical segment.+	-> Maybe Point	-- ^ (x3, y3) Intersection point, if any.++intersectSegVertSeg p1@(x1, y1) p2@(x2, y2) x0 ya yb+	| segClearsBox p1 p2 (x0, ya) (x0, yb)+	= Nothing+	+	| y0 < ya	= Nothing+	| y0 > yb	= Nothing+	| otherwise	= Just (x0, y0)+	+	where y0 | (x2 - x1) == 0 = y1+		 | otherwise	  = (x0 - x1) * (y2 - y1) / (x2 - x1) + y1++

@@ -16,7 +16,7 @@ import Graphics.Gloss.Data.Display import Graphics.Gloss.Data.Picture import Graphics.Gloss.Data.Color-import Graphics.Gloss.Data.ViewState+import Graphics.Gloss.Data.ViewPort import Graphics.Gloss.Internals.Interface.Simulate import Graphics.Gloss.Internals.Interface.Backend 

@@ -15,7 +15,7 @@  -- | Open a new window and display the given animation. -----   Once the window is open you can use the same commands as with @display@.+--   Once the window is open you can use the same commands as with `display`. -- animate :: Display              -- ^ Display mode.         -> Color                -- ^ Background color.

@@ -18,11 +18,8 @@ --   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.

@@ -19,16 +19,17 @@ 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.+-- | Play a game in a window. Like `simulate`, but you manage your own input events.+play    :: 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

@@ -25,17 +25,19 @@ --      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@.+--   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).+simulate +        :: 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 

@@ -4,8 +4,9 @@ where	 import Graphics.Gloss.Data.Color import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.ViewPort import Graphics.Gloss.Data.ViewState-import Graphics.Gloss.Render+import Graphics.Gloss.Rendering import Graphics.Gloss.Internals.Interface.Backend import Graphics.Gloss.Internals.Interface.Window import Graphics.Gloss.Internals.Interface.Common.Exit@@ -13,9 +14,8 @@ import Graphics.Gloss.Internals.Interface.ViewState.Motion import Graphics.Gloss.Internals.Interface.ViewState.Reshape import Graphics.Gloss.Internals.Interface.Animate.Timing-import qualified Graphics.Gloss.Internals.Render.State	        		as RS-import qualified Graphics.Gloss.Internals.Interface.Animate.State		as AN-import qualified Graphics.Gloss.Internals.Interface.Callback			as Callback+import qualified Graphics.Gloss.Internals.Interface.Animate.State	as AN+import qualified Graphics.Gloss.Internals.Interface.Callback		as Callback import Data.IORef import Data.Functor ((<$>)) import Control.Monad@@ -37,7 +37,7 @@         --  	viewSR		<- newIORef viewStateInit 	animateSR	<- newIORef AN.stateInit-        renderS_        <- RS.stateInit+        renderS_        <- initState 	renderSR	<- newIORef renderS_   	let displayFun backendRef = do@@ -53,9 +53,12 @@                 windowSize      <- getWindowDimensions backendRef  		-- render the frame-		renderAction+		displayPicture 			windowSize-			(renderPicture renderS portS picture)+                        backColor+                        renderS+                        (viewPortScale portS)+                        (applyViewPortToPicture portS picture)  		-- perform GC every frame to try and avoid long pauses 		performGC

@@ -4,19 +4,19 @@ where	 import Graphics.Gloss.Data.Color import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.ViewPort import Graphics.Gloss.Data.ViewState-import Graphics.Gloss.Render+import Graphics.Gloss.Rendering import Graphics.Gloss.Internals.Interface.Backend import Graphics.Gloss.Internals.Interface.Window import Graphics.Gloss.Internals.Interface.Common.Exit import Graphics.Gloss.Internals.Interface.ViewState.KeyMouse import Graphics.Gloss.Internals.Interface.ViewState.Motion import Graphics.Gloss.Internals.Interface.ViewState.Reshape-import qualified Graphics.Gloss.Internals.Render.State	        		as RS-import qualified Graphics.Gloss.Internals.Interface.Callback			as Callback-+import qualified Graphics.Gloss.Internals.Interface.Callback as Callback import Data.IORef import Data.Functor+import System.Mem   displayWithBackend@@ -30,16 +30,23 @@ displayWithBackend backend displayMode background picture  =  do	viewSR		<- newIORef viewStateInit -        renderS         <- RS.stateInit+        renderS         <- initState 	renderSR	<- newIORef renderS 	 	let renderFun backendRef = do-		port    <- viewStateViewPort <$> readIORef viewSR-		options	<- readIORef renderSR+		port      <- viewStateViewPort <$> readIORef viewSR+		options	  <- readIORef renderSR                 windowSize <- getWindowDimensions backendRef-	 	renderAction-			windowSize-			(renderPicture options port picture)++                displayPicture +                        windowSize+                        background+                        options+                        (viewPortScale port)+                        (applyViewPortToPicture port picture)++                -- perform GC every frame to try and avoid long pauses+                performGC  	let callbacks 	     =	[ Callback.Display renderFun 

@@ -1,13 +1,13 @@ {-# LANGUAGE RankNTypes #-}  module Graphics.Gloss.Internals.Interface.Game-	( playWithBackendIO-	, Event(..) )+        ( playWithBackendIO+        , Event(..) ) where import Graphics.Gloss.Data.Color import Graphics.Gloss.Data.Picture import Graphics.Gloss.Data.ViewPort-import Graphics.Gloss.Render+import Graphics.Gloss.Rendering import Graphics.Gloss.Internals.Interface.Event import Graphics.Gloss.Internals.Interface.Backend import Graphics.Gloss.Internals.Interface.Window@@ -15,110 +15,115 @@ import Graphics.Gloss.Internals.Interface.ViewState.Reshape import Graphics.Gloss.Internals.Interface.Animate.Timing import Graphics.Gloss.Internals.Interface.Simulate.Idle-import qualified Graphics.Gloss.Internals.Interface.Callback		as Callback-import qualified Graphics.Gloss.Internals.Interface.Simulate.State	as SM-import qualified Graphics.Gloss.Internals.Interface.Animate.State	as AN-import qualified Graphics.Gloss.Internals.Render.State	        	as RS+import qualified Graphics.Gloss.Internals.Interface.Callback            as Callback+import qualified Graphics.Gloss.Internals.Interface.Simulate.State      as SM+import qualified Graphics.Gloss.Internals.Interface.Animate.State       as AN import Data.IORef import System.Mem  playWithBackendIO-	:: forall world a-	.  Backend a-	=> a				-- ^ Initial state of the backend-        -> 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)	-- ^ 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.-	-> Bool				-- ^ Whether to use the callback_exit or not.-	-> IO ()+        :: forall world a+        .  Backend a+        => a            -- ^ Initial state of the backend+        -> 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)        +                        -- ^ 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.+        -> Bool         -- ^ Whether to use the callback_exit or not.+        -> IO ()  playWithBackendIO-	backend+        backend         display-	backgroundColor-	simResolution-	worldStart-	worldToPicture-	worldHandleEvent-	worldAdvance-	withCallbackExit+        backgroundColor+        simResolution+        worldStart+        worldToPicture+        worldHandleEvent+        worldAdvance+        withCallbackExit  = do-	let singleStepTime	= 1+        let singleStepTime      = 1 -	-- make the simulation state-	stateSR		<- newIORef $ SM.stateInit simResolution+        -- make the simulation state+        stateSR         <- newIORef $ SM.stateInit simResolution -	-- make a reference to the initial world-	worldSR		<- newIORef worldStart+        -- make a reference to the initial world+        worldSR         <- newIORef worldStart -	-- make the initial GL view and render states-	viewSR		<- newIORef viewPortInit-	animateSR	<- newIORef AN.stateInit-        renderS_        <- RS.stateInit-	renderSR	<- newIORef renderS_+        -- make the initial GL view and render states+        viewSR          <- newIORef viewPortInit+        animateSR       <- newIORef AN.stateInit+        renderS_        <- initState+        renderSR        <- newIORef renderS_ -	let displayFun backendRef-	     = do-		-- convert the world to a picture-		world		<- readIORef worldSR-		picture		<- worldToPicture world-	-		-- display the picture in the current view-		renderS		<- readIORef renderSR-		viewPort        <- readIORef viewSR+        let displayFun backendRef+             = do+                -- convert the world to a picture+                world           <- readIORef worldSR+                picture         <- worldToPicture world+        +                -- display the picture in the current view+                renderS         <- readIORef renderSR+                viewPort        <- readIORef viewSR                  windowSize <- getWindowDimensions backendRef -		-- render the frame-		renderAction-			windowSize-	 	 	(renderPicture renderS viewPort picture)+                -- render the frame+                displayPicture+                        windowSize+                        backgroundColor+                        renderS+                        (viewPortScale viewPort)+                        (applyViewPortToPicture viewPort picture)  -		-- perform garbage collection-		performGC+                -- perform GC every frame to try and avoid long pauses+                performGC -	let callbacks-	     = 	[ Callback.Display	(animateBegin animateSR)-		, Callback.Display 	displayFun-		, Callback.Display	(animateEnd   animateSR)-		, Callback.Idle		(callback_simulate_idle -						stateSR animateSR (readIORef viewSR)-						worldSR (\_ -> worldAdvance)-						singleStepTime)-		, callback_keyMouse worldSR viewSR worldHandleEvent-		, callback_motion   worldSR worldHandleEvent-		, callback_reshape  worldSR worldHandleEvent]+        let callbacks+             =  [ Callback.Display      (animateBegin animateSR)+                , Callback.Display      displayFun+                , Callback.Display      (animateEnd   animateSR)+                , Callback.Idle         (callback_simulate_idle +                                                stateSR animateSR (readIORef viewSR)+                                                worldSR (\_ -> worldAdvance)+                                                singleStepTime)+                , callback_keyMouse worldSR viewSR worldHandleEvent+                , callback_motion   worldSR worldHandleEvent+                , callback_reshape  worldSR worldHandleEvent] -	let exitCallback-		 = if withCallbackExit then [callback_exit ()] else []+        let exitCallback+                 = if withCallbackExit then [callback_exit ()] else [] -	createWindow backend display backgroundColor $ callbacks ++ exitCallback+        createWindow backend display backgroundColor $ callbacks ++ exitCallback   -- | Callback for KeyMouse events. callback_keyMouse -	:: IORef world	 		-- ^ ref to world state-	-> IORef ViewPort-	-> (Event -> world -> IO world)	-- ^ fn to handle input events-	-> Callback+        :: IORef world                  -- ^ ref to world state+        -> IORef ViewPort+        -> (Event -> world -> IO world) -- ^ fn to handle input events+        -> Callback  callback_keyMouse worldRef viewRef eventFn- 	= KeyMouse (handle_keyMouse worldRef viewRef eventFn)+        = KeyMouse (handle_keyMouse worldRef viewRef eventFn)   handle_keyMouse -	:: IORef a-	-> t-	-> (Event -> a -> IO a)-	-> KeyboardMouseCallback+        :: IORef a+        -> t+        -> (Event -> a -> IO a)+        -> KeyboardMouseCallback  handle_keyMouse worldRef _ eventFn backendRef key keyState keyMods pos- = do	ev         <- keyMouseEvent backendRef key keyState keyMods pos+ = do   ev         <- keyMouseEvent backendRef key keyState keyMods pos         world      <- readIORef worldRef         world'     <- eventFn ev world         writeIORef worldRef world'@@ -126,18 +131,18 @@  -- | Callback for Motion events. callback_motion-	:: IORef world	 		-- ^ ref to world state-	-> (Event -> world -> IO world)	-- ^ fn to handle input events-	-> Callback+        :: IORef world                  -- ^ ref to world state+        -> (Event -> world -> IO world) -- ^ fn to handle input events+        -> Callback  callback_motion worldRef eventFn- 	= Motion (handle_motion worldRef eventFn)+        = Motion (handle_motion worldRef eventFn)   handle_motion -	:: IORef a-	-> (Event -> a -> IO a)-	-> MotionCallback+        :: IORef a+        -> (Event -> a -> IO a)+        -> MotionCallback  handle_motion worldRef eventFn backendRef pos  = do   ev       <- motionEvent backendRef pos@@ -152,7 +157,7 @@   -> (Event -> world -> IO world)   -> Callback callback_reshape worldRef eventFN- 	= Reshape (handle_reshape worldRef eventFN)+        = Reshape (handle_reshape worldRef eventFN)   handle_reshape

@@ -1,13 +1,14 @@ {-# LANGUAGE RankNTypes #-}  module Graphics.Gloss.Internals.Interface.Simulate-	(simulateWithBackendIO)+        (simulateWithBackendIO) where import Graphics.Gloss.Data.Display import Graphics.Gloss.Data.Color import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.ViewPort import Graphics.Gloss.Data.ViewState-import Graphics.Gloss.Render+import Graphics.Gloss.Rendering import Graphics.Gloss.Internals.Interface.Backend import Graphics.Gloss.Internals.Interface.Window import Graphics.Gloss.Internals.Interface.Common.Exit@@ -16,84 +17,88 @@ import Graphics.Gloss.Internals.Interface.ViewState.Reshape import Graphics.Gloss.Internals.Interface.Animate.Timing import Graphics.Gloss.Internals.Interface.Simulate.Idle-import qualified Graphics.Gloss.Internals.Interface.Callback			as Callback-import qualified Graphics.Gloss.Internals.Interface.Simulate.State		as SM-import qualified Graphics.Gloss.Internals.Interface.Animate.State		as AN-import qualified Graphics.Gloss.Internals.Render.State	        		as RS+import qualified Graphics.Gloss.Internals.Interface.Callback            as Callback+import qualified Graphics.Gloss.Internals.Interface.Simulate.State      as SM+import qualified Graphics.Gloss.Internals.Interface.Animate.State       as AN import Data.Functor ((<$>)) import Data.IORef import System.Mem   simulateWithBackendIO-	:: forall model a-	.  Backend a-	=> a				-- ^ Initial state of the backend-        -> 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 ()+        :: forall model a+        .  Backend a+        => a            -- ^ Initial state of the backend+        -> 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 ()  simulateWithBackendIO-	backend+        backend         display-	backgroundColor-	simResolution-	worldStart-	worldToPicture-	worldAdvance+        backgroundColor+        simResolution+        worldStart+        worldToPicture+        worldAdvance  = do-	let singleStepTime	= 1+        let singleStepTime      = 1 -	-- make the simulation state-	stateSR		<- newIORef $ SM.stateInit simResolution+        -- make the simulation state+        stateSR         <- newIORef $ SM.stateInit simResolution -	-- make a reference to the initial world-	worldSR		<- newIORef worldStart+        -- make a reference to the initial world+        worldSR         <- newIORef worldStart -	-- make the initial GL view and render states-	viewSR		<- newIORef viewStateInit-	animateSR	<- newIORef AN.stateInit-        renderS_        <- RS.stateInit-	renderSR	<- newIORef renderS_+        -- make the initial GL view and render states+        viewSR          <- newIORef viewStateInit+        animateSR       <- newIORef AN.stateInit+        renderS_        <- initState+        renderSR        <- newIORef renderS_ -	let displayFun backendRef-	     = do-		-- convert the world to a picture-		world		<- readIORef worldSR-		port		<- viewStateViewPort <$> readIORef viewSR-		picture	        <- worldToPicture world+        let displayFun backendRef+             = do+                -- convert the world to a picture+                world           <- readIORef worldSR+                port            <- viewStateViewPort <$> readIORef viewSR+                picture         <- worldToPicture world -		-- display the picture in the current view-		renderS		<- readIORef renderSR+                -- display the picture in the current view+                renderS         <- readIORef renderSR -                windowSize <- getWindowDimensions backendRef+                windowSize      <- getWindowDimensions backendRef -		-- render the frame-		renderAction-			windowSize-	 	 	(renderPicture renderS port picture)+                -- render the frame+                displayPicture+                        windowSize+                        backgroundColor+                        renderS+                        (viewPortScale port)+                        (applyViewPortToPicture port picture)  -		-- perform garbage collection-		performGC+                -- perform GC every frame to try and avoid long pauses+                performGC -	let callbacks-	     = 	[ Callback.Display	(animateBegin animateSR)-		, Callback.Display 	displayFun-		, Callback.Display	(animateEnd   animateSR)-		, Callback.Idle		(callback_simulate_idle -						stateSR animateSR-						(viewStateViewPort <$> readIORef viewSR)-						worldSR worldAdvance-						singleStepTime)-		, callback_exit () -		, callback_viewState_keyMouse viewSR-		, callback_viewState_motion   viewSR-		, callback_viewState_reshape ]+        let callbacks+             =  [ Callback.Display      (animateBegin animateSR)+                , Callback.Display      displayFun+                , Callback.Display      (animateEnd   animateSR)+                , Callback.Idle         (callback_simulate_idle +                                                stateSR animateSR+                                                (viewStateViewPort <$> readIORef viewSR)+                                                worldSR worldAdvance+                                                singleStepTime)+                , callback_exit () +                , callback_viewState_keyMouse viewSR+                , callback_viewState_motion   viewSR+                , callback_viewState_reshape ] -	createWindow backend display backgroundColor callbacks+        createWindow backend display backgroundColor callbacks

@@ -1,5 +1,5 @@ Name:                gloss-Version:             1.9.1.1+Version:             1.9.2.1 License:             MIT License-file:        LICENSE Author:              Ben Lippmeier@@ -44,15 +44,23 @@         OpenGL     == 2.9.*,         GLUT       == 2.5.*,         bmp        == 1.2.*,-        gloss-rendering == 1.9.1.*+        gloss-rendering == 1.9.2.*    ghc-options:         -O2 -Wall    Exposed-modules:         Graphics.Gloss+        Graphics.Gloss.Data.Bitmap+        Graphics.Gloss.Data.Color+        Graphics.Gloss.Data.Display+        Graphics.Gloss.Data.Picture+        Graphics.Gloss.Data.Point+        Graphics.Gloss.Data.Vector+        Graphics.Gloss.Data.ViewPort         Graphics.Gloss.Data.ViewState-        Graphics.Gloss.Algorithms.RayCast+        Graphics.Gloss.Geometry.Angle+        Graphics.Gloss.Geometry.Line         Graphics.Gloss.Interface.Pure.Display         Graphics.Gloss.Interface.Pure.Animate         Graphics.Gloss.Interface.Pure.Simulate