gloss 1.8.2.2 → 1.9.1.1

raw patch · 25 files changed

+40/−2512 lines, 25 filesdep +gloss-renderingPVP ok

version bump matches the API change (PVP)

Dependencies added: gloss-rendering

API changes (from Hackage documentation)

Files

• Graphics/Gloss.hs +10/−5
• Graphics/Gloss/Data/Color.hs +0/−237
• Graphics/Gloss/Data/Display.hs +0/−13
• Graphics/Gloss/Data/Extent.hs +0/−195
• Graphics/Gloss/Data/Picture.hs +0/−351
• Graphics/Gloss/Data/Point.hs +0/−51
• Graphics/Gloss/Data/Quad.hs +0/−17
• Graphics/Gloss/Data/QuadTree.hs +0/−191
• Graphics/Gloss/Data/Vector.hs +0/−91
• Graphics/Gloss/Data/ViewPort.hs +0/−57
• Graphics/Gloss/Geometry.hs +0/−8
• Graphics/Gloss/Geometry/Angle.hs +0/−25
• Graphics/Gloss/Geometry/Line.hs +0/−326
• Graphics/Gloss/Internals/Interface/Animate.hs +5/−4
• Graphics/Gloss/Internals/Interface/Display.hs +4/−4
• Graphics/Gloss/Internals/Interface/Game.hs +7/−6
• Graphics/Gloss/Internals/Interface/Simulate.hs +6/−5
• Graphics/Gloss/Internals/Interface/Simulate/Idle.hs +3/−54
• Graphics/Gloss/Internals/Interface/Simulate/State.hs +2/−18
• Graphics/Gloss/Internals/Render/Bitmap.hs +0/−86
• Graphics/Gloss/Internals/Render/Circle.hs +0/−246
• Graphics/Gloss/Internals/Render/Common.hs +0/−51
• Graphics/Gloss/Internals/Render/Picture.hs +0/−382
• Graphics/Gloss/Internals/Render/State.hs +0/−69
• gloss.cabal +3/−20

@@ -34,13 +34,18 @@ --   To build gloss using the GLFW window manager instead of GLUT use --        @cabal install gloss --flags=\"GLFW -GLUT\"@ ----- @Release Notes:+-- @+-- Release Notes: ----- For 1.8.0+-- For 1.9:+--  Thanks to Elise Huard+--   * Split rendering code into gloss-rendering package.+--+-- For 1.8 --  Thanks to Francesco Mazzoli --   * Factored out ViewPort and ViewState handling into user visible modules. ----- For 1.7.0:+-- For 1.7: --   * Tweaked circle level-of-detail reduction code. --   * Increased frame rate cap to 100hz. --   Thanks to Doug Burke@@ -48,11 +53,11 @@ --   Thanks to Thomas DuBuisson --   * IO versions of animate, simplate and play. ----- For 1.6.0:+-- For 1.6: --   Thanks to Anthony Cowley --   * Full screen display mode. -- --- For 1.5.0:+-- For 1.5: --   * O(1) Conversion of ForeignPtrs to bitmaps. --   * An extra flag on the Bitmap constructor allows bitmaps to be cached --     in texture memory between frames.

@@ -1,237 +0,0 @@---- | Predefined and custom colors.-module Graphics.Gloss.Data.Color-	( -	-- ** Color data type-	  Color-	, makeColor-        , makeColor'-        , makeColor8-	, rawColor-	, 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 Data.Data----- | An abstract color value.---	We keep the type abstract so we can be sure that the components---	are in the required range. To make a custom color use 'makeColor'.-data Color-	-- | Holds the color components. All components lie in the range [0..1.-	= RGBA  !Float !Float !Float !Float-	deriving (Show, Eq, Data, Typeable)---instance Num Color where- {-# INLINE (+) #-}- (+) (RGBA r1 g1 b1 _) (RGBA r2 g2 b2 _)-        = RGBA (r1 + r2) (g1 + g2) (b1 + b2) 1-- {-# INLINE (-) #-}- (-) (RGBA r1 g1 b1 _) (RGBA r2 g2 b2 _)-        = RGBA (r1 - r2) (g1 - g2) (b1 - b2) 1-- {-# INLINE (*) #-}- (*) (RGBA r1 g1 b1 _) (RGBA r2 g2 b2 _)-        = RGBA (r1 * r2) (g1 * g2) (b1 * b2) 1-- {-# INLINE abs #-}- abs (RGBA r1 g1 b1 _)-        = RGBA (abs r1) (abs g1) (abs b1) 1-- {-# INLINE signum #-}- signum (RGBA r1 g1 b1 _)-        = RGBA (signum r1) (signum g1) (signum b1) 1-        - {-# INLINE fromInteger #-}- fromInteger i-  = let f = fromInteger i-    in  RGBA f f f 1----- | Make a custom color. All components are clamped to the range  [0..1].-makeColor -	:: Float 	-- ^ Red component.-	-> Float 	-- ^ Green component.-	-> Float 	-- ^ Blue component.-	-> Float 	-- ^ Alpha component.-	-> Color--makeColor r g b a-	= clampColor -	$ RGBA r g b a-{-# INLINE makeColor #-}----- | Make a custom color. ---   You promise that all components are clamped to the range [0..1]-makeColor' :: Float -> Float -> Float -> Float -> Color-makeColor' r g b a-        = RGBA r g b a-{-# INLINE makeColor' #-}----- | Make a custom color. All components are clamped to the range [0..255].-makeColor8 -	:: Int 		-- ^ Red component.-	-> Int 		-- ^ Green component.-	-> Int 		-- ^ Blue component.-	-> Int 		-- ^ Alpha component.-	-> Color--makeColor8 r g b a-	= clampColor -	$ RGBA 	(fromIntegral r / 255) -		(fromIntegral g / 255)-		(fromIntegral b / 255)-		(fromIntegral a / 255)-{-# INLINE makeColor8 #-}--	--- | Take the RGBA components of a color.-rgbaOfColor :: Color -> (Float, Float, Float, Float)-rgbaOfColor (RGBA r g b a)	= (r, g, b, a)-{-# INLINE rgbaOfColor #-}-		---- | Make a custom color.---   Components should be in the range [0..1] but this is not checked.-rawColor-	:: Float	-- ^ Red component.-	-> Float	-- ^ Green component.-	-> Float 	-- ^ Blue component.-	-> Float 	-- ^ Alpha component.-	-> Color--rawColor = RGBA-{-# INLINE rawColor #-}----- Internal ---- | Clamp components of a color into the required range.-clampColor :: Color -> Color-clampColor cc- = let	(r, g, b, a)	= rgbaOfColor cc-   in	RGBA (min 1 r) (min 1 g) (min 1 b) (min 1 a)---- | Normalise a color to the value of its largest RGB component.-normaliseColor :: Color -> Color-normaliseColor cc- = let	(r, g, b, a)	= rgbaOfColor cc-	m		= maximum [r, g, b]-   in	RGBA (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	RGBA r1 g1 b1 a1	= c1-	RGBA r2 g2 b2 a2	= c2--	total	= ratio1 + ratio2-	m1	= ratio1 / total-	m2	= ratio2 / total--   in	RGBA 	(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	RGBA r1 g1 b1 a1	= c1-	RGBA r2 g2 b2 a2	= c2--   in	normaliseColor -	 $ RGBA (r1 + r2)-		(g1 + g2)-		(b1 + b2)-		((a1 + a2) / 2)----- | Make a dimmer version of a color, scaling towards black.-dim :: Color -> Color-dim (RGBA r g b a)-	= RGBA (r / 1.2) (g / 1.2) (b / 1.2) a--	--- | Make a brighter version of a color, scaling towards white.-bright :: Color -> Color-bright (RGBA r g b a)-	= clampColor-	$ RGBA (r * 1.2) (g * 1.2) (b * 1.2) a----- | Lighten a color, adding white.-light :: Color -> Color-light (RGBA r g b a)-	= clampColor-	$ RGBA (r + 0.2) (g + 0.2) (b + 0.2) a-	-	--- | Darken a color, adding black.-dark :: Color -> Color-dark (RGBA r g b a)-	= clampColor-	$ RGBA (r - 0.2) (g - 0.2) (b - 0.2) a----- Pre-defined Colors ------------------------------------------------------------ | A greyness of a given magnitude.-greyN 	:: Float 	-- ^ Range is 0 = black, to 1 = white.-	-> Color-greyN n		= RGBA n   n   n   1.0--black, white :: Color-black		= RGBA 0.0 0.0 0.0 1.0-white		= RGBA 1.0 1.0 1.0 1.0---- Colors from the additive color wheel.-red, green, blue :: Color-red		= RGBA 1.0 0.0 0.0 1.0-green		= RGBA 0.0 1.0 0.0 1.0-blue		= RGBA 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

@@ -1,13 +0,0 @@--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)

@@ -1,195 +0,0 @@-{-# LANGUAGE PatternGuards #-}---- | Represents an integral rectangular area of the 2D plane.---   Using `Int`s (instead of `Float`s) for the bounds means we can safely---   compare extents for equality.-module Graphics.Gloss.Data.Extent-	( Extent-	, Coord-	, makeExtent-	, takeExtent-	, squareExtent-	, sizeOfExtent-	, isUnitExtent-	, coordInExtent-	, pointInExtent-	, centerCoordOfExtent-	, cutQuadOfExtent-	, quadOfCoord-	, pathToCoord-	, intersectSegExtent-	, touchesSegExtent)-where-import Graphics.Gloss.Data.Point-import Graphics.Gloss.Data.Quad-import Graphics.Gloss.Geometry.Line-import Data.Maybe----- | A rectangular area of the 2D plane.---   We keep the type abstract to ensure that invalid extents cannot be---   constructed.-data Extent-	= Extent Int Int Int Int-	deriving (Eq, Show)----- | An integral coordinate.-type Coord-	= (Int, Int)----- | Construct an extent.---	The north value must be > south, and east > west, else `error`.-makeExtent -	:: Int 	-- ^ y max (north)-	-> Int 	-- ^ y min (south)-	-> Int 	-- ^ x max (east)-	-> Int 	-- ^ x min (west)-	-> Extent--makeExtent n s e w-	| n >= s, e >= w-	= Extent n s e w-	-	| otherwise-	= error "Graphics.Gloss.Geometry.Extent.makeExtent: invalid extent"----- | Take the NSEW components of an extent.-takeExtent :: Extent -> (Int, Int, Int, Int)-takeExtent (Extent n s e w)-	= (n, s, e, w)----- | A square extent of a given size.-squareExtent :: Int -> Extent-squareExtent i-	= Extent i 0 i 0----- | Get the width and height of an extent.-sizeOfExtent :: Extent -> (Int, Int)-sizeOfExtent (Extent n s e w)-	= (e - w, n - s)----- | Check if an extent is a square with a width and height of 1.-isUnitExtent :: Extent -> Bool-isUnitExtent extent-	= sizeOfExtent extent == (1, 1)----- | Check whether a coordinate lies inside an extent.-coordInExtent :: Extent -> Coord -> Bool-coordInExtent (Extent n s e w) (x, y)-	=  x >= w && x < e-	&& y >= s && y < n----- | Check whether a point lies inside an extent.-pointInExtent :: Extent -> Point -> Bool-pointInExtent (Extent n s e w) (x, y)- = let	n'	= fromIntegral n-	s'	= fromIntegral s-	e'	= fromIntegral e-	w'	= fromIntegral w-	-   in	x >= w' && x <= e'-     && y >= s' && y <= n'----- | Get the coordinate that lies at the center of an extent.-centerCoordOfExtent :: Extent -> (Int, Int)-centerCoordOfExtent (Extent n s e w)- = 	( w + (e - w) `div` 2-	, s + (n - s) `div` 2)----- | Cut one quadrant out of an extent.-cutQuadOfExtent :: Quad -> Extent -> Extent-cutQuadOfExtent quad (Extent n s e w)  - = let	hheight	= (n - s) `div` 2-	hwidth	= (e - w) `div` 2-   in	case quad of-	  	NW -> Extent n (s + hheight)  (e - hwidth) w-		NE -> Extent n (s + hheight)  e (w + hwidth)-		SW -> Extent (n - hheight) s  (e - hwidth) w-		SE -> Extent (n - hheight) s  e (w + hwidth)-	-	--- | Get the quadrant that this coordinate lies in, if any.-quadOfCoord :: Extent -> Coord -> Maybe Quad-quadOfCoord extent coord- 	= listToMaybe -	$ filter (\q -> coordInExtent (cutQuadOfExtent q extent) coord)-	$ allQuads--	--- | Constuct a path to a particular coordinate in an extent.-pathToCoord :: Extent -> Coord -> Maybe [Quad]-pathToCoord extent coord-	| isUnitExtent extent	-	= Just []-	-	| otherwise-	= do	quad	<- quadOfCoord extent coord-		rest	<- pathToCoord (cutQuadOfExtent quad extent) coord-		return	$ quad : rest----- | If a line segment (P1-P2) intersects the outer edge of an extent then---   return the intersection point, that is closest to P1, if any.---   If P1 is inside the extent then `Nothing`.------   @---                   P2---                  /---            ----/----            | /  |---            +    |---           /---------         / ---        P1---   @--- -intersectSegExtent :: Point -> Point -> Extent -> Maybe Point-intersectSegExtent p1@(x1, y1) p2 (Extent n' s' e' w')-	-- starts below extent-	| y1 < s-	, Just pos	<- intersectSegHorzSeg p1 p2 s w e-	= Just pos-	-	-- starts above extent-	| y1 > n-	, Just pos	<- intersectSegHorzSeg p1 p2 n w e-	= Just pos--	-- starts left of extent-	| x1 < w-	, Just pos	<- intersectSegVertSeg p1 p2 w s n-	= Just pos-	-	-- starts right of extent-	| x1 > e-	, Just pos	<- intersectSegVertSeg p1 p2 e s n-	= Just pos--	-- must be starting inside extent.-	| otherwise-	= Nothing-	-	where	n	= fromIntegral n'-		s	= fromIntegral s'-		e	= fromIntegral e'-		w	= fromIntegral w'----- | Check whether a line segment's endpoints are inside an extent, or if it---   intersects with the boundary.-touchesSegExtent :: Point -> Point -> Extent -> Bool-touchesSegExtent p1 p2 extent-	=   pointInExtent extent p1-       	 || pointInExtent extent p2-	 || isJust (intersectSegExtent p1 p2 extent)-

@@ -1,351 +0,0 @@---- | Data types for representing pictures.-module Graphics.Gloss.Data.Picture-	( Point-	, Vector-	, Path-	, Picture(..)-	, BitmapData--	-- * 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--        -- * Loading Bitmaps-        , bitmapOfForeignPtr-        , bitmapOfByteString-        , bitmapOfBMP-        , loadBMP)--where-import Graphics.Gloss.Data.Color-import Graphics.Gloss.Data.Point-import Graphics.Gloss.Data.Vector-import Graphics.Gloss.Geometry.Angle-import Graphics.Gloss.Internals.Render.Bitmap-import Codec.BMP-import Foreign.ForeignPtr-import Foreign.Marshal.Alloc-import Foreign.Marshal.Utils-import Foreign.Ptr-import Data.Word-import Data.Monoid-import Data.ByteString-import Data.Data-import System.IO.Unsafe-import qualified Data.ByteString.Unsafe as BSU-import Prelude hiding (map)---- | A path through the x-y plane.-type Path	= [Point]				----- | A 2D picture-data Picture-	-- Primitives ---------------------------------------	-- | A blank picture, with nothing in it.-	= Blank--	-- | A convex polygon filled with a solid color.-	| Polygon 	Path-	-	-- | A line along an arbitrary path.-	| Line		Path--	-- | A circle with the given radius.-	| Circle	Float--	-- | A circle with the given thickness and radius.-	--   If the thickness is 0 then this is equivalent to `Circle`.-	| ThickCircle	Float Float--	-- | A circular arc drawn counter-clockwise between two angles -        --  (in degrees) at the given radius.-        | Arc           Float Float Float--	-- | A circular arc drawn counter-clockwise between two angles -        --  (in degrees), with the given radius  and thickness.-	--   If the thickness is 0 then this is equivalent to `Arc`.-        | ThickArc	Float Float Float Float--	-- | Some text to draw with a vector font.-	| Text		String--	-- | A bitmap image with a width, height and some 32-bit RGBA-        --   bitmap data.-	-- -	--  The boolean flag controls whether Gloss should cache the data-        --  between frames for speed. If you are programatically generating-        --  the image for each frame then use `False`. If you have loaded it-        --  from a file then use `True`.-	| Bitmap	Int	Int 	BitmapData Bool--	-- Color -------------------------------------------	-- | A picture drawn with this color.-	| Color		Color  		Picture--	-- Transforms --------------------------------------	-- | A picture translated by the given x and y coordinates.-	| Translate	Float Float	Picture--	-- | A picture rotated clockwise by the given angle (in degrees).-	| Rotate	Float		Picture--	-- | A picture scaled by the given x and y factors.-	| Scale		Float	Float	Picture--	-- More Pictures -----------------------------------	-- | A picture consisting of several others.-	| Pictures	[Picture]-	deriving (Show, Eq, Data, Typeable)----- Instances -------------------------------------------------------------------instance Monoid Picture where-	mempty		= blank-	mappend a b	= Pictures [a, b]-	mconcat		= Pictures----- 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----- Bitmaps ----------------------------------------------------------------------- | O(1). Use a `ForeignPtr` of RGBA data as a bitmap with the given---   width and height.----   The boolean flag controls whether Gloss should cache the data---   between frames for speed. If you are programatically generating---   the image for each frame then use `False`. If you have loaded it---   from a file then use `True`.-bitmapOfForeignPtr :: Int -> Int -> ForeignPtr Word8 -> Bool -> Picture-bitmapOfForeignPtr width height fptr cacheMe- = let  len     = width * height * 4-        bdata   = BitmapData len fptr-   in   Bitmap width height bdata cacheMe ----- | O(size). Copy a `ByteString` of RGBA data into a bitmap with the given---   width and height.------   The boolean flag controls whether Gloss should cache the data---   between frames for speed. If you are programatically generating---   the image for each frame then use `False`. If you have loaded it---   from a file then use `True`.-{-# NOINLINE bitmapOfByteString #-}-bitmapOfByteString :: Int -> Int -> ByteString -> Bool -> Picture-bitmapOfByteString width height bs cacheMe- = unsafePerformIO- $ do   let len = width * height * 4-        ptr     <- mallocBytes len-        fptr    <- newForeignPtr finalizerFree ptr--        BSU.unsafeUseAsCString bs-         $ \cstr -> copyBytes ptr (castPtr cstr) len--        let bdata = BitmapData len fptr-        return $ Bitmap width height bdata cacheMe----- | O(size). Copy a `BMP` file into a bitmap.-{-# NOINLINE bitmapOfBMP #-}-bitmapOfBMP :: BMP -> Picture-bitmapOfBMP bmp- = unsafePerformIO- $ do   let (width, height)     = bmpDimensions bmp-        let bs                  = unpackBMPToRGBA32 bmp -        let len                 = width * height * 4--        ptr     <- mallocBytes len-        fptr    <- newForeignPtr finalizerFree ptr--        BSU.unsafeUseAsCString bs-         $ \cstr -> copyBytes ptr (castPtr cstr) len--        let bdata = BitmapData len fptr-        reverseRGBA bdata--        return $ Bitmap width height bdata True----- | Load an uncompressed 24 or 32bit RGBA BMP file as a bitmap.-loadBMP :: FilePath -> IO Picture-loadBMP filePath- = do   ebmp    <- readBMP filePath-        case ebmp of-         Left err       -> error $ show err-         Right bmp      -> return $ bitmapOfBMP bmp----- 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-

@@ -1,51 +0,0 @@-{-# OPTIONS -fno-warn-missing-methods -fno-warn-orphans #-}-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}-module Graphics.Gloss.Data.Point-	( Point-	, pointInBox)-where---- | A point on the x-y plane.---   Points can also be treated as `Vector`s, so "Graphics.Gloss.Data.Vector"---   may also be useful.-type Point	= (Float, Float)			----- | Pretend a point is a number.---	Vectors aren't real numbes according to Haskell, because they don't---	support the multiply and divide field operators. We can pretend they---	are though, and use the (+) and (-) operators as component-wise---	addition and subtraction.----instance Num Point where-	(+) (x1, y1) (x2, y2)	= (x1 + x2, y1 + y2)- 	(-) (x1, y1) (x2, y2)	= (x1 - x2, y1 - y2)-        (*) (x1, y1) (x2, y2)   = (x1 * x2, y1 * y2)-        signum (x, y)           = (signum x, signum y)-        abs    (x, y)           = (abs x, abs y)-	negate (x, y)		= (negate x, negate y)	-        fromInteger x           = (fromInteger x, fromInteger x)----- | 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

@@ -1,17 +0,0 @@--module Graphics.Gloss.Data.Quad-	( Quad(..)-	, allQuads)-where-	--- | Represents a Quadrant in the 2D plane.-data Quad-	= NW 	-- ^ North West-	| NE 	-- ^ North East-	| SW 	-- ^ South West-	| SE	-- ^ South East-	deriving (Show, Eq, Enum)---- | A list of all quadrants. Same as @[NW .. SE]@.-allQuads :: [Quad]-allQuads = [NW .. SE]

@@ -1,191 +0,0 @@-{-# LANGUAGE RankNTypes #-}---- | A QuadTree can be used to recursively divide up 2D space into quadrants.---   The smallest division corresponds to an unit `Extent`, so the total depth ---   of the tree will depend on what sized `Extent` you start with.-module Graphics.Gloss.Data.QuadTree-	( QuadTree (..)-	, emptyTree-	, emptyNode-	, takeQuadOfTree-	, liftToQuad-	, insertByPath-	, insertByCoord-	, lookupNodeByPath-	, lookupByPath-	, lookupByCoord-	, flattenQuadTree-	, flattenQuadTreeWithExtents)-where-import Graphics.Gloss.Data.Quad-import Graphics.Gloss.Data.Extent---- | The quad tree structure.-data QuadTree a-	-- | An empty node.-	= TNil--	-- | A leaf containint some value.-	| TLeaf a-	-	-- | A node with four children.-	| TNode (QuadTree a) (QuadTree a) 	-- NW NE-		(QuadTree a) (QuadTree a)	-- SW SE-	deriving Show----- | A `TNil` tree.-emptyTree :: QuadTree a-emptyTree = TNil----- | A node with `TNil`. for all its branches.-emptyNode :: QuadTree a-emptyNode = TNode TNil TNil TNil TNil----- | Get a quadrant from a node.---   If the tree does not have an outer node then `Nothing`.-takeQuadOfTree-	:: Quad-	-> QuadTree a-	-> Maybe (QuadTree a)--takeQuadOfTree quad tree- = case tree of-	TNil		-> Nothing-	TLeaf{}		-> Nothing-	TNode nw ne sw se-	 -> case quad of-		NW	-> Just nw-		NE	-> Just ne-		SW	-> Just sw-		SE	-> Just se----- | Apply a function to a quadrant of a node.---   If the tree does not have an outer node then return the original tree.-liftToQuad-	:: Quad-	-> (QuadTree a -> QuadTree a) -	-> QuadTree a  -> QuadTree a--liftToQuad quad f tree- = case tree of-	TNil		-> tree-	TLeaf{}		-> tree-	TNode nw ne sw se-	 -> case quad of-		NW	-> TNode (f nw) ne sw se-		NE	-> TNode nw (f ne) sw se-		SW	-> TNode nw ne (f sw) se-		SE	-> TNode nw ne sw (f se)-		 -		--- | Insert a value into the tree at the position given by a path.---   If the path intersects an existing `TLeaf` then return the original tree.-insertByPath :: [Quad] -> a -> QuadTree a -> QuadTree a-	-insertByPath [] x _-	= TLeaf x-	-insertByPath (q:qs) x tree- = case tree of-	TNil	-> liftToQuad q (insertByPath qs x) emptyNode-	TLeaf{}	-> tree-	TNode{}	-> liftToQuad q (insertByPath qs x) tree----- | Insert a value into the node containing this coordinate.---   The node is created at maximum depth, corresponding to an unit `Extent`.-insertByCoord :: Extent -> Coord -> a -> QuadTree a -> Maybe (QuadTree a)-insertByCoord extent coord x tree- = do	path	<- pathToCoord extent coord-	return	$  insertByPath path x tree----- | Lookup a node based on a path to it.-lookupNodeByPath-	:: [Quad]-	-> QuadTree a-	-> Maybe (QuadTree a)--lookupNodeByPath [] tree-	= Just tree-	-lookupNodeByPath (q:qs) tree- = case tree of-	TNil	-> Nothing-	TLeaf{}	-> Nothing-	TNode{}-	 -> let Just quad	= takeQuadOfTree q tree-	    in  lookupNodeByPath qs quad----- | Lookup an element based given a path to it.-lookupByPath :: [Quad] -> QuadTree a -> Maybe a-lookupByPath path tree- = case lookupNodeByPath path tree of-	Just (TLeaf x)	-> Just x-	_		-> Nothing----- | Lookup a node if a tree given a coordinate which it contains.-lookupByCoord -	:: forall a-	.  Extent 	-- ^ Extent that covers the whole tree.-	-> Coord 	-- ^ Coordinate of the value of interest.-	-> QuadTree a -	-> Maybe a-lookupByCoord extent coord tree- = do	path	<- pathToCoord extent coord-	lookupByPath path tree-	-	--- | Flatten a QuadTree into a list of its contained values, with coordinates.-flattenQuadTree -	:: forall a-	.  Extent 	-- ^ Extent that covers the whole tree.-	-> QuadTree a -	-> [(Coord, a)]-	-flattenQuadTree extentInit treeInit- = flatten' extentInit treeInit- where	flatten' extent tree- 	 = case tree of-		TNil	-> []-		TLeaf x	-		 -> let (_, s, _, w) = takeExtent extent-		    in  [((w, s), x)]--		TNode{}	-> concat $ map (flattenQuad extent tree) allQuads-			-	flattenQuad extent tree quad- 	 = let	extent'		= cutQuadOfExtent quad extent-		Just tree'	= takeQuadOfTree quad tree-   	   in	flatten' extent' tree'----- | Flatten a QuadTree into a list of its contained values, with coordinates.-flattenQuadTreeWithExtents-	:: forall a-	.  Extent 	-- ^ Extent that covers the whole tree.-	-> QuadTree a -	-> [(Extent, a)]-	-flattenQuadTreeWithExtents extentInit treeInit- = flatten' extentInit treeInit- where	flatten' extent tree- 	 = case tree of-		TNil	-> []-		TLeaf x	-		 -> [(extent, x)]--		TNode{}	-> concat $ map (flattenQuad extent tree) allQuads-			-	flattenQuad extent tree quad- 	 = let	extent'		= cutQuadOfExtent quad extent-		Just tree'	= takeQuadOfTree quad tree-   	   in	flatten' extent' tree'--

@@ -1,91 +0,0 @@-{-# OPTIONS -fno-warn-missing-methods #-}-{-# LANGUAGE TypeSynonymInstances #-}---- | Geometric functions concerning vectors.-module Graphics.Gloss.Data.Vector-	( Vector-	, magV-	, argV-	, dotV-	, detV-	, mulSV-	, rotateV-	, angleVV-	, normaliseV-	, unitVectorAtAngle )-where-import Graphics.Gloss.Data.Point-import Graphics.Gloss.Geometry.Angle---- | A vector can be treated as a point, and vis-versa.-type Vector	= Point----- | 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)-	= normaliseAngle $ 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.-normaliseV :: Vector -> Vector-normaliseV v	= mulSV (1 / magV v) v-{-# INLINE normaliseV #-}----- | 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 #-}-

@@ -1,57 +0,0 @@-module Graphics.Gloss.Data.ViewPort-	( ViewPort(..)-	, viewPortInit-	, applyViewPortToPicture-	, invertViewPort )-where-import Graphics.Gloss.Data.Vector-import Graphics.Gloss.Geometry.Angle-import Graphics.Gloss.Data.Picture (Picture(..))-import Graphics.Gloss.Data.Point----- | 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		= scale-                        , viewPortTranslate	= (transX, transY)-			, viewPortRotate	= rotate }-	= Scale scale scale . Rotate rotate . 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		= scale-			, viewPortTranslate	= trans-			, viewPortRotate	= rotate }-        pos-	= rotateV (degToRad rotate) (mulSV (1 / scale) pos) - trans-

@@ -1,8 +0,0 @@--module Graphics.Gloss.Geometry-	( module Graphics.Gloss.Geometry.Angle-	, module Graphics.Gloss.Geometry.Line )-where-import Graphics.Gloss.Geometry.Angle-import Graphics.Gloss.Geometry.Line-	

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

@@ -1,326 +0,0 @@-{-# 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--

@@ -5,8 +5,7 @@ import Graphics.Gloss.Data.Color import Graphics.Gloss.Data.Picture import Graphics.Gloss.Data.ViewState-import Graphics.Gloss.Internals.Render.Common-import Graphics.Gloss.Internals.Render.Picture+import Graphics.Gloss.Render import Graphics.Gloss.Internals.Interface.Backend import Graphics.Gloss.Internals.Interface.Window import Graphics.Gloss.Internals.Interface.Common.Exit@@ -51,10 +50,12 @@ 		renderS		<- readIORef renderSR 		portS		<- viewStateViewPort <$> readIORef viewSR +                windowSize      <- getWindowDimensions backendRef+ 		-- render the frame 		renderAction-			backendRef-			(renderPicture backendRef renderS portS picture)+			windowSize+			(renderPicture renderS portS picture)  		-- perform GC every frame to try and avoid long pauses 		performGC

@@ -5,8 +5,7 @@ import Graphics.Gloss.Data.Color import Graphics.Gloss.Data.Picture import Graphics.Gloss.Data.ViewState-import Graphics.Gloss.Internals.Render.Common-import Graphics.Gloss.Internals.Render.Picture+import Graphics.Gloss.Render import Graphics.Gloss.Internals.Interface.Backend import Graphics.Gloss.Internals.Interface.Window import Graphics.Gloss.Internals.Interface.Common.Exit@@ -37,9 +36,10 @@ 	let renderFun backendRef = do 		port    <- viewStateViewPort <$> readIORef viewSR 		options	<- readIORef renderSR+                windowSize <- getWindowDimensions backendRef 	 	renderAction-			backendRef-			(renderPicture backendRef options port picture)+			windowSize+			(renderPicture options port picture)  	let callbacks 	     =	[ Callback.Display renderFun 

@@ -7,8 +7,7 @@ import Graphics.Gloss.Data.Color import Graphics.Gloss.Data.Picture import Graphics.Gloss.Data.ViewPort-import Graphics.Gloss.Internals.Render.Common-import Graphics.Gloss.Internals.Render.Picture+import Graphics.Gloss.Render import Graphics.Gloss.Internals.Interface.Event import Graphics.Gloss.Internals.Interface.Backend import Graphics.Gloss.Internals.Interface.Window@@ -71,12 +70,14 @@ 	 		-- display the picture in the current view 		renderS		<- readIORef renderSR-		viewS		<- readIORef viewSR+		viewPort        <- readIORef viewSR +                windowSize <- getWindowDimensions backendRef+ 		-- render the frame 		renderAction-			backendRef-	 	 	(renderPicture backendRef renderS viewS picture)+			windowSize+	 	 	(renderPicture renderS viewPort picture)   		-- perform garbage collection 		performGC@@ -87,7 +88,7 @@ 		, Callback.Display	(animateEnd   animateSR) 		, Callback.Idle		(callback_simulate_idle  						stateSR animateSR (readIORef viewSR)-						worldSR worldStart (\_ -> worldAdvance)+						worldSR (\_ -> worldAdvance) 						singleStepTime) 		, callback_keyMouse worldSR viewSR worldHandleEvent 		, callback_motion   worldSR worldHandleEvent

@@ -7,8 +7,7 @@ import Graphics.Gloss.Data.Color import Graphics.Gloss.Data.Picture import Graphics.Gloss.Data.ViewState-import Graphics.Gloss.Internals.Render.Common-import Graphics.Gloss.Internals.Render.Picture+import Graphics.Gloss.Render import Graphics.Gloss.Internals.Interface.Backend import Graphics.Gloss.Internals.Interface.Window import Graphics.Gloss.Internals.Interface.Common.Exit@@ -73,10 +72,12 @@ 		-- display the picture in the current view 		renderS		<- readIORef renderSR +                windowSize <- getWindowDimensions backendRef+ 		-- render the frame 		renderAction-			backendRef-	 	 	(renderPicture backendRef renderS port picture)+			windowSize+	 	 	(renderPicture renderS port picture)   		-- perform garbage collection 		performGC@@ -88,7 +89,7 @@ 		, Callback.Idle		(callback_simulate_idle  						stateSR animateSR 						(viewStateViewPort <$> readIORef viewSR)-						worldSR worldStart worldAdvance+						worldSR worldAdvance 						singleStepTime) 		, callback_exit ()  		, callback_viewState_keyMouse viewSR

@@ -24,44 +24,16 @@         -- directly because sometimes we hold a ref to a 'ViewPort' (in         -- Game) and sometimes a ref to a 'ViewState'. 	-> IORef world					-- ^ the current world-	-> world					-- ^ the initial 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 worldStart worldAdvance singleStepTime backendRef+callback_simulate_idle simSR animateSR viewSA worldSR worldAdvance _singleStepTime backendRef  = {-# SCC "callbackIdle" #-}-   do	simS		<- readIORef simSR-	let result-		| SM.stateReset simS-		= simulate_reset simSR worldSR worldStart--		| SM.stateRun   simS-		= simulate_run   simSR animateSR viewSA worldSR worldAdvance-		-		| SM.stateStep  simS-		= simulate_step  simSR viewSA worldSR worldAdvance singleStepTime-		-		| otherwise-		= \_ -> return ()-		-	result backendRef+   do	simulate_run simSR animateSR viewSA worldSR worldAdvance backendRef   --- reset the world to -simulate_reset :: IORef SM.State -> IORef a -> a -> IdleCallback-simulate_reset simSR worldSR worldStart backendRef- = do	writeIORef worldSR worldStart-- 	simSR `modifyIORef` \c -> c 	-		{ SM.stateReset		= False -	 	, SM.stateIteration	= 0 -		, SM.stateSimTime	= 0 }-	 -	Backend.postRedisplay backendRef-	 -  -- take the number of steps specified by controlWarp simulate_run  	:: IORef SM.State@@ -117,32 +89,9 @@ 	-- update the control state 	simSR `modifyIORef` \c -> c 		{ SM.stateIteration	= nFinal-		, SM.stateSimTime	= newSimTime -		, SM.stateStepsPerFrame	= fromIntegral thisSteps }+		, SM.stateSimTime	= newSimTime } 	 	-- tell glut we want to draw the window after returning-	Backend.postRedisplay backendRef----- take a single step-simulate_step -	:: IORef SM.State-	-> IO ViewPort-	-> IORef world-	-> (ViewPort -> Float -> world -> IO world) -	-> Float-	-> IdleCallback--simulate_step simSR viewSA worldSR worldAdvance singleStepTime backendRef- = do	viewS		<- viewSA- 	world		<- readIORef worldSR-	world'		<- worldAdvance viewS singleStepTime world-	-	writeIORef worldSR world'-	simSR `modifyIORef` \c -> c 	-		{ SM.stateIteration 	= SM.stateIteration c + 1 -	 	, SM.stateStep		= False }-	  	Backend.postRedisplay backendRef  

@@ -11,23 +11,11 @@ 	{ -- | The iteration number we're up to. 	  stateIteration	:: !Integer -	-- | Whether the animation is free-running (or single step)-	, stateRun		:: !Bool--	-- | Signals to callbackIdle to take a single step of the automation.-	, stateStep		:: !Bool--	-- | Signals to callbackIdle to roll-back to the initial world.-	, stateReset		:: !Bool-		 	-- | 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-	-	-- | Record how many steps we've been taking per frame-	, stateStepsPerFrame 	:: !Int  }+	, stateSimTime		:: !Float  } 	  -- | Initial control state@@ -35,11 +23,7 @@ stateInit resolution  	= State  	{ stateIteration		= 0-	, stateRun			= True-	, stateStep			= False-	, stateReset			= False 	, stateResolution		= resolution -	, stateSimTime			= 0 -	, stateStepsPerFrame		= 0 }+	, stateSimTime			= 0 } 	 	

@@ -1,86 +0,0 @@-{-# OPTIONS -fwarn-incomplete-patterns #-}---- | Helper functions for rendering bitmaps-module Graphics.Gloss.Internals.Render.Bitmap-	( BitmapData(..)-	, reverseRGBA-	, bitmapPath-	, freeBitmapData-	)-where-import Data.Data-import Foreign----- | Abstract 32-bit RGBA bitmap data.-data BitmapData -        = BitmapData -                Int                     -- length (in bytes)-                (ForeignPtr Word8)      -- pointer to data-        deriving (Eq, Data, Typeable)---instance Show BitmapData where- show _ = "BitmapData"----- | Generates the point path to display the bitmap centred-bitmapPath :: Float -> Float -> [(Float, Float)]-bitmapPath width height - = [(-width', -height'), (width', -height'), (width', height'), (-width', height')]- where	width'  = width  / 2-	height' = height / 2----- | Destructively reverse the byte order in an array.---   This is necessary as OpenGL reads pixel data as ABGR, rather than RGBA-reverseRGBA :: BitmapData -> IO ()-reverseRGBA (BitmapData length8 fptr)- = withForeignPtr fptr (reverseRGBA_ptr length8)----- | Destructively reverses the byte order in an array.-reverseRGBA_ptr :: Int -> Ptr Word8 -> IO ()-reverseRGBA_ptr length8 ptr8- = go (length8 `div` 4) (castPtr ptr8) 0- where-        go :: Int -> Ptr Word32 -> Int -> IO ()-        go len ptr count-         | count < len -         = do	curr <- peekElemOff ptr count-      	        let byte0 = shift (isolateByte0 curr) 24-      	        let byte1 = shift (isolateByte1 curr) 8-      	        let byte2 = shift (isolateByte2 curr) (-8)-      	        let byte3 = shift (isolateByte3 curr) (-24)-      	        pokeElemOff ptr count (byte0 .|. byte1 .|. byte2 .|. byte3)-      	        go len ptr (count + 1)--         | otherwise -         = return ()---- | Frees the allocated memory given to OpenGL to avoid a memory leak-freeBitmapData :: Ptr Word8 -> IO ()-{-# INLINE freeBitmapData #-}-freeBitmapData p = free p----- | These functions work as bit masks to isolate the Word8 components-{-# INLINE isolateByte0 #-}-isolateByte0 :: Word32 -> Word32-isolateByte0 word =-   word .&. (255 :: Word32)--{-# INLINE isolateByte1 #-}-isolateByte1 :: Word32 -> Word32-isolateByte1 word =-   word .&. (65280 :: Word32)--{-# INLINE isolateByte2 #-}-isolateByte2 :: Word32 -> Word32-isolateByte2 word =-   word .&. (16711680 :: Word32)--{-# INLINE isolateByte3 #-}-isolateByte3 :: Word32 -> Word32-isolateByte3 word =-   word .&. (4278190080 :: Word32)

@@ -1,246 +0,0 @@-{-# LANGUAGE BangPatterns, MagicHash, PatternGuards #-}-{-# OPTIONS_HADDOCK hide #-}---- | Fast(ish) rendering of circles.-module Graphics.Gloss.Internals.Render.Circle-        ( renderCircle-        , renderArc)-where-import 	Graphics.Gloss.Internals.Render.Common-import  Graphics.Gloss.Geometry.Angle-import	qualified Graphics.Rendering.OpenGL.GL		as GL-import	GHC.Exts----- | Decide how many line segments to use to render the circle.---   The number of segments we should use to get a nice picture depends on ---   the size of the circle on the screen, not its intrinsic radius.---   If the viewport has been zoomed-in then we need to use more segments.----{-# INLINE circleSteps #-}-circleSteps :: Float -> Int-circleSteps sDiam-        | sDiam < 8     = 8-        | sDiam < 16    = 16-        | sDiam < 32    = 32-        | otherwise     = 64----- Circle ------------------------------------------------------------------------ | Render a circle with the given thickness-renderCircle :: Float -> Float -> Float -> Float -> Float -> IO ()-renderCircle posX posY scaleFactor radius_ thickness_- = go (abs radius_) (abs thickness_)- where go radius thickness--        -- If the circle is smaller than a pixel, render it as a point.-        | thickness     == 0-        , radScreen     <- scaleFactor * (radius + thickness / 2)-        , radScreen     <= 1-        = GL.renderPrimitive GL.Points-            $ GL.vertex $ GL.Vertex2 (gf posX) (gf posY)--        -- Render zero thickness circles with lines.-        | thickness == 0-        , radScreen	<- scaleFactor * radius-	, steps		<- circleSteps radScreen-        = renderCircleLine  posX posY steps radius--        -- Some thick circle.-        | radScreen     <- scaleFactor * (radius + thickness / 2)-        , steps         <- circleSteps radScreen-        = renderCircleStrip posX posY steps radius thickness----- | Render a circle as a line.-renderCircleLine :: Float -> Float -> Int -> Float -> IO ()-renderCircleLine (F# posX) (F# posY) steps (F# rad)- = let  n               = fromIntegral steps-        !(F# tStep)     = (2 * pi) / n-        !(F# tStop)     = (2 * pi)--   in   GL.renderPrimitive GL.LineLoop-         $ renderCircleLine_step posX posY tStep tStop rad 0.0#-{-# INLINE renderCircleLine #-}----- | Render a circle with a given thickness as a triangle strip-renderCircleStrip :: Float -> Float -> Int -> Float -> Float -> IO ()-renderCircleStrip (F# posX) (F# posY) steps r width- = let  n               = fromIntegral steps-        !(F# tStep)     = (2 * pi) / n-        !(F# tStop)     = (2 * pi) + (F# tStep) / 2-        !(F# r1)        = r - width / 2-        !(F# r2)        = r + width / 2--   in   GL.renderPrimitive GL.TriangleStrip-         $ renderCircleStrip_step posX posY tStep tStop r1 0.0# r2 -                (tStep `divideFloat#` 2.0#)-{-# INLINE renderCircleStrip #-}----- Arc --------------------------------------------------------------------------- | Render an arc with the given thickness.-renderArc :: Float -> Float -> Float -> Float -> Float -> Float -> Float -> IO ()-renderArc posX posY scaleFactor radius_ a1 a2 thickness_- = go (abs radius_) (abs thickness_)- where go radius thickness--        -- Render zero thickness arcs with lines.-        | thickness == 0-        , radScreen     <- scaleFactor * radius-        , steps         <- circleSteps radScreen-        = renderArcLine posX posY steps radius a1 a2--        -- Some thick arc.-        | radScreen     <- scaleFactor * (radius + thickness / 2)-        , steps         <- circleSteps radScreen-        = renderArcStrip posX posY steps radius a1 a2 thickness-  ---- | Render an arc as a line.-renderArcLine :: Float -> Float -> Int -> Float -> Float -> Float -> IO ()-renderArcLine (F# posX) (F# posY) steps (F# rad) a1 a2- = let 	n		= fromIntegral steps-	!(F# tStep)	= (2 * pi) / n-        !(F# tStart)    = degToRad a1-	!(F# tStop)	= degToRad a2 + if a1 >= a2 then 2 * pi else 0--        -- force the line to end at the desired angle-        endVertex       = addPointOnCircle posX posY rad tStop--   in	GL.renderPrimitive GL.LineStrip-   	 $ do   renderCircleLine_step posX posY tStep tStop rad tStart-                endVertex-{-# INLINE renderArcLine #-}----- | Render an arc with a given thickness as a triangle strip-renderArcStrip :: Float -> Float -> Int -> Float -> Float -> Float -> Float -> IO ()-renderArcStrip (F# posX) (F# posY) steps r a1 a2 width- = let	n		= fromIntegral steps-        tStep           = (2 * pi) / n--        t1              = normaliseAngle $ degToRad a1-        t2              = normaliseAngle $ degToRad a2-        (tStart, tStop) = if t1 <= t2 then (t1, t2) else (t2, t1)-        tDiff           = tStop - tStart-        tMid            = tStart + tDiff / 2-- 	!(F# tStep')	= tStep-        !(F# tStep2')   = tStep / 2-        !(F# tStart')   = tStart-        !(F# tStop')    = tStop-        !(F# tCut')     = tStop - tStep-        !(F# tMid')     = tMid-	!(F# r1')	= r - width / 2-	!(F# r2')	= r + width / 2-                -   in	GL.renderPrimitive GL.TriangleStrip-   	 $ do  -                 -- start vector-                 addPointOnCircle posX posY r1' tStart'-                 addPointOnCircle posX posY r2' tStart'--                 -- If we don't have a complete step then just drop a point-                 -- between the two ending lines.-                 if tDiff < tStep-                   then do-                        addPointOnCircle posX posY r1' tMid'--                        -- end vectors-                        addPointOnCircle posX posY r2' tStop'-                        addPointOnCircle posX posY r1' tStop'---                   else do-                        renderCircleStrip_step posX posY tStep' tCut' r1' tStart' r2'-                                (tStart' `plusFloat#` tStep2')--                        -- end vectors-                        addPointOnCircle posX posY r1' tStop'-                        addPointOnCircle posX posY r2' tStop'-{-# INLINE renderArcStrip #-}----- Step functions --------------------------------------------------------------renderCircleLine_step-        :: Float# -> Float#-        -> Float# -> Float#-        -> Float# -> Float# -        -> IO ()--renderCircleLine_step posX posY tStep tStop rad tt-        | 1# <- tt `geFloat#` tStop-        = return ()-        -        | otherwise-        = do    addPointOnCircle posX posY rad tt-                renderCircleLine_step posX posY tStep tStop rad -                        (tt `plusFloat#` tStep)-{-# INLINE renderCircleLine_step #-}---renderCircleStrip_step -	:: Float# -> Float# -	-> Float# -> Float# -	-> Float# -> Float#-        -> Float# -> Float# -> IO ()--renderCircleStrip_step posX posY tStep tStop r1 t1 r2 t2-	| 1# <- t1 `geFloat#` tStop-	= return ()-	-	| otherwise-	= do	addPointOnCircle posX posY r1 t1-                addPointOnCircle posX posY r2 t2-		renderCircleStrip_step posX posY tStep tStop r1 -			(t1 `plusFloat#` tStep) r2 (t2 `plusFloat#` tStep)-{-# INLINE renderCircleStrip_step #-}---addPoint :: Float# -> Float# -> IO ()-addPoint x y =-  GL.vertex $ GL.Vertex2 (gf (F# x)) (gf (F# y))-{-# INLINE addPoint #-}---addPointOnCircle :: Float# -> Float# -> Float# -> Float# -> IO ()-addPointOnCircle posX posY rad tt =-  addPoint-    (posX `plusFloat#` (rad `timesFloat#` (cosFloat# tt)))-    (posY `plusFloat#` (rad `timesFloat#` (sinFloat# tt)))-{-# INLINE addPointOnCircle #-}----{- Unused sector drawing code.-   Sectors are currently drawn as compound Pictures,-   but we might want this if we end up implementing the ThickSector -   version as well.---- | Render a sector as a line.-renderSectorLine :: Float -> Float -> Int -> Float -> Float -> Float -> IO ()-renderSectorLine pX@(F# posX) pY@(F# posY) steps (F# rad) a1 a2- = let  n               = fromIntegral steps-        !(F# tStep)     = (2 * pi) / n-        !(F# tStart)    = degToRad a1-        !(F# tStop)     = degToRad a2 + if a1 >= a2 then 2 * pi else 0--        -- need to set up the edges of the start/end triangles-        startVertex     = GL.vertex $ GL.Vertex2 (gf pX) (gf pY)-        endVertex       = addPointOnCircle posX posY rad tStop--   in   GL.renderPrimitive GL.LineLoop-         $ do   startVertex-                renderCircleLine_step posX posY tStep tStop rad tStart-                endVertex---- | Render a sector.-renderSector :: Float -> Float -> Float -> Float -> Float -> Float -> IO ()-renderSector posX posY scaleFactor radius a1 a2-        | radScreen     <- scaleFactor * radius-        , steps         <- circleSteps (2 * radScreen)-        = renderSectorLine posX posY steps radius a1 a2--}-

@@ -1,51 +0,0 @@-{-# OPTIONS_HADDOCK hide #-}-module Graphics.Gloss.Internals.Render.Common where--import Graphics.Gloss.Internals.Interface.Backend-import	Graphics.Rendering.OpenGL					(($=))-import qualified Graphics.Rendering.OpenGL.GL	as GL-import Unsafe.Coerce-import Data.IORef---- | The OpenGL library doesn't seem to provide a nice way convert---	a Float to a GLfloat, even though they're the same thing---	under the covers.  ------  Using realToFrac is too slow, as it doesn't get fused in at---	least GHC 6.12.1----gf :: Float -> GL.GLfloat-{-# INLINE gf #-}-gf x = unsafeCoerce x---- | Used for similar reasons to above-gsizei :: Int -> GL.GLsizei-{-# INLINE gsizei #-}-gsizei x = unsafeCoerce x---- | Perform a rendering action setting up the coords first-renderAction-	:: Backend a-	=> IORef a-	-> IO ()-	-> IO ()--renderAction backendRef action- = do- 	GL.matrixMode	$= GL.Projection-	GL.preservingMatrix-	 $ do-		-- setup the co-ordinate system-	 	GL.loadIdentity-		(sizeX, sizeY) 	<- getWindowDimensions backendRef-		let (sx, sy)	= (fromIntegral sizeX / 2, fromIntegral sizeY / 2)--		GL.ortho (-sx) sx (-sy) sy 0 (-100)-	-		-- draw the world-		GL.matrixMode 	$= GL.Modelview 0-		action--		GL.matrixMode	$= GL.Projection-	-	GL.matrixMode	$= GL.Modelview 0

@@ -1,382 +0,0 @@-{-# OPTIONS -fwarn-incomplete-patterns #-}-{-# OPTIONS_HADDOCK hide #-}-{-# LANGUAGE ImplicitParams, ScopedTypeVariables #-}--module Graphics.Gloss.Internals.Render.Picture-	(renderPicture)-where-import Graphics.Gloss.Data.Picture-import Graphics.Gloss.Data.Color-import Graphics.Gloss.Data.ViewPort-import Graphics.Gloss.Internals.Interface.Backend-import Graphics.Gloss.Internals.Render.State-import Graphics.Gloss.Internals.Render.Common-import Graphics.Gloss.Internals.Render.Circle-import Graphics.Gloss.Internals.Render.Bitmap-import System.Mem.StableName-import Foreign.ForeignPtr-import Data.IORef-import Data.List-import Control.Monad-import Graphics.Rendering.OpenGL	               	(($=), get)-import qualified Graphics.Rendering.OpenGL.GL	        as GL-import qualified Graphics.Rendering.OpenGL.GLU.Errors   as GLU-import qualified Graphics.UI.GLUT		        as GLUT----- | Render a picture using the given render options and viewport.-renderPicture-	:: forall a . Backend a-	=> IORef a-	-> State		-- ^ The render state-	-> ViewPort		-- ^ The current viewport.-	-> Picture 		-- ^ The picture to render.-	-> IO ()--renderPicture-	backendRef-	renderS-	viewS-	picture- = do-	-- This GL state doesn't change during rendering, -	--	so we can just read it once here-	(matProj_  :: GL.GLmatrix GL.GLdouble)	-			<- get $ GL.matrix (Just GL.Projection)-	viewport_  	<- get $ GL.viewport-	windowSize_	<- getWindowDimensions backendRef--	-- -	let ?modeWireframe	= stateWireframe renderS-	    ?modeColor		= stateColor     renderS-	    ?refTextures        = stateTextures  renderS-	    ?matProj		= matProj_-	    ?viewport		= viewport_-	    ?windowSize		= windowSize_-	-	-- setup render state for world-	setLineSmooth	(stateLineSmooth renderS)-	setBlendAlpha	(stateBlendAlpha renderS)-	-	-- Adjust the picture-	let picture'		= applyViewPortToPicture viewS picture-        checkErrors "before drawPicture."-        drawPicture (viewPortScale viewS) picture'-        checkErrors "after drawPicture."---drawPicture-	:: ( ?modeWireframe     :: Bool-	   , ?modeColor         :: Bool-	   , ?refTextures       :: IORef [Texture])-	=> Float -> Picture -> IO ()	  --drawPicture circScale picture- = {-# SCC "drawComponent" #-}-   case picture of--	-- nothin'-	Blank-	 -> 	return ()--	-- line- 	Line path	-	 -> GL.renderPrimitive GL.LineStrip -		$ vertexPFs path---	-- polygon (where?)-	Polygon path-	 | ?modeWireframe-	 -> GL.renderPrimitive GL.LineLoop-	 	$ vertexPFs path-		-	 | otherwise-	 -> GL.renderPrimitive GL.Polygon-	 	$ vertexPFs path--	-- circle-	Circle radius-	 ->  renderCircle 0 0 circScale radius 0-	-	ThickCircle radius thickness-	 ->  renderCircle 0 0 circScale radius thickness-	-        -- arc-        Arc a1 a2 radius-         ->  renderArc 0 0 circScale radius a1 a2 0-             -        ThickArc a1 a2 radius thickness-         ->  renderArc 0 0 circScale radius a1 a2 thickness-             -	-- stroke text-	-- 	text looks weird when we've got blend on,-	--	so disable it during the renderString call.-	Text str -	 -> do-	 	GL.blend	$= GL.Disabled-                GL.preservingMatrix $ GLUT.renderString GLUT.Roman str-		GL.blend	$= GL.Enabled--	-- colors with float components.-	Color col p-	 |  ?modeColor-	 ->  do	oldColor 	 <- get GL.currentColor--		let (r, g, b, a) = rgbaOfColor col--		GL.currentColor	 $= GL.Color4 (gf r) (gf g) (gf b) (gf a)-		drawPicture circScale p-		GL.currentColor	$= oldColor		--	 |  otherwise-	 -> 	drawPicture circScale p---        -- Translation ---------------------------        -- Easy translations are done directly to avoid calling GL.perserveMatrix.-	Translate posX posY (Circle radius)-	 -> renderCircle posX posY circScale radius 0--	Translate posX posY (ThickCircle radius thickness)-	 -> renderCircle posX posY circScale radius thickness--	Translate posX posY (Arc a1 a2 radius)-	 -> renderArc posX posY circScale radius a1 a2 0--	Translate posX posY (ThickArc a1 a2 radius thickness)-	 -> renderArc posX posY circScale radius a1 a2 thickness-             -	Translate tx ty (Rotate deg p)-	 -> GL.preservingMatrix-	  $ do	GL.translate (GL.Vector3 (gf tx) (gf ty) 0)-		GL.rotate    (gf deg) (GL.Vector3 0 0 (-1))-		drawPicture circScale p--	Translate tx ty	p-	 -> GL.preservingMatrix-	  $ do	GL.translate (GL.Vector3 (gf tx) (gf ty) 0)-		drawPicture circScale p---        -- Rotation ------------------------------        -- Easy rotations are done directly to avoid calling GL.perserveMatrix.-        Rotate _   (Circle radius)-         -> renderCircle   0 0 circScale radius 0--        Rotate _   (ThickCircle radius thickness)-         -> renderCircle   0 0 circScale radius thickness--        Rotate deg (Arc a1 a2 radius)-         -> renderArc      0 0 circScale radius (a1-deg) (a2-deg) 0--        Rotate deg (ThickArc a1 a2 radius thickness)-         -> renderArc      0 0 circScale radius (a1-deg) (a2-deg) thickness--        -	Rotate deg p-	 -> GL.preservingMatrix-	  $ do	GL.rotate (gf deg) (GL.Vector3 0 0 (-1))-		drawPicture circScale p---        -- Scale ---------------------------------	Scale sx sy p-	 -> GL.preservingMatrix-	  $ do	GL.scale (gf sx) (gf sy) 1-		let mscale	= max sx sy-		drawPicture (circScale * mscale) p-			-	-- Bitmap --------------------------------	Bitmap width height imgData cacheMe-	 -> do	-                -- Load the image data into a texture,-                -- or grab it from the cache if we've already done that before.-	        tex     <- loadTexture ?refTextures width height imgData cacheMe-	 -		-- Set up wrap and filtering mode-		GL.textureWrapMode GL.Texture2D GL.S $= (GL.Repeated, GL.Repeat)-		GL.textureWrapMode GL.Texture2D GL.T $= (GL.Repeated, GL.Repeat)-		GL.textureFilter   GL.Texture2D      $= ((GL.Nearest, Nothing), GL.Nearest)-		-		-- Enable texturing-		GL.texture GL.Texture2D $= GL.Enabled-		GL.textureFunction      $= GL.Combine-		-		-- Set current texture-		GL.textureBinding GL.Texture2D $= Just (texObject tex)-		-		-- Set to opaque-		GL.currentColor $= GL.Color4 1.0 1.0 1.0 1.0-		-		-- Draw textured polygon-		GL.renderPrimitive GL.Polygon-		 $ zipWithM_-		        (\(pX, pY) (tX, tY)-			  -> do GL.texCoord $ GL.TexCoord2 (gf tX) (gf tY)-		           	GL.vertex   $ GL.Vertex2   (gf pX) (gf pY))--			(bitmapPath (fromIntegral width) (fromIntegral height))-			        [(0,0), (1.0,0), (1.0,1.0), (0,1.0)]--		-- Disable texturing-		GL.texture GL.Texture2D $= GL.Disabled--                -- Free uncachable texture objects.-                freeTexture tex-                --	Pictures ps-	 -> mapM_ (drawPicture circScale) ps-	--- Errors ----------------------------------------------------------------------checkErrors :: String -> IO ()-checkErrors place- = do   errors          <- get $ GLU.errors-        when (not $ null errors)-         $ mapM_ (handleError place) errors--handleError :: String -> GLU.Error -> IO ()-handleError place err- = case err of-    GLU.Error GLU.StackOverflow _-     -> error $ unlines -      [ "Gloss / OpenGL Stack Overflow " ++ show place-      , "  This program uses the Gloss vector graphics library, which tried to"-      , "  draw a picture using more nested transforms (Translate/Rotate/Scale)"-      , "  than your OpenGL implementation supports. The OpenGL spec requires"-      , "  all implementations to have a transform stack depth of at least 32,"-      , "  and Gloss tries not to push the stack when it doesn't have to, but"-      , "  that still wasn't enough."-      , ""-      , "  You should complain to your harware vendor that they don't provide"-      , "  a better way to handle this situation at the OpenGL API level."-      , ""-      , "  To make this program work you'll need to reduce the number of nested"-      , "  transforms used when defining the Picture given to Gloss. Sorry." ]--    -- Issue #32: Spurious "Invalid Operation" errors under Windows 7 64-bit.-    --   When using GLUT under Windows 7 it complains about InvalidOperation, -    --   but doesn't provide any other details. All the examples look ok, so -    --   we're just ignoring the error for now.-    GLU.Error GLU.InvalidOperation _-     -> return ()-    _ -     -> error $ unlines -     [  "Gloss / OpenGL Internal Error " ++ show place-     ,  "  Please report this on haskell-gloss@googlegroups.com."-     ,  show err ]----- Textures ---------------------------------------------------------------------- | Load a texture.---   If we've seen it before then use the pre-installed one from the texture---   cache, otherwise load it into OpenGL.-loadTexture-        :: IORef [Texture]-        -> Int -> Int -> BitmapData-        -> Bool-        -> IO Texture--loadTexture refTextures width height imgData cacheMe- = do   textures        <- readIORef refTextures--        -- Try and find this same texture in the cache.-        name            <- makeStableName imgData-        let mTexCached      -                = find (\tex -> texName   tex == name-                             && texWidth  tex == width-                             && texHeight tex == height)-                textures-                -        case mTexCached of-         Just tex-          ->    return tex-                -         Nothing-          -> do tex     <- installTexture width height imgData cacheMe-                when cacheMe-                 $ writeIORef refTextures (tex : textures)-                return tex----- | Install a texture into OpenGL.-installTexture     -        :: Int -> Int-        -> BitmapData-        -> Bool-        -> IO Texture--installTexture width height bitmapData@(BitmapData _ fptr) cacheMe- = do   -	-- Allocate texture handle for texture-	[tex] <- GL.genObjectNames 1-	GL.textureBinding GL.Texture2D $= Just tex--	-- Sets the texture in imgData as the current texture-	-- This copies the data from the pointer into OpenGL texture memory, -	-- so it's ok if the foreignptr gets garbage collected after this.-        withForeignPtr fptr-         $ \ptr ->-   	   GL.texImage2D-		GL.Texture2D-		GL.NoProxy-		0-		GL.RGBA8-		(GL.TextureSize2D-			(gsizei width)-			(gsizei height))-		0-		(GL.PixelData GL.RGBA GL.UnsignedInt8888 ptr)--        -- Make a stable name that we can use to identify this data again.-        -- If the user gives us the same texture data at the same size then we-        -- can avoid loading it into texture memory again.-        name    <- makeStableName bitmapData--        return  Texture-                { texName       = name-                , texWidth      = width-                , texHeight     = height-                , texData       = fptr-                , texObject     = tex-                , texCacheMe    = cacheMe }----- | If this texture does not have its `cacheMe` flag set then delete it from ---   OpenGL and free the memory.-freeTexture :: Texture -> IO ()-freeTexture tex- | texCacheMe tex       = return ()- | otherwise            = GL.deleteObjectNames [texObject tex]------ Utils ------------------------------------------------------------------------- | Turn alpha blending on or off-setBlendAlpha :: Bool -> IO ()-setBlendAlpha state- 	| state	- 	= do	GL.blend	$= GL.Enabled-		GL.blendFunc	$= (GL.SrcAlpha, GL.OneMinusSrcAlpha)--	| otherwise- 	= do	GL.blend	$= GL.Disabled-		GL.blendFunc	$= (GL.One, GL.Zero) 	---- | Turn line smoothing on or off-setLineSmooth :: Bool -> IO ()-setLineSmooth state-	| state		= GL.lineSmooth	$= GL.Enabled-	| otherwise	= GL.lineSmooth $= GL.Disabled---vertexPFs ::	[(Float, Float)] -> IO ()-{-# INLINE vertexPFs #-}-vertexPFs []	= return ()-vertexPFs ((x, y) : rest)- = do	GL.vertex $ GL.Vertex2 (gf x) (gf y)- 	vertexPFs rest---

@@ -1,69 +0,0 @@-{-# OPTIONS_HADDOCK hide #-}---- | Rendering options-module Graphics.Gloss.Internals.Render.State-	( State (..)-	, stateInit-	, Texture (..))-where-import qualified Graphics.Rendering.OpenGL.GL	as GL-import Foreign.ForeignPtr-import System.Mem.StableName-import Data.Word-import Data.IORef-import Graphics.Gloss.Data.Picture---- | Render options settings-data State-	= State-	{ -- | Whether to use color-	  stateColor		:: !Bool--	-- | Whether to force wireframe mode only-	, stateWireframe	:: !Bool--	-- | Whether to use alpha blending-	, stateBlendAlpha	:: !Bool--	-- | Whether to use line smoothing-	, stateLineSmooth	:: !Bool-	-	-- | Cache of Textures that we've sent to OpenGL.-	, stateTextures         :: !(IORef [Texture])-	}-	---- | A texture that we've sent to OpenGL.-data Texture-        = Texture-        { -- | Stable name derived from the `BitmapData` that the user gives us.-          texName       :: StableName BitmapData--        -- | Width of the image, in pixels.-        , texWidth      :: Int--        -- | Height of the image, in pixels.-        , texHeight     :: Int--        -- | Pointer to the Raw texture data.-        , texData       :: ForeignPtr Word8-        -        -- | The OpenGL texture object.-        , texObject     :: GL.TextureObject--        -- | Whether we want to leave this in OpenGL texture memory between frames.-        , texCacheMe    :: Bool }----- | Default render options-stateInit :: IO State-stateInit- = do   textures        <- newIORef []-	return  State-	        { stateColor		= True-                , stateWireframe	= False-	        , stateBlendAlpha	= True-	        , stateLineSmooth	= False -	        , stateTextures         = textures }-	-

@@ -1,5 +1,5 @@ Name:                gloss-Version:             1.8.2.2+Version:             1.9.1.1 License:             MIT License-file:        LICENSE Author:              Ben Lippmeier@@ -43,25 +43,14 @@         bytestring == 0.10.*,         OpenGL     == 2.9.*,         GLUT       == 2.5.*,-        bmp        == 1.2.*+        bmp        == 1.2.*,+        gloss-rendering == 1.9.1.*    ghc-options:         -O2 -Wall    Exposed-modules:         Graphics.Gloss-        Graphics.Gloss.Geometry-        Graphics.Gloss.Geometry.Angle-        Graphics.Gloss.Geometry.Line-        Graphics.Gloss.Data.Display-        Graphics.Gloss.Data.Point-        Graphics.Gloss.Data.Vector-        Graphics.Gloss.Data.Quad-        Graphics.Gloss.Data.Extent-        Graphics.Gloss.Data.QuadTree-        Graphics.Gloss.Data.Color-        Graphics.Gloss.Data.Picture-        Graphics.Gloss.Data.ViewPort         Graphics.Gloss.Data.ViewState         Graphics.Gloss.Algorithms.RayCast         Graphics.Gloss.Interface.Pure.Display@@ -87,12 +76,6 @@         Graphics.Gloss.Internals.Interface.ViewState.Motion         Graphics.Gloss.Internals.Interface.ViewState.Reshape         Graphics.Gloss.Internals.Interface.Window-        Graphics.Gloss.Internals.Render.Bitmap-        Graphics.Gloss.Internals.Render.Circle-        Graphics.Gloss.Internals.Render.Common-        Graphics.Gloss.Internals.Render.State-        Graphics.Gloss.Internals.Render.Picture-         Graphics.Gloss.Internals.Interface.Display         Graphics.Gloss.Internals.Interface.Animate         Graphics.Gloss.Internals.Interface.Simulate