gloss 1.9.2.1 → 1.9.3.1

raw patch · 26 files changed

+689/−692 lines, 26 filesdep ~GLUTdep ~OpenGLdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: GLUT, OpenGL, base, ghc-prim, gloss-rendering

API changes (from Hackage documentation)

Files

• Graphics/Gloss.hs +10/−10
• Graphics/Gloss/Data/Color.hs +59/−59
• Graphics/Gloss/Data/Point.hs +10/−10
• Graphics/Gloss/Data/Vector.hs +26/−26
• Graphics/Gloss/Geometry/Angle.hs +5/−5
• Graphics/Gloss/Geometry/Line.hs +163/−163
• Graphics/Gloss/Interface/Pure/Animate.hs +3/−3
• Graphics/Gloss/Interface/Pure/Display.hs +3/−3
• Graphics/Gloss/Interface/Pure/Game.hs +4/−4
• Graphics/Gloss/Interface/Pure/Simulate.hs +3/−3
• Graphics/Gloss/Internals/Color.hs +7/−7
• Graphics/Gloss/Internals/Interface/Animate.hs +34/−34
• Graphics/Gloss/Internals/Interface/Animate/State.hs +33/−33
• Graphics/Gloss/Internals/Interface/Animate/Timing.hs +40/−40
• Graphics/Gloss/Internals/Interface/Common/Exit.hs +12/−12
• Graphics/Gloss/Internals/Interface/Debug.hs +52/−52
• Graphics/Gloss/Internals/Interface/Display.hs +23/−24
• Graphics/Gloss/Internals/Interface/Event.hs +32/−33
• Graphics/Gloss/Internals/Interface/Simulate.hs +0/−1
• Graphics/Gloss/Internals/Interface/Simulate/Idle.hs +64/−64
• Graphics/Gloss/Internals/Interface/Simulate/State.hs +18/−18
• Graphics/Gloss/Internals/Interface/ViewState/KeyMouse.hs +11/−11
• Graphics/Gloss/Internals/Interface/ViewState/Motion.hs +11/−11
• Graphics/Gloss/Internals/Interface/ViewState/Reshape.hs +11/−11
• Graphics/Gloss/Internals/Interface/Window.hs +49/−49
• gloss.cabal +6/−6

@@ -1,6 +1,6 @@  -- | Gloss hides the pain of drawing simple vector graphics behind a nice data type and---	a few display functions. +--      a few display functions.  -- --   Getting something on the screen is as easy as: --@@ -11,13 +11,13 @@ -- --   Once the window is open you can use the following: ----- 	* Quit - esc-key.+--      * Quit - esc-key. -----	* Move Viewport - left-click drag, arrow keys.+--      * Move Viewport - left-click drag, arrow keys. -----	* Rotate Viewport - right-click drag, control-left-click drag, or home\/end-keys.+--      * Rotate Viewport - right-click drag, control-left-click drag, or home\/end-keys. -----	* Zoom Viewport - mouse wheel, or page up\/down-keys.+--      * Zoom Viewport - mouse wheel, or page up\/down-keys. -- --   Animations can be constructed similarly using the `animate`. --@@ -66,14 +66,14 @@ -- For more information, check out <http://gloss.ouroborus.net>. -- module Graphics.Gloss -	( module Graphics.Gloss.Data.Picture-	, module Graphics.Gloss.Data.Color+        ( module Graphics.Gloss.Data.Picture+        , module Graphics.Gloss.Data.Color         , module Graphics.Gloss.Data.Bitmap         , Display(..)-	, display-	, animate+        , display+        , animate         , simulate-	, play)+        , play) where import Graphics.Gloss.Data.Display import Graphics.Gloss.Data.Picture

@@ -1,30 +1,30 @@  -- | Predefined and custom colors. module Graphics.Gloss.Data.Color-	( -- ** Color data type-	  Color+        ( -- ** Color data type+          Color         , makeColor         , makeColorI         , rgbaOfColor -  	  -- ** Color functions-	, mixColors-	, addColors-	, dim,   bright-	, light, dark+          -- ** Color functions+        , mixColors+        , addColors+        , dim,   bright+        , light, dark -	  -- ** Pre-defined colors-	, greyN,  black,  white+          -- ** Pre-defined colors+        , greyN,  black,  white -	  -- *** Primary-	, red,    green,  blue+          -- *** Primary+        , red,    green,  blue -	  -- *** Secondary-	, yellow,     cyan,       magenta-	-	  -- *** Tertiary-	, rose,   violet, azure, aquamarine, chartreuse, orange-	)+          -- *** Secondary+        , yellow,     cyan,       magenta+        +          -- *** Tertiary+        , rose,   violet, azure, aquamarine, chartreuse, orange+        ) where import Graphics.Gloss.Rendering @@ -41,40 +41,40 @@  -- | 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.+        :: 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+ = let  (r1, g1, b1, a1) = rgbaOfColor c1+        (r2, g2, b2, a2) = rgbaOfColor c2 -	total	= ratio1 + ratio2-	m1	= ratio1 / total-	m2	= ratio2 / total+        total   = ratio1 + ratio2+        m1      = ratio1 / total+        m2      = ratio2 / total -   in	makeColor +   in   makeColor                  (m1 * r1 + m2 * r2)-		(m1 * g1 + m2 * g2)-		(m1 * b1 + m2 * b2)-		(m1 * a1 + m2 * a2)+                (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.+--      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+ = let  (r1, g1, b1, a1) = rgbaOfColor c1+        (r2, g2, b2, a2) = rgbaOfColor c2 -   in	normalizeColor -	 $ makeColor +   in   normalizeColor +         $ makeColor                  (r1 + r2)-		(g1 + g2)-		(b1 + b2)-		((a1 + a2) / 2)+                (g1 + g2)+                (b1 + b2)+                ((a1 + a2) / 2)   -- | Make a dimmer version of a color, scaling towards black.@@ -83,7 +83,7 @@  = 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@@ -96,8 +96,8 @@ 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@@ -107,31 +107,31 @@  -- 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+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+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+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+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+rose            = addColors red     magenta+violet          = addColors magenta blue+azure           = addColors blue    cyan+aquamarine      = addColors cyan    green+chartreuse      = addColors green   yellow+orange          = addColors yellow  red

@@ -1,8 +1,8 @@ {-# OPTIONS -fno-warn-missing-methods -fno-warn-orphans #-} {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} module Graphics.Gloss.Data.Point-	( Point, Path-	, pointInBox)+        ( Point, Path+        , pointInBox) where import Graphics.Gloss.Data.Picture @@ -20,12 +20,12 @@ -- @ -- pointInBox -	:: Point -	-> Point -	-> Point -> Bool-	+        :: 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+        =  x0 >= min x1 x2+        && x0 <= max x1 x2+        && y0 >= min y1 y2+        && y0 <= max y1 y2

@@ -3,16 +3,16 @@  -- | Geometric functions concerning vectors. module Graphics.Gloss.Data.Vector-	( Vector-	, magV-	, argV-	, dotV-	, detV-	, mulSV-	, rotateV-	, angleVV-	, normalizeV-	, unitVectorAtAngle )+        ( Vector+        , magV+        , argV+        , dotV+        , detV+        , mulSV+        , rotateV+        , angleVV+        , normalizeV+        , unitVectorAtAngle ) where import Graphics.Gloss.Data.Picture import Graphics.Gloss.Geometry.Angle@@ -20,43 +20,43 @@  -- | The magnitude of a vector. magV :: Vector -> Float-magV (x, y) 	-	= sqrt (x * x + y * y)+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+        = 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+        = x1 * y1 + x2 * y2 {-# INLINE dotV #-}   -- | The determinant of two vectors. detV :: Vector -> Vector -> Float detV (x1, y1) (x2, y2)-	= x1 * y2 - y1 * x2+        = x1 * y2 - y1 * x2 {-# INLINE detV #-}   -- | Multiply a vector by a scalar. mulSV :: Float -> Vector -> Vector-mulSV s (x, y)		-	= (s * x, s * y)+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 * cos r - y * sin r         ,  x * sin r + y * cos r) {-# INLINE rotateV #-} @@ -64,25 +64,25 @@ -- | 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)+ = let  m1      = magV p1+        m2      = magV p2+        d       = p1 `dotV` p2+        aDiff   = acos $ d / (m1 * m2) -   in	aDiff	+   in   aDiff    {-# INLINE angleVV #-}   -- | Normalise a vector, so it has a magnitude of 1. normalizeV :: Vector -> Vector-normalizeV v	= mulSV (1 / magV v) v+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.+--      The provided angle is in radians. unitVectorAtAngle :: Float -> Vector unitVectorAtAngle r-	= (cos r, sin r)+        = (cos r, sin r) {-# INLINE unitVectorAtAngle #-} 

@@ -1,19 +1,19 @@ -- | Geometric functions concerning angles. If not otherwise specified, all angles are in radians. module Graphics.Gloss.Geometry.Angle-	( degToRad-	, radToDeg-	, normalizeAngle )+        ( degToRad+        , radToDeg+        , normalizeAngle ) where  -- | Convert degrees to radians degToRad :: Float -> Float-degToRad d	= d * pi / 180+degToRad d      = d * pi / 180 {-# INLINE degToRad #-}   -- | Convert radians to degrees radToDeg :: Float -> Float-radToDeg r	= r * 180 / pi+radToDeg r      = r * 180 / pi {-# INLINE radToDeg #-}  

@@ -5,25 +5,25 @@ --   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+        ( segClearsBox -	-- * Closest points-	, closestPointOnLine-	, closestPointOnLineParam +        -- * Closest points+        , closestPointOnLine+        , closestPointOnLineParam  -	-- * Line-Line intersection-	, intersectLineLine+        -- * Line-Line intersection+        , intersectLineLine -	-- * Seg-Line intersection-	, intersectSegLine-	, intersectSegHorzLine-	, intersectSegVertLine+        -- * Seg-Line intersection+        , intersectSegLine+        , intersectSegHorzLine+        , intersectSegVertLine -	-- * Seg-Seg intersection-	, intersectSegSeg-	, intersectSegHorzSeg-	, intersectSegVertSeg)-	+        -- * Seg-Seg intersection+        , intersectSegSeg+        , intersectSegHorzSeg+        , intersectSegVertSeg)+         where import Graphics.Gloss.Data.Point import Graphics.Gloss.Data.Vector@@ -31,39 +31,39 @@  -- | 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+        :: 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+        | 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`+--      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`+        :: 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+        = 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.+--      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.+--      Return an indication of where on the line P4 is relative to P1 and P2. -- -- @ --      if P4 == P1 then 0@@ -83,14 +83,14 @@ -- {-# INLINE closestPointOnLineParam #-} closestPointOnLineParam-	:: Point 	-- ^ `P1`-	-> Point 	-- ^ `P2`-	-> Point 	-- ^ `P3`-	-> Float+        :: Point        -- ^ `P1`+        -> Point        -- ^ `P2`+        -> Point        -- ^ `P3`+        -> Float  closestPointOnLineParam p1 p2 p3- 	= (p3 - p1) `dotV` (p2 - p1) - 	/ (p2 - p1) `dotV` (p2 - p1)+        = (p3 - p1) `dotV` (p2 - p1) +        / (p2 - p1) `dotV` (p2 - p1)   @@ -111,30 +111,30 @@ -- @ -- intersectLineLine -	:: Point	-- ^ `P1`-	-> Point	-- ^ `P2`-	-> Point	-- ^ `P3`-	-> Point	-- ^ `P4`-	-> Maybe Point+        :: 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+ = let  dx12    = x1 - x2+        dx34    = x3 - x4 -	dy12	= y1 - y2-	dy34	= y3 - y4-	-	den	= dx12 * dy34  - dy12 * dx34+        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	+        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)+                numx    = det12 * dx34 - dx12 * det34+                numy    = det12 * dy34 - dy12 * det34+             in Just (numx / den, numy / den)   -- Segment-Line intersection --------------------------------------------------@@ -142,22 +142,22 @@ --   if any. -- intersectSegLine-	:: Point	-- ^ `P1`-	-> Point	-- ^ `P2`-	-> Point	-- ^ `P3`-	-> Point	-- ^ `P4`-	-> Maybe Point+        :: 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-	+        -- 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. --@@ -170,30 +170,30 @@ -- @ -- intersectSegHorzLine -	:: Point 	-- ^ P1 First point of segment.-	-> Point 	-- ^ P2 Second point of segment.-	-> Float 	-- ^ y value of line.-	-> Maybe Point+        :: 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)+        +        -- 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)   @@ -210,31 +210,31 @@ -- @ -- intersectSegVertLine -	:: Point 	-- ^ P1 First point of segment.-	-> Point 	-- ^ P2 Second point of segment.-	-> Float 	-- ^ x value of line.-	-> Maybe Point+        :: 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)+        +        -- 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 -----------------------------------------------@@ -242,23 +242,23 @@ -- | 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+        :: 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+        -- 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.@@ -272,23 +272,23 @@ -- @   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.-	+        :: 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+        | 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+        | 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.@@ -304,22 +304,22 @@ -- @   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.+        :: 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+        | 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  

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

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

@@ -6,11 +6,11 @@ -- | 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.Display         , module Graphics.Gloss.Data.Picture-	, module Graphics.Gloss.Data.Color-	, play-	, Event(..), Key(..), SpecialKey(..), MouseButton(..), KeyState(..), Modifiers(..))+        , module Graphics.Gloss.Data.Color+        , play+        , Event(..), Key(..), SpecialKey(..), MouseButton(..), KeyState(..), Modifiers(..)) where import Graphics.Gloss.Data.Display import Graphics.Gloss.Data.Picture

@@ -7,10 +7,10 @@ --   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.Display         , module Graphics.Gloss.Data.Picture-	, module Graphics.Gloss.Data.Color-	, simulate+        , module Graphics.Gloss.Data.Color+        , simulate         , ViewPort(..)) where import Graphics.Gloss.Data.Display

@@ -3,7 +3,7 @@ module Graphics.Gloss.Internals.Color where  import Graphics.Gloss.Data.Color-import qualified Graphics.Rendering.OpenGL.GL		as GL+import qualified Graphics.Rendering.OpenGL.GL           as GL  import Unsafe.Coerce @@ -11,9 +11,9 @@ glColor4OfColor :: Fractional a => Color -> GL.Color4 a glColor4OfColor color  = case rgbaOfColor color of-	(r, g, b, a)-	 -> let	rF	= unsafeCoerce r-		gF	= unsafeCoerce g-		bF	= unsafeCoerce b-		aF	= unsafeCoerce a-   	    in	GL.Color4 rF gF bF aF+        (r, g, b, a)+         -> let rF      = unsafeCoerce r+                gF      = unsafeCoerce g+                bF      = unsafeCoerce b+                aF      = unsafeCoerce a+            in  GL.Color4 rF gF bF aF

@@ -1,7 +1,7 @@  module Graphics.Gloss.Internals.Interface.Animate-	(animateWithBackendIO)-where	+        (animateWithBackendIO)+where    import Graphics.Gloss.Data.Color import Graphics.Gloss.Data.Picture import Graphics.Gloss.Data.ViewPort@@ -14,63 +14,63 @@ 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.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 import System.Mem import GHC.Float (double2Float) + animateWithBackendIO-	:: Backend a-	=> a                     -- ^ Initial State of the backend+        :: Backend a+        => a                     -- ^ Initial State of the backend         -> Bool                  -- ^ Whether to allow the image to be panned around.         -> Display               -- ^ Display mode.-	-> Color                 -- ^ Background color.-	-> (Float -> IO Picture) -- ^ Function to produce the next frame of animation.+        -> 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 ()+        -> IO ()  animateWithBackendIO backend pannable display backColor frameOp- = do	+ = do            -- -	viewSR		<- newIORef viewStateInit-	animateSR	<- newIORef AN.stateInit+        viewSR          <- newIORef viewStateInit+        animateSR       <- newIORef AN.stateInit         renderS_        <- initState-	renderSR	<- newIORef renderS_+        renderSR        <- newIORef renderS_ - 	let displayFun backendRef = do-		-- extract the current time from the state-		timeS		<- animateSR `getsIORef` AN.stateAnimateTime+        let displayFun backendRef = do+                -- extract the current time from the state+                timeS           <- animateSR `getsIORef` AN.stateAnimateTime -		-- call the user action to get the animation frame-		picture		<- frameOp (double2Float timeS)+                -- call the user action to get the animation frame+                picture         <- frameOp (double2Float timeS) -		renderS		<- readIORef renderSR-		portS		<- viewStateViewPort <$> readIORef viewSR+                renderS         <- readIORef renderSR+                portS           <- viewStateViewPort <$> readIORef viewSR                  windowSize      <- getWindowDimensions backendRef -		-- render the frame-		displayPicture-			windowSize+                -- render the frame+                displayPicture+                        windowSize                         backColor                         renderS                         (viewPortScale portS)                         (applyViewPortToPicture portS picture) -		-- perform GC every frame to try and avoid long pauses-		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		(\s -> postRedisplay s)-		, callback_exit () -		, callback_viewState_motion viewSR-		, callback_viewState_reshape ]+        let callbacks+             =  [ Callback.Display      (animateBegin animateSR)+                , Callback.Display      displayFun+                , Callback.Display      (animateEnd   animateSR)+                , Callback.Idle         (\s -> postRedisplay s)+                , callback_exit () +                , callback_viewState_motion viewSR+                , callback_viewState_reshape ]                ++ (if pannable                    then [callback_viewState_keyMouse viewSR]

@@ -1,54 +1,54 @@ {-# OPTIONS_HADDOCK hide #-}  module Graphics.Gloss.Internals.Interface.Animate.State-	( State (..) -	, stateInit )+        ( State (..) +        , stateInit ) where  -- | Animation State data State-	= State-	{-	-- | Whether the animation is running.-	  stateAnimate			:: !Bool+        = State+        {+        -- | 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+        -- | Whether this is the first frame of the animation.+        , stateAnimateStart             :: !Bool -	-- | Number of msec the animation has been running for-	, stateAnimateTime		:: !Double+        -- | Number of msec the animation has been running for+        , stateAnimateTime              :: !Double -	-- | The time when we entered the display callback for the current frame.-	, stateDisplayTime		:: !Double-	, stateDisplayTimeLast		:: !Double+        -- | The time when we entered the display callback for the current frame.+        , stateDisplayTime              :: !Double+        , stateDisplayTimeLast          :: !Double -	-- | Clamp the minimum time between frames to this value (in seconds)+        -- | 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.-	, stateGateTimeStart		:: !Double+        , stateDisplayTimeClamp         :: !Double+                                                        +        -- | The time when the last call to the users render function finished.+        , stateGateTimeStart            :: !Double -	-- | The time when displayInWindow last finished (after sleeping to clamp fps).-	, stateGateTimeEnd		:: !Double-	-	-- | How long it took to draw this frame-	, stateGateTimeElapsed		:: !Double }+        -- | The time when displayInWindow last finished (after sleeping to clamp fps).+        , stateGateTimeEnd              :: !Double+        +        -- | How long it took to draw this frame+        , stateGateTimeElapsed          :: !Double }   stateInit :: State stateInit-	= State-	{ stateAnimate			= True+        = State+        { stateAnimate                  = True         , stateAnimateCount             = 0-	, stateAnimateStart		= True-	, stateAnimateTime		= 0-	, stateDisplayTime		= 0-	, stateDisplayTimeLast		= 0 -	, stateDisplayTimeClamp		= 0.01-	, stateGateTimeStart		= 0-	, stateGateTimeEnd		= 0 -	, stateGateTimeElapsed		= 0 }+        , stateAnimateStart             = True+        , stateAnimateTime              = 0+        , stateDisplayTime              = 0+        , stateDisplayTimeLast          = 0 +        , stateDisplayTimeClamp         = 0.01+        , stateGateTimeStart            = 0+        , stateGateTimeEnd              = 0 +        , stateGateTimeElapsed          = 0 }

@@ -2,16 +2,16 @@ {-# OPTIONS_HADDOCK hide #-}  -- | Handles timing of animation.---	The main point is that we want to restrict the framerate to something---	sensible, instead of just displaying at the machines maximum possible---	rate and soaking up 100% cpu. +--      The main point is that we want to restrict the framerate to something+--      sensible, instead of just displaying at the machines maximum possible+--      rate and soaking up 100% cpu.  -----	We also keep track of the elapsed time since the start of the program,---	so we can pass this to the user's animation function.+--      We also keep track of the elapsed time since the start of the program,+--      so we can pass this to the user's animation function. --  module Graphics.Gloss.Internals.Interface.Animate.Timing-	( animateBegin-	, animateEnd )+        ( animateBegin+        , animateEnd ) where import Graphics.Gloss.Internals.Interface.Backend import Graphics.Gloss.Internals.Interface.Animate.State@@ -20,62 +20,62 @@   -- | Handles animation timing details.---	Call this function at the start of each frame.+--      Call this function at the start of each frame. animateBegin :: IORef State -> DisplayCallback animateBegin stateRef backendRef  = do-	-- write the current time into the display state-	displayTime		<- elapsedTime backendRef-	displayTimeLast		<- stateRef `getsIORef` stateDisplayTime-	let displayTimeElapsed	= displayTime - displayTimeLast+        -- write the current time into the display state+        displayTime             <- elapsedTime backendRef+        displayTimeLast         <- stateRef `getsIORef` stateDisplayTime+        let displayTimeElapsed  = displayTime - displayTimeLast -	stateRef `modifyIORef` \s -> s -		{ stateDisplayTime	= displayTime -		, stateDisplayTimeLast	= displayTimeLast }+        stateRef `modifyIORef` \s -> s +                { stateDisplayTime      = displayTime +                , stateDisplayTimeLast  = displayTimeLast } -	-- increment the animation time-	animate         <- stateRef `getsIORef` stateAnimate+        -- increment the animation time+        animate         <- stateRef `getsIORef` stateAnimate         animateCount    <- stateRef `getsIORef` stateAnimateCount-	animateTime	<- stateRef `getsIORef` stateAnimateTime-	animateStart	<- stateRef `getsIORef` stateAnimateStart+        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)-	 $ stateRef `modifyIORef` \s -> s-	       { stateAnimateTime	= animateTime + displayTimeElapsed }-			-	when animate-	 $ stateRef `modifyIORef` \s -> s-	       { stateAnimateCount      = animateCount + 1-               , stateAnimateStart	= False  }+-}      +        when (animate && not animateStart)+         $ stateRef `modifyIORef` \s -> s+               { stateAnimateTime       = animateTime + displayTimeElapsed }+                        +        when animate+         $ stateRef `modifyIORef` \s -> s+               { stateAnimateCount      = animateCount + 1+               , stateAnimateStart      = False  }    -- | Handles animation timing details.---	Call this function at the end of each frame.+--      Call this function at the end of each frame. animateEnd :: IORef State -> DisplayCallback animateEnd stateRef backendRef  = do-	-- timing gate, limits the maximum frame frequency (FPS)-	timeClamp	<- stateRef `getsIORef` stateDisplayTimeClamp+        -- timing gate, limits the maximum frame frequency (FPS)+        timeClamp       <- stateRef `getsIORef` stateDisplayTimeClamp -	gateTimeStart	<- elapsedTime backendRef			-- the start of this gate-	gateTimeEnd	<- stateRef `getsIORef` stateGateTimeEnd	-- end of the previous gate-	let gateTimeElapsed = gateTimeStart - gateTimeEnd+        gateTimeStart   <- elapsedTime backendRef                       -- the start of this gate+        gateTimeEnd     <- stateRef `getsIORef` stateGateTimeEnd        -- end of the previous gate+        let gateTimeElapsed = gateTimeStart - gateTimeEnd -	when (gateTimeElapsed < timeClamp)-	 $ do	sleep backendRef (timeClamp - gateTimeElapsed)+        when (gateTimeElapsed < timeClamp)+         $ do   sleep backendRef (timeClamp - gateTimeElapsed) -	gateTimeFinal	<- elapsedTime backendRef+        gateTimeFinal   <- elapsedTime backendRef -	stateRef `modifyIORef` \s -> s -		{ stateGateTimeEnd	= gateTimeFinal -		, stateGateTimeElapsed	= gateTimeElapsed }+        stateRef `modifyIORef` \s -> s +                { stateGateTimeEnd      = gateTimeFinal +                , stateGateTimeElapsed  = gateTimeElapsed }   getsIORef :: IORef a -> (a -> r) -> IO r

@@ -3,23 +3,23 @@  -- | Callback for exiting the program. module Graphics.Gloss.Internals.Interface.Common.Exit-	(callback_exit)+        (callback_exit) where import Graphics.Gloss.Internals.Interface.Backend.Types  callback_exit :: a -> Callback callback_exit stateRef- =	KeyMouse (keyMouse_exit stateRef)+ =      KeyMouse (keyMouse_exit stateRef)  keyMouse_exit :: a -> KeyboardMouseCallback keyMouse_exit-	_-	backend-	key keyState _-	_-	| key		== SpecialKey KeyEsc-	, keyState	== Down-	= exitBackend backend-		-	| otherwise-	= return ()+        _+        backend+        key keyState _+        _+        | key           == SpecialKey KeyEsc+        , keyState      == Down+        = exitBackend backend+                +        | otherwise+        = return ()

@@ -1,67 +1,67 @@ {-# OPTIONS_HADDOCK hide #-}  -- | Implements functions to dump portions of the OpenGL state to stdout.---	Used for debugging.+--      Used for debugging. module Graphics.Gloss.Internals.Interface.Debug-	( dumpFramebufferState-	, dumpFragmentState )+        ( dumpFramebufferState+        , dumpFragmentState ) where-import qualified Graphics.Rendering.OpenGL.GL	as GL-import Graphics.Rendering.OpenGL		(get)-		+import qualified Graphics.Rendering.OpenGL.GL   as GL+import Graphics.Rendering.OpenGL                (get)+                 -- | Dump internal state of the OpenGL framebuffer dumpFramebufferState :: IO () dumpFramebufferState  = do- 	auxBuffers	<- get GL.auxBuffers-	doubleBuffer	<- get GL.doubleBuffer-	drawBuffer	<- get GL.drawBuffer+        auxBuffers      <- get GL.auxBuffers+        doubleBuffer    <- get GL.doubleBuffer+        drawBuffer      <- get GL.drawBuffer -	rgbaBits	<- get GL.rgbaBits-	stencilBits	<- get GL.stencilBits-	depthBits	<- get GL.depthBits-	accumBits	<- get GL.accumBits-	-	clearColor	<- get GL.clearColor-	clearStencil	<- get GL.clearStencil-	clearDepth	<- get GL.clearDepth-	clearAccum	<- get GL.clearAccum-	-	colorMask	<- get GL.colorMask-	stencilMask	<- get GL.stencilMask-	depthMask	<- get GL.depthMask-	-	putStr	$  "* dumpFramebufferState\n"-		++ "  auxBuffers         = " ++ show auxBuffers		++ "\n"-		++ "  doubleBuffer       = " ++ show doubleBuffer	++ "\n"-		++ "  drawBuffer         = " ++ show drawBuffer		++ "\n"-		++ "\n"-		++ "  bits       rgba    = " ++ show rgbaBits		++ "\n"-		++ "             stencil = " ++ show stencilBits	++ "\n"-		++ "             depth   = " ++ show depthBits		++ "\n"-		++ "             accum   = " ++ show accumBits		++ "\n"-		++ "\n"-		++ "  clear      color   = " ++ show clearColor		++ "\n"-		++ "             stencil = " ++ show clearStencil	++ "\n"-		++ "             depth   = " ++ show clearDepth		++ "\n"-		++ "             accum   = " ++ show clearAccum		++ "\n"-		++ "\n"-		++ "  mask       color   = " ++ show colorMask		++ "\n"-		++ "             stencil = " ++ show stencilMask	++ "\n"-		++ "             depth   = " ++ show depthMask		++ "\n"-		++ "\n"-		+        rgbaBits        <- get GL.rgbaBits+        stencilBits     <- get GL.stencilBits+        depthBits       <- get GL.depthBits+        accumBits       <- get GL.accumBits+        +        clearColor      <- get GL.clearColor+        clearStencil    <- get GL.clearStencil+        clearDepth      <- get GL.clearDepth+        clearAccum      <- get GL.clearAccum+        +        colorMask       <- get GL.colorMask+        stencilMask     <- get GL.stencilMask+        depthMask       <- get GL.depthMask+        +        putStr  $  "* dumpFramebufferState\n"+                ++ "  auxBuffers         = " ++ show auxBuffers         ++ "\n"+                ++ "  doubleBuffer       = " ++ show doubleBuffer       ++ "\n"+                ++ "  drawBuffer         = " ++ show drawBuffer         ++ "\n"+                ++ "\n"+                ++ "  bits       rgba    = " ++ show rgbaBits           ++ "\n"+                ++ "             stencil = " ++ show stencilBits        ++ "\n"+                ++ "             depth   = " ++ show depthBits          ++ "\n"+                ++ "             accum   = " ++ show accumBits          ++ "\n"+                ++ "\n"+                ++ "  clear      color   = " ++ show clearColor         ++ "\n"+                ++ "             stencil = " ++ show clearStencil       ++ "\n"+                ++ "             depth   = " ++ show clearDepth         ++ "\n"+                ++ "             accum   = " ++ show clearAccum         ++ "\n"+                ++ "\n"+                ++ "  mask       color   = " ++ show colorMask          ++ "\n"+                ++ "             stencil = " ++ show stencilMask        ++ "\n"+                ++ "             depth   = " ++ show depthMask          ++ "\n"+                ++ "\n"+                  -- | Dump internal state of the fragment renderer. dumpFragmentState :: IO () dumpFragmentState  = do- 	blend		<- get GL.blend-	blendEquation	<- get GL.blendEquation-	blendFunc	<- get GL.blendFunc-	-	putStr	$  "* dumpFragmentState\n"-		++ "  blend              = " ++ show blend		++ "\n"-		++ "  blend equation     = " ++ show blendEquation	++ "\n"-		++ "  blend func         = " ++ show blendFunc		++ "\n"-		++ "\n"+        blend           <- get GL.blend+        blendEquation   <- get GL.blendEquation+        blendFunc       <- get GL.blendFunc+        +        putStr  $  "* dumpFragmentState\n"+                ++ "  blend              = " ++ show blend              ++ "\n"+                ++ "  blend equation     = " ++ show blendEquation      ++ "\n"+                ++ "  blend func         = " ++ show blendFunc          ++ "\n"+                ++ "\n"

@@ -1,7 +1,7 @@  module Graphics.Gloss.Internals.Interface.Display-	(displayWithBackend)-where	+        (displayWithBackend)+where    import Graphics.Gloss.Data.Color import Graphics.Gloss.Data.Picture import Graphics.Gloss.Data.ViewPort@@ -15,27 +15,26 @@ import Graphics.Gloss.Internals.Interface.ViewState.Reshape import qualified Graphics.Gloss.Internals.Interface.Callback as Callback import Data.IORef-import Data.Functor import System.Mem   displayWithBackend-	:: Backend a-	=> a                -- ^ Initial state of the backend.+        :: Backend a+        => a                -- ^ Initial state of the backend.         -> Display          -- ^ Display config.-	-> Color            -- ^ Background color.-	-> Picture          -- ^ The picture to draw.-	-> IO ()+        -> Color            -- ^ Background color.+        -> Picture          -- ^ The picture to draw.+        -> IO ()  displayWithBackend backend displayMode background picture- =  do	viewSR		<- newIORef viewStateInit+ =  do  viewSR          <- newIORef viewStateInit          renderS         <- initState-	renderSR	<- newIORef renderS-	-	let renderFun backendRef = do-		port      <- viewStateViewPort <$> readIORef viewSR-		options	  <- readIORef renderSR+        renderSR        <- newIORef renderS+        +        let renderFun backendRef = do+                port      <- viewStateViewPort <$> readIORef viewSR+                options   <- readIORef renderSR                 windowSize <- getWindowDimensions backendRef                  displayPicture @@ -48,15 +47,15 @@                 -- perform GC every frame to try and avoid long pauses                 performGC -	let callbacks-	     =	[ Callback.Display renderFun +        let callbacks+             =  [ Callback.Display renderFun  -		-- Escape exits the program-		, callback_exit () -		-		-- Viewport control with mouse-		, callback_viewState_keyMouse viewSR-		, callback_viewState_motion   viewSR-		, callback_viewState_reshape ]+                -- Escape exits the program+                , callback_exit () +                +                -- Viewport control with mouse+                , callback_viewState_keyMouse viewSR+                , callback_viewState_motion   viewSR+                , callback_viewState_reshape ] -	createWindow backend displayMode background callbacks+        createWindow backend displayMode background callbacks

@@ -1,53 +1,52 @@ {-# LANGUAGE RankNTypes #-} module Graphics.Gloss.Internals.Interface.Event         ( Event (..)-	, keyMouseEvent-	, motionEvent )+        , keyMouseEvent+        , motionEvent ) where import Data.IORef-import Data.Functor ((<$>)) import Graphics.Gloss.Internals.Interface.Backend  -- | Possible input events. data Event-	= EventKey    Key KeyState Modifiers (Float, Float)-	| EventMotion (Float, Float)+        = EventKey    Key KeyState Modifiers (Float, Float)+        | EventMotion (Float, Float)         | EventResize (Int, Int)-	deriving (Eq, Show)+        deriving (Eq, Show)  keyMouseEvent ::-	forall a . Backend a-	=> IORef a-	-> Key-	-> KeyState-	-> Modifiers-	-> (Int, Int)-	-> IO Event+        forall a . Backend a+        => IORef a+        -> Key+        -> KeyState+        -> Modifiers+        -> (Int, Int)+        -> IO Event keyMouseEvent backendRef key keyState modifiers pos-	= EventKey key keyState modifiers <$> convertPoint backendRef pos+        = EventKey key keyState modifiers <$> convertPoint backendRef pos  motionEvent ::-	forall a . Backend a-	=> IORef a-	-> (Int, Int)-	-> IO Event+        forall a . Backend a+        => IORef a+        -> (Int, Int)+        -> IO Event motionEvent backendRef pos-	= EventMotion <$> convertPoint backendRef pos+        = EventMotion <$> convertPoint backendRef pos  convertPoint ::-	forall a . Backend a-	=> IORef a-	-> (Int, Int)-	-> IO (Float,Float)+        forall a . Backend a+        => IORef a+        -> (Int, Int)+        -> IO (Float,Float) convertPoint backendRef pos- = do	(sizeX_, sizeY_) 	<- getWindowDimensions backendRef-	let (sizeX, sizeY)	= (fromIntegral sizeX_, fromIntegral sizeY_)+ = do   (sizeX_, sizeY_)        <- getWindowDimensions backendRef+        let (sizeX, sizeY)      = (fromIntegral sizeX_, fromIntegral sizeY_) -	let (px_, py_)		= pos-	let px			= fromIntegral px_-	let py			= sizeY - fromIntegral py_-	-	let px'			= px - sizeX / 2-	let py' 		= py - sizeY / 2-	let pos'		= (px', py')-	return pos'+        let (px_, py_)          = pos+        let px                  = fromIntegral px_+        let py                  = sizeY - fromIntegral py_+        +        let px'                 = px - sizeX / 2+        let py'                 = py - sizeY / 2+        let pos'                = (px', py')+        return pos'

@@ -20,7 +20,6 @@ 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 

@@ -2,97 +2,97 @@ {-# LANGUAGE RankNTypes #-}  module Graphics.Gloss.Internals.Interface.Simulate.Idle-	( callback_simulate_idle )+        ( callback_simulate_idle ) where import Graphics.Gloss.Data.ViewPort import Graphics.Gloss.Internals.Interface.Callback-import qualified Graphics.Gloss.Internals.Interface.Backend		as Backend-import qualified Graphics.Gloss.Internals.Interface.Animate.State	as AN-import qualified Graphics.Gloss.Internals.Interface.Simulate.State	as SM+import qualified Graphics.Gloss.Internals.Interface.Backend             as Backend+import qualified Graphics.Gloss.Internals.Interface.Animate.State       as AN+import qualified Graphics.Gloss.Internals.Interface.Simulate.State      as SM import Data.IORef import Control.Monad import GHC.Float (double2Float)   -- | The graphics library calls back on this function when it's finished drawing---	and it's time to do some computation.+--      and it's time to do some computation. callback_simulate_idle-	:: IORef SM.State				-- ^ the simulation state-	-> IORef AN.State				-- ^ the animation statea-	-> IO ViewPort+        :: IORef SM.State                               -- ^ the simulation state+        -> IORef AN.State                               -- ^ the animation statea+        -> IO ViewPort         -- ^ action to get the 'ViewPort'.  We don't use an 'IORef'         -- directly because sometimes we hold a ref to a 'ViewPort' (in         -- Game) and sometimes a ref to a 'ViewState'.-	-> IORef world					-- ^ the current world-	-> (ViewPort -> Float -> world -> IO world) 	-- ^ fn to advance the world-	-> Float					-- ^ how much time to advance world by -							--	in single step mode-	-> IdleCallback-	+        -> IORef world                                  -- ^ the current world+        -> (ViewPort -> Float -> world -> IO world)     -- ^ fn to advance the world+        -> Float                                        -- ^ how much time to advance world by +                                                        --      in single step mode+        -> IdleCallback+         callback_simulate_idle simSR animateSR viewSA worldSR worldAdvance _singleStepTime backendRef  = {-# SCC "callbackIdle" #-}-   do	simulate_run simSR animateSR viewSA worldSR worldAdvance backendRef+   do   simulate_run simSR animateSR viewSA worldSR worldAdvance backendRef    -- take the number of steps specified by controlWarp simulate_run -	:: IORef SM.State-	-> IORef AN.State-	-> IO ViewPort-	-> IORef world-	-> (ViewPort -> Float -> world -> IO world)-	-> IdleCallback-	+        :: IORef SM.State+        -> IORef AN.State+        -> IO ViewPort+        -> IORef world+        -> (ViewPort -> Float -> world -> IO world)+        -> IdleCallback+         simulate_run simSR _ viewSA worldSR worldAdvance backendRef- = do	viewS		<- viewSA-	simS		<- readIORef simSR-	worldS		<- readIORef worldSR+ = do   viewS           <- viewSA+        simS            <- readIORef simSR+        worldS          <- readIORef worldSR -	-- get the elapsed time since the start simulation (wall clock)- 	elapsedTime	<- fmap double2Float $ Backend.elapsedTime backendRef+        -- get the elapsed time since the start simulation (wall clock)+        elapsedTime     <- fmap double2Float $ Backend.elapsedTime backendRef -	-- get how far along the simulation is-	simTime			<- simSR `getsIORef` SM.stateSimTime+        -- get how far along the simulation is+        simTime                 <- simSR `getsIORef` SM.stateSimTime  - 	-- we want to simulate this much extra time to bring the simulation-	--	up to the wall clock.-	let thisTime	= elapsedTime - simTime-	 -	-- work out how many steps of simulation this equals-	resolution	<- simSR `getsIORef` SM.stateResolution-	let timePerStep	= 1 / fromIntegral resolution-	let thisSteps_	= truncate $ fromIntegral resolution * thisTime-	let thisSteps	= if thisSteps_ < 0 then 0 else thisSteps_+        -- we want to simulate this much extra time to bring the simulation+        --      up to the wall clock.+        let thisTime    = elapsedTime - simTime+         +        -- work out how many steps of simulation this equals+        resolution      <- simSR `getsIORef` SM.stateResolution+        let timePerStep = 1 / fromIntegral resolution+        let thisSteps_  = truncate $ fromIntegral resolution * thisTime+        let thisSteps   = if thisSteps_ < 0 then 0 else thisSteps_ -	let newSimTime	= simTime + fromIntegral thisSteps * timePerStep-	 -{-	putStr	$  "elapsed time    = " ++ show elapsedTime 	++ "\n"-		++ "sim time        = " ++ show simTime		++ "\n"-		++ "this time       = " ++ show thisTime	++ "\n"-		++ "this steps      = " ++ show thisSteps	++ "\n"-		++ "new sim time    = " ++ show newSimTime	++ "\n"-		++ "taking          = " ++ show thisSteps	++ "\n\n"+        let newSimTime  = simTime + fromIntegral thisSteps * timePerStep+         +{-      putStr  $  "elapsed time    = " ++ show elapsedTime     ++ "\n"+                ++ "sim time        = " ++ show simTime         ++ "\n"+                ++ "this time       = " ++ show thisTime        ++ "\n"+                ++ "this steps      = " ++ show thisSteps       ++ "\n"+                ++ "new sim time    = " ++ show newSimTime      ++ "\n"+                ++ "taking          = " ++ show thisSteps       ++ "\n\n" -}- 	-- work out the final step number for this display cycle-	let nStart	= SM.stateIteration simS-	let nFinal 	= nStart + thisSteps+        -- work out the final step number for this display cycle+        let nStart      = SM.stateIteration simS+        let nFinal      = nStart + thisSteps -	-- keep advancing the world until we get to the final iteration number-	(_,world') <- untilM 	(\(n, _) 	-> n >= nFinal)-				(\(n, w)	-> liftM (\w' -> (n+1,w')) ( worldAdvance viewS timePerStep w))-				(nStart, worldS)+        -- keep advancing the world until we get to the final iteration number+        (_,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'+        -- 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' -	-- update the control state-	simSR `modifyIORef` \c -> c-		{ SM.stateIteration	= nFinal-		, SM.stateSimTime	= newSimTime }-	-	-- tell glut we want to draw the window after returning-	Backend.postRedisplay backendRef+        -- update the control state+        simSR `modifyIORef` \c -> c+                { SM.stateIteration     = nFinal+                , SM.stateSimTime       = newSimTime }+        +        -- tell glut we want to draw the window after returning+        Backend.postRedisplay backendRef   getsIORef :: IORef a -> (a -> r) -> IO r@@ -104,4 +104,4 @@   where   go x | test x    = return x        | otherwise = op x >>= go-	+        

@@ -1,29 +1,29 @@ {-# OPTIONS_HADDOCK hide #-}  module Graphics.Gloss.Internals.Interface.Simulate.State-	( State (..)-	, stateInit )+        ( State (..)+        , stateInit ) where  -- | Simulation state-data State	- = 	State-	{ -- | The iteration number we're up to.-	  stateIteration	:: !Integer+data State      + =      State+        { -- | The iteration number we're up to.+          stateIteration        :: !Integer -	-- | How many simulation setps to take for each second of real time-	, stateResolution	:: !Int -	-	-- | How many seconds worth of simulation we've done so far-	, stateSimTime		:: !Float  }-	+        -- | How many simulation setps to take for each second of real time+        , stateResolution       :: !Int +        +        -- | How many seconds worth of simulation we've done so far+        , stateSimTime          :: !Float  }+          -- | Initial control state stateInit :: Int -> State stateInit resolution- 	= State- 	{ stateIteration		= 0-	, stateResolution		= resolution -	, stateSimTime			= 0 }-	-	+        = State+        { stateIteration                = 0+        , stateResolution               = resolution +        , stateSimTime                  = 0 }+        +        

@@ -2,7 +2,7 @@ {-# LANGUAGE RankNTypes #-}  module Graphics.Gloss.Internals.Interface.ViewState.KeyMouse-	(callback_viewState_keyMouse)+        (callback_viewState_keyMouse) where import Graphics.Gloss.Data.ViewState import Graphics.Gloss.Internals.Interface.Backend@@ -11,22 +11,22 @@   -- | Callback to handle keyboard and mouse button events---	for controlling the 'ViewState'.+--      for controlling the 'ViewState'. callback_viewState_keyMouse -	:: IORef ViewState-	-> Callback+        :: IORef ViewState+        -> Callback  callback_viewState_keyMouse viewStateRef- 	= KeyMouse (viewState_keyMouse viewStateRef)+        = KeyMouse (viewState_keyMouse viewStateRef)   viewState_keyMouse :: IORef ViewState -> KeyboardMouseCallback viewState_keyMouse viewStateRef stateRef key keyState keyMods pos- = do	viewState <- readIORef viewStateRef-	ev	  <- keyMouseEvent stateRef key keyState keyMods pos+ = do   viewState <- readIORef viewStateRef+        ev        <- keyMouseEvent stateRef key keyState keyMods pos         case updateViewStateWithEventMaybe ev viewState of-		Nothing -> return ()-		Just viewState' -                 -> do	viewStateRef `writeIORef` viewState'-			postRedisplay stateRef+                Nothing -> return ()+                Just viewState' +                 -> do  viewStateRef `writeIORef` viewState'+                        postRedisplay stateRef 

@@ -2,7 +2,7 @@ {-# LANGUAGE ScopedTypeVariables, RankNTypes #-}  module Graphics.Gloss.Internals.Interface.ViewState.Motion-	(callback_viewState_motion)+        (callback_viewState_motion) where import Graphics.Gloss.Data.ViewState import Graphics.Gloss.Internals.Interface.Callback@@ -12,23 +12,23 @@   -- | Callback to handle keyboard and mouse button events---	for controlling the viewport.+--      for controlling the viewport. callback_viewState_motion -	:: IORef ViewState-	-> Callback+        :: IORef ViewState+        -> Callback  callback_viewState_motion portRef- 	= Motion (viewState_motion portRef)+        = Motion (viewState_motion portRef)   viewState_motion :: IORef ViewState -> MotionCallback viewState_motion viewStateRef stateRef pos- = do	viewState <- readIORef viewStateRef-	ev        <- motionEvent stateRef pos+ = do   viewState <- readIORef viewStateRef+        ev        <- motionEvent stateRef pos         case updateViewStateWithEventMaybe ev viewState of-		Nothing -> return ()-		Just viewState' -                 -> do	viewStateRef `writeIORef` viewState'-			postRedisplay stateRef+                Nothing -> return ()+                Just viewState' +                 -> do  viewStateRef `writeIORef` viewState'+                        postRedisplay stateRef  

@@ -1,28 +1,28 @@ {-# OPTIONS_HADDOCK hide #-}  module Graphics.Gloss.Internals.Interface.ViewState.Reshape-	(callback_viewState_reshape, viewState_reshape)+        (callback_viewState_reshape, viewState_reshape) where import Graphics.Gloss.Internals.Interface.Callback import Graphics.Gloss.Internals.Interface.Backend-import Graphics.Rendering.OpenGL			(($=))-import qualified Graphics.Rendering.OpenGL.GL		as GL+import Graphics.Rendering.OpenGL                        (($=))+import qualified Graphics.Rendering.OpenGL.GL           as GL   -- | Callback to handle keyboard and mouse button events---	for controlling the viewport.+--      for controlling the viewport. callback_viewState_reshape :: Callback callback_viewState_reshape- 	= Reshape (viewState_reshape)+        = Reshape (viewState_reshape)   viewState_reshape :: ReshapeCallback viewState_reshape stateRef (width,height)  = do-	-- Setup the viewport-	--	This controls what part of the window openGL renders to.-	--	We'll use the whole window.-	--- 	GL.viewport 	$= ( GL.Position 0 0+        -- Setup the viewport+        --      This controls what part of the window openGL renders to.+        --      We'll use the whole window.+        --+        GL.viewport     $= ( GL.Position 0 0                            , GL.Size (fromIntegral width) (fromIntegral height))-	postRedisplay stateRef+        postRedisplay stateRef

@@ -1,79 +1,79 @@ {-# OPTIONS_HADDOCK hide #-} --- | 	The main display function.-module	Graphics.Gloss.Internals.Interface.Window-	( createWindow )+-- |    The main display function.+module  Graphics.Gloss.Internals.Interface.Window+        ( createWindow ) where import Graphics.Gloss.Data.Color import Graphics.Gloss.Internals.Color import Graphics.Gloss.Internals.Interface.Backend import Graphics.Gloss.Internals.Interface.Debug-import Graphics.Rendering.OpenGL			(($=))-import qualified Graphics.Rendering.OpenGL.GL		as GL+import Graphics.Rendering.OpenGL                        (($=))+import qualified Graphics.Rendering.OpenGL.GL           as GL import Data.IORef (newIORef) import Control.Monad  -- | Open a window and use the supplied callbacks to handle window events. createWindow-	:: Backend a-	=> a+        :: Backend a+        => a         -> Display-	-> Color		-- ^ Color to use when clearing.-	-> [Callback]		-- ^ Callbacks to use-	-> IO ()+        -> Color                -- ^ Color to use when clearing.+        -> [Callback]           -- ^ Callbacks to use+        -> IO ()  createWindow-	backend+        backend         display-	clearColor-	callbacks+        clearColor+        callbacks  = do-	-- Turn this on to spew debugging info to stdout-	let debug	= False+        -- Turn this on to spew debugging info to stdout+        let debug       = False -	-- Initialize backend state-	backendStateRef <- newIORef backend+        -- Initialize backend state+        backendStateRef <- newIORef backend -	when debug-	 $ do 	putStr	$ "* displayInWindow\n"+        when debug+         $ do   putStr  $ "* displayInWindow\n" -	-- Intialize backend-	initializeBackend backendStateRef debug+        -- Intialize backend+        initializeBackend backendStateRef debug -	-- Here we go!-	when debug-	 $ do	putStr	$ "* c window\n\n"+        -- Here we go!+        when debug+         $ do   putStr  $ "* c window\n\n" -	-- Open window-	openWindow backendStateRef display+        -- Open window+        openWindow backendStateRef display -	-- Setup callbacks-	installDisplayCallback     backendStateRef callbacks-	installWindowCloseCallback backendStateRef-	installReshapeCallback     backendStateRef callbacks-	installKeyMouseCallback    backendStateRef callbacks-	installMotionCallback      backendStateRef callbacks-	installIdleCallback        backendStateRef callbacks+        -- Setup callbacks+        installDisplayCallback     backendStateRef callbacks+        installWindowCloseCallback backendStateRef+        installReshapeCallback     backendStateRef callbacks+        installKeyMouseCallback    backendStateRef callbacks+        installMotionCallback      backendStateRef callbacks+        installIdleCallback        backendStateRef callbacks -	-- we don't need the depth buffer for 2d.-	GL.depthFunc	$= Just GL.Always+        -- we don't need the depth buffer for 2d.+        GL.depthFunc    $= Just GL.Always -	-- always clear the buffer to white-	GL.clearColor	$= glColor4OfColor clearColor+        -- always clear the buffer to white+        GL.clearColor   $= glColor4OfColor clearColor -	-- Dump some debugging info-	when debug-	 $ do	dumpBackendState backendStateRef-		dumpFramebufferState-		dumpFragmentState+        -- Dump some debugging info+        when debug+         $ do   dumpBackendState backendStateRef+                dumpFramebufferState+                dumpFragmentState -	when debug-	 $ do	putStr	$ "* entering mainloop..\n"+        when debug+         $ do   putStr  $ "* entering mainloop..\n" -	-- Start the main backend loop-	runMainLoop backendStateRef+        -- Start the main backend loop+        runMainLoop backendStateRef -	when debug-	 $	putStr	$ "* all done\n"+        when debug+         $      putStr  $ "* all done\n" -	return ()+        return ()

@@ -1,5 +1,5 @@ Name:                gloss-Version:             1.9.2.1+Version:             1.9.3.1 License:             MIT License-file:        LICENSE Author:              Ben Lippmeier@@ -37,14 +37,14 @@  Library   Build-Depends: -        base       == 4.7.*,-        ghc-prim   == 0.3.*,+        base       == 4.8.*,+        ghc-prim   == 0.4.*,         containers == 0.5.*,         bytestring == 0.10.*,-        OpenGL     == 2.9.*,-        GLUT       == 2.5.*,+        OpenGL     == 2.12.*,+        GLUT       == 2.7.*,         bmp        == 1.2.*,-        gloss-rendering == 1.9.2.*+        gloss-rendering == 1.9.3.*    ghc-options:         -O2 -Wall