packages feed

gloss 1.1.1.0 → 1.2.0.0

raw patch · 40 files changed

+974/−646 lines, 40 filesdep ~containersPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: containers

API changes (from Hackage documentation)

- Graphics.Gloss: simulateInWindow :: String -> (Int, Int) -> (Int, Int) -> Color -> Int -> world -> (world -> Picture) -> (ViewPort -> Float -> world -> world) -> IO ()
- Graphics.Gloss.Color: addColors :: Color -> Color -> Color
- Graphics.Gloss.Color: aquamarine :: Color
- Graphics.Gloss.Color: azure :: Color
- Graphics.Gloss.Color: black :: Color
- Graphics.Gloss.Color: blue :: Color
- Graphics.Gloss.Color: bright :: Color -> Color
- Graphics.Gloss.Color: chartreuse :: Color
- Graphics.Gloss.Color: cyan :: Color
- Graphics.Gloss.Color: dark :: Color -> Color
- Graphics.Gloss.Color: data Color
- Graphics.Gloss.Color: dim :: Color -> Color
- Graphics.Gloss.Color: green :: Color
- Graphics.Gloss.Color: greyN :: Float -> Color
- Graphics.Gloss.Color: instance Eq Color
- Graphics.Gloss.Color: instance Show Color
- Graphics.Gloss.Color: light :: Color -> Color
- Graphics.Gloss.Color: magenta :: Color
- Graphics.Gloss.Color: makeColor :: Float -> Float -> Float -> Float -> Color
- Graphics.Gloss.Color: makeColor8 :: Int -> Int -> Int -> Int -> Color
- Graphics.Gloss.Color: mixColors :: Float -> Float -> Color -> Color -> Color
- Graphics.Gloss.Color: orange :: Color
- Graphics.Gloss.Color: red :: Color
- Graphics.Gloss.Color: rgbaOfColor :: Color -> (Float, Float, Float, Float)
- Graphics.Gloss.Color: rose :: Color
- Graphics.Gloss.Color: violet :: Color
- Graphics.Gloss.Color: white :: Color
- Graphics.Gloss.Color: yellow :: Color
- Graphics.Gloss.Data.QuadTree: instance (Show a) => Show (QuadTree a)
- Graphics.Gloss.Game: AdditionalButton :: Int -> MouseButton
- Graphics.Gloss.Game: Char :: Char -> Key
- Graphics.Gloss.Game: Down :: KeyState
- Graphics.Gloss.Game: EventKey :: Key -> KeyState -> Modifiers -> (Float, Float) -> Event
- Graphics.Gloss.Game: EventMotion :: (Float, Float) -> Event
- Graphics.Gloss.Game: KeyBegin :: SpecialKey
- Graphics.Gloss.Game: KeyDelete :: SpecialKey
- Graphics.Gloss.Game: KeyDown :: SpecialKey
- Graphics.Gloss.Game: KeyEnd :: SpecialKey
- Graphics.Gloss.Game: KeyF1 :: SpecialKey
- Graphics.Gloss.Game: KeyF10 :: SpecialKey
- Graphics.Gloss.Game: KeyF11 :: SpecialKey
- Graphics.Gloss.Game: KeyF12 :: SpecialKey
- Graphics.Gloss.Game: KeyF2 :: SpecialKey
- Graphics.Gloss.Game: KeyF3 :: SpecialKey
- Graphics.Gloss.Game: KeyF4 :: SpecialKey
- Graphics.Gloss.Game: KeyF5 :: SpecialKey
- Graphics.Gloss.Game: KeyF6 :: SpecialKey
- Graphics.Gloss.Game: KeyF7 :: SpecialKey
- Graphics.Gloss.Game: KeyF8 :: SpecialKey
- Graphics.Gloss.Game: KeyF9 :: SpecialKey
- Graphics.Gloss.Game: KeyHome :: SpecialKey
- Graphics.Gloss.Game: KeyInsert :: SpecialKey
- Graphics.Gloss.Game: KeyLeft :: SpecialKey
- Graphics.Gloss.Game: KeyNumLock :: SpecialKey
- Graphics.Gloss.Game: KeyPageDown :: SpecialKey
- Graphics.Gloss.Game: KeyPageUp :: SpecialKey
- Graphics.Gloss.Game: KeyRight :: SpecialKey
- Graphics.Gloss.Game: KeyUp :: SpecialKey
- Graphics.Gloss.Game: LeftButton :: MouseButton
- Graphics.Gloss.Game: MiddleButton :: MouseButton
- Graphics.Gloss.Game: Modifiers :: KeyState -> KeyState -> KeyState -> Modifiers
- Graphics.Gloss.Game: MouseButton :: MouseButton -> Key
- Graphics.Gloss.Game: RightButton :: MouseButton
- Graphics.Gloss.Game: SpecialKey :: SpecialKey -> Key
- Graphics.Gloss.Game: Up :: KeyState
- Graphics.Gloss.Game: WheelDown :: MouseButton
- Graphics.Gloss.Game: WheelUp :: MouseButton
- Graphics.Gloss.Game: alt :: Modifiers -> KeyState
- Graphics.Gloss.Game: ctrl :: Modifiers -> KeyState
- Graphics.Gloss.Game: data Event
- Graphics.Gloss.Game: data Key :: *
- Graphics.Gloss.Game: data KeyState :: *
- Graphics.Gloss.Game: data Modifiers :: *
- Graphics.Gloss.Game: data MouseButton :: *
- Graphics.Gloss.Game: data SpecialKey :: *
- Graphics.Gloss.Game: gameInWindow :: String -> (Int, Int) -> (Int, Int) -> Color -> Int -> world -> (world -> Picture) -> (Event -> world -> world) -> (Float -> world -> world) -> IO ()
- Graphics.Gloss.Game: shift :: Modifiers -> KeyState
- Graphics.Gloss.Geometry.Vector: angleVV :: Vector -> Vector -> Float
- Graphics.Gloss.Geometry.Vector: argV :: Vector -> Float
- Graphics.Gloss.Geometry.Vector: detV :: Vector -> Vector -> Float
- Graphics.Gloss.Geometry.Vector: dotV :: Vector -> Vector -> Float
- Graphics.Gloss.Geometry.Vector: instance Num (Float, Float)
- Graphics.Gloss.Geometry.Vector: magV :: Vector -> Float
- Graphics.Gloss.Geometry.Vector: mulSV :: Float -> Vector -> Vector
- Graphics.Gloss.Geometry.Vector: normaliseV :: Vector -> Vector
- Graphics.Gloss.Geometry.Vector: rotateV :: Float -> Vector -> Vector
- Graphics.Gloss.Geometry.Vector: unitVectorAtAngle :: Float -> Vector
- Graphics.Gloss.Picture: Blank :: Picture
- Graphics.Gloss.Picture: Circle :: Float -> Picture
- Graphics.Gloss.Picture: Color :: Color -> Picture -> Picture
- Graphics.Gloss.Picture: Line :: Path -> Picture
- Graphics.Gloss.Picture: Pictures :: [Picture] -> Picture
- Graphics.Gloss.Picture: Polygon :: Path -> Picture
- Graphics.Gloss.Picture: Rotate :: Float -> Picture -> Picture
- Graphics.Gloss.Picture: Scale :: Float -> Float -> Picture -> Picture
- Graphics.Gloss.Picture: Text :: String -> Picture
- Graphics.Gloss.Picture: ThickCircle :: Float -> Float -> Picture
- Graphics.Gloss.Picture: Translate :: Float -> Float -> Picture -> Picture
- Graphics.Gloss.Picture: data Picture
- Graphics.Gloss.Picture: instance Eq Picture
- Graphics.Gloss.Picture: instance Show Picture
- Graphics.Gloss.Picture: type Path = [Point]
- Graphics.Gloss.Picture: type Point = (Float, Float)
- Graphics.Gloss.Picture: type Vector = Point
- Graphics.Gloss.Shapes: lineLoop :: Path -> Picture
- Graphics.Gloss.Shapes: rectanglePath :: Float -> Float -> Path
- Graphics.Gloss.Shapes: rectangleSolid :: Float -> Float -> Picture
- Graphics.Gloss.Shapes: rectangleUpperPath :: Float -> Float -> Path
- Graphics.Gloss.Shapes: rectangleUpperSolid :: Float -> Float -> Picture
- Graphics.Gloss.Shapes: rectangleUpperWire :: Float -> Float -> Picture
- Graphics.Gloss.Shapes: rectangleWire :: Float -> Float -> Picture
- Graphics.Gloss.ViewPort: ViewPort :: (Float, Float) -> Float -> Float -> ViewPort
- Graphics.Gloss.ViewPort: data ViewPort
- Graphics.Gloss.ViewPort: viewPortInit :: ViewPort
- Graphics.Gloss.ViewPort: viewPortRotate :: ViewPort -> Float
- Graphics.Gloss.ViewPort: viewPortScale :: ViewPort -> Float
- Graphics.Gloss.ViewPort: viewPortTranslate :: ViewPort -> (Float, Float)
+ Graphics.Gloss.Data.Color: addColors :: Color -> Color -> Color
+ Graphics.Gloss.Data.Color: aquamarine :: Color
+ Graphics.Gloss.Data.Color: azure :: Color
+ Graphics.Gloss.Data.Color: black :: Color
+ Graphics.Gloss.Data.Color: blue :: Color
+ Graphics.Gloss.Data.Color: bright :: Color -> Color
+ Graphics.Gloss.Data.Color: chartreuse :: Color
+ Graphics.Gloss.Data.Color: cyan :: Color
+ Graphics.Gloss.Data.Color: dark :: Color -> Color
+ Graphics.Gloss.Data.Color: data Color
+ Graphics.Gloss.Data.Color: dim :: Color -> Color
+ Graphics.Gloss.Data.Color: green :: Color
+ Graphics.Gloss.Data.Color: greyN :: Float -> Color
+ Graphics.Gloss.Data.Color: instance Eq Color
+ Graphics.Gloss.Data.Color: instance Show Color
+ Graphics.Gloss.Data.Color: light :: Color -> Color
+ Graphics.Gloss.Data.Color: magenta :: Color
+ Graphics.Gloss.Data.Color: makeColor :: Float -> Float -> Float -> Float -> Color
+ Graphics.Gloss.Data.Color: makeColor8 :: Int -> Int -> Int -> Int -> Color
+ Graphics.Gloss.Data.Color: mixColors :: Float -> Float -> Color -> Color -> Color
+ Graphics.Gloss.Data.Color: orange :: Color
+ Graphics.Gloss.Data.Color: red :: Color
+ Graphics.Gloss.Data.Color: rgbaOfColor :: Color -> (Float, Float, Float, Float)
+ Graphics.Gloss.Data.Color: rose :: Color
+ Graphics.Gloss.Data.Color: violet :: Color
+ Graphics.Gloss.Data.Color: white :: Color
+ Graphics.Gloss.Data.Color: yellow :: Color
+ Graphics.Gloss.Data.Picture: Blank :: Picture
+ Graphics.Gloss.Data.Picture: Circle :: Float -> Picture
+ Graphics.Gloss.Data.Picture: Color :: Color -> Picture -> Picture
+ Graphics.Gloss.Data.Picture: Line :: Path -> Picture
+ Graphics.Gloss.Data.Picture: Pictures :: [Picture] -> Picture
+ Graphics.Gloss.Data.Picture: Polygon :: Path -> Picture
+ Graphics.Gloss.Data.Picture: Rotate :: Float -> Picture -> Picture
+ Graphics.Gloss.Data.Picture: Scale :: Float -> Float -> Picture -> Picture
+ Graphics.Gloss.Data.Picture: Text :: String -> Picture
+ Graphics.Gloss.Data.Picture: ThickCircle :: Float -> Float -> Picture
+ Graphics.Gloss.Data.Picture: Translate :: Float -> Float -> Picture -> Picture
+ Graphics.Gloss.Data.Picture: blank :: Picture
+ Graphics.Gloss.Data.Picture: circle :: Float -> Picture
+ Graphics.Gloss.Data.Picture: color :: Color -> Picture -> Picture
+ Graphics.Gloss.Data.Picture: data Picture
+ Graphics.Gloss.Data.Picture: instance Eq Picture
+ Graphics.Gloss.Data.Picture: instance Monoid Picture
+ Graphics.Gloss.Data.Picture: instance Show Picture
+ Graphics.Gloss.Data.Picture: line :: Path -> Picture
+ Graphics.Gloss.Data.Picture: lineLoop :: Path -> Picture
+ Graphics.Gloss.Data.Picture: pictures :: [Picture] -> Picture
+ Graphics.Gloss.Data.Picture: polygon :: Path -> Picture
+ Graphics.Gloss.Data.Picture: rectanglePath :: Float -> Float -> Path
+ Graphics.Gloss.Data.Picture: rectangleSolid :: Float -> Float -> Picture
+ Graphics.Gloss.Data.Picture: rectangleUpperPath :: Float -> Float -> Path
+ Graphics.Gloss.Data.Picture: rectangleUpperSolid :: Float -> Float -> Picture
+ Graphics.Gloss.Data.Picture: rectangleUpperWire :: Float -> Float -> Picture
+ Graphics.Gloss.Data.Picture: rectangleWire :: Float -> Float -> Picture
+ Graphics.Gloss.Data.Picture: rotate :: Float -> Picture -> Picture
+ Graphics.Gloss.Data.Picture: scale :: Float -> Float -> Picture -> Picture
+ Graphics.Gloss.Data.Picture: text :: String -> Picture
+ Graphics.Gloss.Data.Picture: thickCircle :: Float -> Float -> Picture
+ Graphics.Gloss.Data.Picture: translate :: Float -> Float -> Picture -> Picture
+ Graphics.Gloss.Data.Picture: type Path = [Point]
+ Graphics.Gloss.Data.Picture: type Point = (Float, Float)
+ Graphics.Gloss.Data.Picture: type Vector = Point
+ Graphics.Gloss.Data.Point: instance Num Point
+ Graphics.Gloss.Data.Point: pointInBox :: Point -> Point -> Point -> Bool
+ Graphics.Gloss.Data.Point: type Point = (Float, Float)
+ Graphics.Gloss.Data.QuadTree: instance Show a => Show (QuadTree a)
+ Graphics.Gloss.Data.Vector: angleVV :: Vector -> Vector -> Float
+ Graphics.Gloss.Data.Vector: argV :: Vector -> Float
+ Graphics.Gloss.Data.Vector: detV :: Vector -> Vector -> Float
+ Graphics.Gloss.Data.Vector: dotV :: Vector -> Vector -> Float
+ Graphics.Gloss.Data.Vector: magV :: Vector -> Float
+ Graphics.Gloss.Data.Vector: mulSV :: Float -> Vector -> Vector
+ Graphics.Gloss.Data.Vector: normaliseV :: Vector -> Vector
+ Graphics.Gloss.Data.Vector: rotateV :: Float -> Vector -> Vector
+ Graphics.Gloss.Data.Vector: type Vector = Point
+ Graphics.Gloss.Data.Vector: unitVectorAtAngle :: Float -> Vector
+ Graphics.Gloss.Geometry.Line: intersectLineLine :: Point -> Point -> Point -> Point -> Maybe Point
+ Graphics.Gloss.Geometry.Line: intersectSegHorzLine :: Point -> Point -> Float -> Maybe Point
+ Graphics.Gloss.Geometry.Line: intersectSegLine :: Point -> Point -> Point -> Point -> Maybe Point
+ Graphics.Gloss.Geometry.Line: intersectSegSeg :: Point -> Point -> Point -> Point -> Maybe Point
+ Graphics.Gloss.Geometry.Line: intersectSegVertLine :: Point -> Point -> Float -> Maybe Point
+ Graphics.Gloss.Geometry.Line: segClearsBox :: Point -> Point -> Point -> Point -> Bool
+ Graphics.Gloss.Interface.Game: AdditionalButton :: Int -> MouseButton
+ Graphics.Gloss.Interface.Game: Char :: Char -> Key
+ Graphics.Gloss.Interface.Game: Down :: KeyState
+ Graphics.Gloss.Interface.Game: EventKey :: Key -> KeyState -> Modifiers -> (Float, Float) -> Event
+ Graphics.Gloss.Interface.Game: EventMotion :: (Float, Float) -> Event
+ Graphics.Gloss.Interface.Game: KeyBegin :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyDelete :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyDown :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyEnd :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyF1 :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyF10 :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyF11 :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyF12 :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyF2 :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyF3 :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyF4 :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyF5 :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyF6 :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyF7 :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyF8 :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyF9 :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyHome :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyInsert :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyLeft :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyNumLock :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyPageDown :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyPageUp :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyRight :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyUp :: SpecialKey
+ Graphics.Gloss.Interface.Game: LeftButton :: MouseButton
+ Graphics.Gloss.Interface.Game: MiddleButton :: MouseButton
+ Graphics.Gloss.Interface.Game: Modifiers :: KeyState -> KeyState -> KeyState -> Modifiers
+ Graphics.Gloss.Interface.Game: MouseButton :: MouseButton -> Key
+ Graphics.Gloss.Interface.Game: RightButton :: MouseButton
+ Graphics.Gloss.Interface.Game: SpecialKey :: SpecialKey -> Key
+ Graphics.Gloss.Interface.Game: Up :: KeyState
+ Graphics.Gloss.Interface.Game: WheelDown :: MouseButton
+ Graphics.Gloss.Interface.Game: WheelUp :: MouseButton
+ Graphics.Gloss.Interface.Game: alt :: Modifiers -> KeyState
+ Graphics.Gloss.Interface.Game: ctrl :: Modifiers -> KeyState
+ Graphics.Gloss.Interface.Game: data Event
+ Graphics.Gloss.Interface.Game: data Key :: *
+ Graphics.Gloss.Interface.Game: data KeyState :: *
+ Graphics.Gloss.Interface.Game: data Modifiers :: *
+ Graphics.Gloss.Interface.Game: data MouseButton :: *
+ Graphics.Gloss.Interface.Game: data SpecialKey :: *
+ Graphics.Gloss.Interface.Game: gameInWindow :: String -> (Int, Int) -> (Int, Int) -> Color -> Int -> world -> (world -> Picture) -> (Event -> world -> world) -> (Float -> world -> world) -> IO ()
+ Graphics.Gloss.Interface.Game: shift :: Modifiers -> KeyState
+ Graphics.Gloss.Interface.Simulate: ViewPort :: (Float, Float) -> Float -> Float -> ViewPort
+ Graphics.Gloss.Interface.Simulate: data ViewPort
+ Graphics.Gloss.Interface.Simulate: simulateInWindow :: String -> (Int, Int) -> (Int, Int) -> Color -> Int -> model -> (model -> Picture) -> (ViewPort -> Float -> model -> model) -> IO ()
+ Graphics.Gloss.Interface.Simulate: viewPortRotate :: ViewPort -> Float
+ Graphics.Gloss.Interface.Simulate: viewPortScale :: ViewPort -> Float
+ Graphics.Gloss.Interface.Simulate: viewPortTranslate :: ViewPort -> (Float, Float)

Files

Graphics/Gloss.hs view
@@ -19,33 +19,31 @@ -- --	* Zoom Viewport - mouse wheel, or page up\/down-keys. -----   Animations and simulations can be constructed similarly using the `animateInWindow` ---   and `simulateInWindow` functions. +--   Animations can be constructed similarly using the `animateInWindow`. -----   If you want to manage your own key\/mouse events then use gameInWindow from the---   Graphics.Gloss.Game module.+--   If you want to run a simulation based around finite time steps then try+--   `simulateInWindow` from "Graphics.Gloss.Interface.Simulate". --+--   If you want to manage your own key\/mouse events then use `gameInWindow` from+--   "Graphics.Gloss.Interface.Game".+-- --   Gloss uses OpenGL under the hood, but you don't have to worry about any of that. -- -- @ --   Release Notes:---   Since 1.0.0.2:+--   For 1.1.0.0: --     Added game mode. --     Added QuadTree and Extent structures. --     Added simple ray casting. -- @ -- module Graphics.Gloss -	( module Graphics.Gloss.Picture-	, module Graphics.Gloss.Color-	, module Graphics.Gloss.ViewPort+	( module Graphics.Gloss.Data.Picture+	, module Graphics.Gloss.Data.Color 	, displayInWindow -	, animateInWindow-	, simulateInWindow)+	, animateInWindow) where-import Graphics.Gloss.Picture-import Graphics.Gloss.Color-import Graphics.Gloss.ViewPort+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color import Graphics.Gloss.Internals.Interface.Display	(displayInWindow) import Graphics.Gloss.Internals.Interface.Animate	(animateInWindow)-import Graphics.Gloss.Internals.Interface.Simulate	(simulateInWindow)
Graphics/Gloss/Algorithms/RayCast.hs view
@@ -5,7 +5,7 @@ 	( castSegIntoCellularQuadTree 	, traceSegIntoCellularQuadTree) where-import Graphics.Gloss.Picture+import Graphics.Gloss.Data.Picture import Graphics.Gloss.Data.Quad import Graphics.Gloss.Data.Extent import Graphics.Gloss.Data.QuadTree@@ -32,7 +32,7 @@  castSegIntoCellularQuadTree p1 p2 extent tree 	| cells@(_:_)	<- traceSegIntoCellularQuadTree p1 p2 extent tree-	, c : _		<- sortBy ((compareDistanceTo p1) `on` (\(a, b, c) -> a) ) cells+	, c : _		<- sortBy ((compareDistanceTo p1) `on` (\(a, _, _) -> a) ) cells 	= Just c 	 	| otherwise
− Graphics/Gloss/Color.hs
@@ -1,184 +0,0 @@---- | Predefined and custom colors.-module Graphics.Gloss.Color-	( -	-- ** Color data type-	  Color-	, makeColor-	, makeColor8-	, 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 qualified Graphics.Rendering.OpenGL.GL	as GL---- | 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)----- | 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----- | 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)--	--- | Take the RGBA components of a color.-rgbaOfColor :: Color -> (Float, Float, Float, Float)-rgbaOfColor (RGBA r g b a)	= (r, g, b, a)-		---- 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
+ Graphics/Gloss/Data/Color.hs view
@@ -0,0 +1,182 @@++-- | Predefined and custom colors.+module Graphics.Gloss.Data.Color+	( +	-- ** Color data type+	  Color+	, makeColor+	, makeColor8+	, 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++-- | 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)+++-- | 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+++-- | 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)++	+-- | Take the RGBA components of a color.+rgbaOfColor :: Color -> (Float, Float, Float, Float)+rgbaOfColor (RGBA r g b a)	= (r, g, b, a)+		++-- 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
Graphics/Gloss/Data/Extent.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE PatternGuards #-} --- | Represents a rectangular area of the 2D plane.---	The bounds are represented as integers so that we can compare extents for equality.+-- | 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@@ -19,7 +19,7 @@ 	, intersectSegExtent 	, touchesSegExtent) where-import Graphics.Gloss.Picture	(Point)+import Graphics.Gloss.Data.Point import Graphics.Gloss.Data.Quad import Graphics.Gloss.Geometry.Line import Data.Maybe@@ -28,11 +28,7 @@ -- | A rectangular area of the 2D plane. --   We keep the type abstract to ensure that invalid extents cannot be constructed. data Extent-	= Extent-	{ extentNorth	:: Int-	, extentSouth	:: Int-	, extentEast	:: Int-	, extentWest	:: Int }+	= Extent Int Int Int Int 	deriving (Eq, Show)  @@ -155,7 +151,7 @@ --   @ --  intersectSegExtent :: Point -> Point -> Extent -> Maybe Point-intersectSegExtent p1@(x1, y1) p2 extent@(Extent n' s' e' w')+intersectSegExtent p1@(x1, y1) p2 (Extent n' s' e' w') 	-- starts below extent 	| y1 < s 	, Just pos	<- intersectSegHorzSeg p1 p2 s w e@@ -188,7 +184,7 @@  -- | 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@(Extent n' s' e' w')+touchesSegExtent p1 p2 extent 	=   pointInExtent extent p1        	 || pointInExtent extent p2 	 || isJust (intersectSegExtent p1 p2 extent)
+ Graphics/Gloss/Data/Picture.hs view
@@ -0,0 +1,165 @@++-- | Data types for representing pictures.+module Graphics.Gloss.Data.Picture+	( Point+	, Vector+	, Path+	, Picture(..)++	-- * Aliases for Picture constructors+	, blank, polygon, line, circle, thickCircle, text+	, color, translate, rotate, scale+	, pictures++	-- * Line loops+ 	, lineLoop+	+	-- * Rectangles+	, rectanglePath, 	rectangleWire, 		rectangleSolid+	, rectangleUpperPath,	rectangleUpperWire, 	rectangleUpperSolid)+where+import Graphics.Gloss.Data.Color+import Graphics.Gloss.Data.Point+import Graphics.Gloss.Data.Vector+import Data.Monoid+++-- | 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 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++	-- | Some text to draw with a vector font.+	| Text		String++	-- 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 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)+++-- Instances -------------------------------------------------------------------------------------+instance Monoid Picture where+	mempty		= blank+	mappend a b	= Pictures [a, b]+	mconcat		= Pictures++++-- Constructors ----------------------------------------------------------------------------------+blank :: Picture+blank	= Blank++polygon :: Path -> Picture+polygon = Polygon++line :: Path -> Picture+line 	= Line++circle :: Float -> Picture+circle 	= Circle++thickCircle :: Float -> Float -> Picture+thickCircle = ThickCircle++text :: String -> Picture+text = Text++color :: Color -> Picture -> Picture+color = Color++translate :: Float -> Float -> Picture -> Picture+translate = Translate++rotate :: Float -> Picture -> Picture+rotate = Rotate++scale :: Float -> Float -> Picture -> Picture+scale = Scale++pictures :: [Picture] -> Picture+pictures = Pictures+++-- Shapes ----------------------------------------------------------------------------------------+-- | A closed loop along this path.+lineLoop :: Path -> Picture+lineLoop []	= Line []+lineLoop (x:xs)	= Line ((x:xs) ++ [x])+++-- | A path representing a rectangle centered about the origin,+--	with the given width and height.+rectanglePath :: Float -> Float -> Path+rectanglePath sizeX sizeY			+ = let	sx	= sizeX / 2+	sy	= sizeY / 2+   in	[(-sx, -sy), (-sx, sy), (sx, sy), (sx, -sy)]+++-- | A wireframe rectangle centered about the origin,+--	with the given width and height.+rectangleWire :: Float -> Float -> Picture+rectangleWire sizeX sizeY+	= lineLoop $ rectanglePath sizeX sizeY+++-- | A wireframe rectangle in the y > 0 half of the x-y plane,+--	with the given width and height.+rectangleUpperWire :: Float -> Float -> Picture+rectangleUpperWire sizeX sizeY+	= lineLoop $ rectangleUpperPath sizeX sizeY+++-- | A path representing a rectangle in the y > 0 half of the x-y plane,+--	with the given width and height+rectangleUpperPath :: Float -> Float -> Path+rectangleUpperPath sizeX sy+ = let 	sx	= sizeX / 2+   in  	[(-sx, 0), (-sx, sy), (sx, sy), (sx, 0)]+++-- | A solid rectangle centered about the origin, +--	with the given width and height.+rectangleSolid :: Float -> Float -> Picture+rectangleSolid sizeX sizeY+	= Polygon $ rectanglePath sizeX sizeY+++-- | A sold rectangle in the y > 0 half of the x-y plane,+--	with the given width and height.+rectangleUpperSolid :: Float -> Float -> Picture+rectangleUpperSolid sizeX sizeY+	= Polygon  $ rectangleUpperPath sizeX sizeY
+ Graphics/Gloss/Data/Point.hs view
@@ -0,0 +1,46 @@+{-# OPTIONS -fno-warn-missing-methods #-}+{-# LANGUAGE TypeSynonymInstances #-}+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)+	negate (x, y)		= (negate x, negate y)	+++-- | 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
Graphics/Gloss/Data/QuadTree.hs view
@@ -86,7 +86,7 @@ --   If the path intersects an existing `TLeaf` then return the original tree. insertByPath :: [Quad] -> a -> QuadTree a -> QuadTree a 	-insertByPath [] x tree+insertByPath [] x _ 	= TLeaf x 	 insertByPath (q:qs) x tree@@ -155,7 +155,7 @@  	 = case tree of 		TNil	-> [] 		TLeaf x	-		 -> let (n, s, e, w) = takeExtent extent+		 -> let (_, s, _, w) = takeExtent extent 		    in  [((w, s), x)]  		TNode{}	-> concat $ map (flattenQuad extent tree) allQuads
+ Graphics/Gloss/Data/Vector.hs view
@@ -0,0 +1,86 @@+{-# 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+{-# INLINE magV #-}+magV (x, y) 	+	= sqrt (x * x + y * y)++-- | The angle of this vector, relative to the +ve x-axis.+argV :: Vector -> Float+{-# INLINE argV #-}+argV (x, y)+	= normaliseAngle $ atan2 y x++-- | The dot product of two vectors.+dotV :: Vector -> Vector -> Float+{-# INLINE dotV #-}+dotV (x1, x2) (y1, y2)+	= x1 * y1 + x2 * y2++-- | The determinant of two vectors.+detV :: Vector -> Vector -> Float+{-# INLINE detV #-}+detV (x1, y1) (x2, y2)+	= x1 * y2 - y1 * x2++-- | Multiply a vector by a scalar.+mulSV :: Float -> Vector -> Vector+{-# INLINE mulSV #-}+mulSV s (x, y)		+	= (s * x, s * y)++-- | Rotate a vector by an angle (in radians). +ve angle is counter-clockwise.+rotateV :: Float -> Vector -> Vector+{-# INLINE rotateV #-}+rotateV r (x, y)+ = 	(  x * cos r - y * sin r+        ,  x * sin r + y * cos r)+++-- | Compute the inner angle (in radians) between two vectors.+angleVV :: Vector -> Vector -> Float+{-# INLINE angleVV #-}+angleVV p1 p2+ = let 	m1	= magV p1+ 	m2	= magV p2+	d	= p1 `dotV` p2+	aDiff	= acos $ d / (m1 * m2)++   in	aDiff	+++-- | Normalise a vector, so it has a magnitude of 1.+normaliseV :: Vector -> Vector+{-# INLINE normaliseV #-}+normaliseV v	= mulSV (1 / magV v) v+++-- | Produce a unit vector at a given angle relative to the +ve x-axis.+--	The provided angle is in radians.+unitVectorAtAngle :: Float -> Vector+{-# INLINE unitVectorAtAngle #-}+unitVectorAtAngle r+	= (cos r, sin r)+
− Graphics/Gloss/Game.hs
@@ -1,18 +0,0 @@---- We export this stuff separately so we don't clutter up the --- API of the Graphics.Gloss module.---- | This game mode lets you manage your own input. Pressing ESC will still abort the program,---   but you don't get automatic pan and zoom controls like with `displayInWindow`.-module Graphics.Gloss.Game- 	( module Graphics.Gloss.Picture-	, module Graphics.Gloss.Color-	, module Graphics.Gloss.ViewPort-	, gameInWindow-	, Event(..), Key(..), SpecialKey(..), MouseButton(..), KeyState(..), Modifiers(..))-where-import Graphics.Gloss.Picture-import Graphics.Gloss.Color-import Graphics.Gloss.ViewPort-import Graphics.Gloss.Internals.Interface.Game		(gameInWindow, Event(..))-import Graphics.UI.GLUT.Callbacks.Window
Graphics/Gloss/Geometry.hs view
@@ -1,10 +1,8 @@  module Graphics.Gloss.Geometry 	( module Graphics.Gloss.Geometry.Angle-	, module Graphics.Gloss.Geometry.Vector 	, module Graphics.Gloss.Geometry.Line ) where import Graphics.Gloss.Geometry.Angle-import Graphics.Gloss.Geometry.Vector import Graphics.Gloss.Geometry.Line 	
Graphics/Gloss/Geometry/Line.hs view
@@ -1,15 +1,50 @@ {-# LANGUAGE PatternGuards #-} --- | Geometric functions concerning lines.+-- | 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-	( closestPointOnLine+	( 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.Picture	(Point)-import Graphics.Gloss.Geometry.Vector+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@@ -58,31 +93,181 @@  	/ (p2 - p1) `dotV` (p2 - p1)  --- | Check if line segment (P1-P2) clears a box (P3-P4) by being well outside it.-segClearsBox -	:: Point	-- ^ P1 First point of segment. ++-- Line-Line intersection -------------------------------------------------------------------------++-- | Given four points specifying two lines, get the point where the two lines cross, if any.+--   Note that the lines extend off to infinity, so the intersection point might not lie+--   between either of the two pairs of points.+--+-- @+--     \\      /+--      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.-	-> Point 	-- ^ P3 Lower left point of box.-	-> Point	-- ^ P4 Upper right point of box.-	-> Bool+	-> 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) -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  +-- | 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+--                 + P2 --                /---   (xa, y3) ---+---- (xb, y3)+-- (xa, y3)  +---+----+ (xb, y3) --              /---             /---           P1+--          P1 + -- @   intersectSegHorzSeg@@ -108,13 +293,13 @@ -- | Check if an arbitrary segment intersects a vertical segment. -- -- @---         (x3, yb)---               |   P1+--      (x3, yb) ++--               |   + P1 --               | / --               + --             / |---          P2   |---             (x3, ya)+--        P2 +   |+--               + (x3, ya) -- @   intersectSegVertSeg@@ -135,3 +320,5 @@ 	 	where y0 | (x2 - x1) == 0	= y1 		 | otherwise		= (x0 - x1) * (y2 - y1) / (x2 - x1) + y1++
− Graphics/Gloss/Geometry/Vector.hs
@@ -1,94 +0,0 @@-{-# OPTIONS -fno-warn-missing-methods #-}-{-# LANGUAGE FlexibleInstances #-}---- | Geometric functions concerning vectors.-module Graphics.Gloss.Geometry.Vector-	( magV-	, argV-	, dotV-	, detV-	, mulSV-	, rotateV-	, angleVV-	, normaliseV-	, unitVectorAtAngle )-where-import Graphics.Gloss.Picture		(Vector)-import Graphics.Gloss.Geometry.Angle----- | Pretend a vector 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 (Float, Float) where-	(+) (x1, y1) (x2, y2)	= (x1 + x2, y1 + y2)- 	(-) (x1, y1) (x2, y2)	= (x1 - x2, y1 - y2)-	negate (x, y)		= (negate x, negate y)	----- | The magnitude of a vector.-magV :: Vector -> Float-{-# INLINE magV #-}-magV (x, y) 	-	= sqrt (x * x + y * y)---- | The angle of this vector, relative to the +ve x-axis.-argV :: Vector -> Float-{-# INLINE argV #-}-argV (x, y)-	= normaliseAngle $ atan2 y x---- | The dot product of two vectors.-dotV :: Vector -> Vector -> Float-{-# INLINE dotV #-}-dotV (x1, x2) (y1, y2)-	= x1 * y1 + x2 * y2---- | The determinant of two vectors.-detV :: Vector -> Vector -> Float-{-# INLINE detV #-}-detV (x1, y1) (x2, y2)-	= x1 * y2 - y1 * x2---- | Multiply a vector by a scalar.-mulSV :: Float -> Vector -> Vector-{-# INLINE mulSV #-}-mulSV s (x, y)		-	= (s * x, s * y)---- | Rotate a vector by an angle (in radians). +ve angle is counter-clockwise.-rotateV :: Float -> Vector -> Vector-{-# INLINE rotateV #-}-rotateV r (x, y)- = 	(  x * cos r - y * sin r-        ,  x * sin r + y * cos r)----- | Compute the inner angle (in radians) between two vectors.-angleVV :: Vector -> Vector -> Float-{-# INLINE angleVV #-}-angleVV p1@(x1, y1) p2@(x2, y2)- = let 	m1	= magV p1- 	m2	= magV p2-	d	= p1 `dotV` p2-	aDiff	= acos $ d / (m1 * m2)--   in	aDiff	----- | Normalise a vector, so it has a magnitude of 1.-normaliseV :: Vector -> Vector-{-# INLINE normaliseV #-}-normaliseV v	= mulSV (1 / magV v) v----- | Produce a unit vector at a given angle relative to the +ve x-axis.---	The provided angle is in radians.-unitVectorAtAngle :: Float -> Vector-{-# INLINE unitVectorAtAngle #-}-unitVectorAtAngle r-	= (cos r, sin r)-
+ Graphics/Gloss/Interface/Game.hs view
@@ -0,0 +1,16 @@++-- We export this stuff separately so we don't clutter up the +-- API of the Graphics.Gloss module.++-- | This game mode lets you manage your own input. Pressing ESC will still abort the program,+--   but you don't get automatic pan and zoom controls like with `displayInWindow`.+module Graphics.Gloss.Interface.Game+ 	( module Graphics.Gloss.Data.Picture+	, module Graphics.Gloss.Data.Color+	, gameInWindow+	, Event(..), Key(..), SpecialKey(..), MouseButton(..), KeyState(..), Modifiers(..))+where+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import Graphics.Gloss.Internals.Interface.Game		(gameInWindow, Event(..))+import Graphics.UI.GLUT.Callbacks.Window
+ Graphics/Gloss/Interface/Simulate.hs view
@@ -0,0 +1,17 @@++-- We export this stuff separately so we don't clutter up the +-- API of the Graphics.Gloss module.++-- | Simulate mode is for producing an animation of some model who's picture+--   changes over finite time steps. The behavior of the model can also depent+--   on the current `ViewPort`.+module Graphics.Gloss.Interface.Simulate+ 	( module Graphics.Gloss.Data.Picture+	, module Graphics.Gloss.Data.Color+	, ViewPort(..)+	, simulateInWindow)+where+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import Graphics.Gloss.Internals.Interface.ViewPort+import Graphics.Gloss.Internals.Interface.Simulate	(simulateInWindow)
Graphics/Gloss/Internals/Color.hs view
@@ -2,7 +2,7 @@  module Graphics.Gloss.Internals.Color where -import Graphics.Gloss.Color+import Graphics.Gloss.Data.Color import qualified Graphics.Rendering.OpenGL.GL		as GL  import Unsafe.Coerce
Graphics/Gloss/Internals/Interface/Animate.hs view
@@ -3,13 +3,13 @@ module Graphics.Gloss.Internals.Interface.Animate 	(animateInWindow) where	-import Graphics.Gloss.Color-import Graphics.Gloss.Picture-import Graphics.Gloss.ViewPort+import Graphics.Gloss.Data.Color+import Graphics.Gloss.Data.Picture import Graphics.Gloss.Internals.Render.Picture import Graphics.Gloss.Internals.Render.ViewPort import Graphics.Gloss.Internals.Interface.Window import Graphics.Gloss.Internals.Interface.Common.Exit+import Graphics.Gloss.Internals.Interface.ViewPort import Graphics.Gloss.Internals.Interface.ViewPort.KeyMouse import Graphics.Gloss.Internals.Interface.ViewPort.Motion import Graphics.Gloss.Internals.Interface.ViewPort.Reshape@@ -75,6 +75,6 @@  	createWindow name size pos backColor callbacks -+getsIORef :: IORef a -> (a -> r) -> IO r getsIORef ref fun  = liftM fun $ readIORef ref
Graphics/Gloss/Internals/Interface/Animate/State.hs view
@@ -38,6 +38,7 @@ 	, stateGateTimeElapsed		:: Int }  +stateInit :: State stateInit 	= State 	{ stateAnimate			= True
Graphics/Gloss/Internals/Interface/Animate/Timing.hs view
@@ -17,8 +17,7 @@ import Control.Concurrent import Data.IORef import qualified Graphics.UI.GLUT			as GLUT-import qualified Graphics.Rendering.OpenGL.GL		as GL-import Graphics.UI.GLUT					(($=), get)+import Graphics.UI.GLUT					(get)   -- | Handles animation timing details.@@ -77,5 +76,6 @@ 		, stateGateTimeElapsed	= gateTimeElapsed }  +getsIORef :: IORef a -> (a -> r) -> IO r getsIORef ref fun  = liftM fun $ readIORef ref
Graphics/Gloss/Internals/Interface/Common/Exit.hs view
@@ -5,17 +5,19 @@ module Graphics.Gloss.Internals.Interface.Common.Exit 	(callback_exit) where-import	Graphics.Gloss.Internals.Interface.Callback-import	qualified Graphics.UI.GLUT		as GLUT-import	qualified System.Exit			as System+import Graphics.Gloss.Internals.Interface.Callback+import qualified Graphics.UI.GLUT		as GLUT+import qualified System.Exit			as System +callback_exit :: a -> Callback callback_exit stateRef  =	KeyMouse (keyMouse_exit stateRef) +keyMouse_exit :: a -> GLUT.KeyboardMouseCallback keyMouse_exit-	stateRef-	key keyState keyMods-	pos+	_+	key keyState _+	_  	-- exit 	| key		== GLUT.Char '\27'
Graphics/Gloss/Internals/Interface/Debug.hs view
@@ -7,10 +7,9 @@ 	, dumpFramebufferState 	, dumpFragmentState ) where- import qualified Graphics.Rendering.OpenGL.GL	as GL import qualified Graphics.UI.GLUT		as GLUT-import Graphics.UI.GLUT			(($=), get)+import Graphics.UI.GLUT			(get)   -- | Dump the internal state of GLUT
Graphics/Gloss/Internals/Interface/Display.hs view
@@ -3,13 +3,13 @@ module Graphics.Gloss.Internals.Interface.Display 	(displayInWindow) where	-import Graphics.Gloss.Color-import Graphics.Gloss.Picture-import Graphics.Gloss.ViewPort+import Graphics.Gloss.Data.Color+import Graphics.Gloss.Data.Picture import Graphics.Gloss.Internals.Render.Picture import Graphics.Gloss.Internals.Render.ViewPort import Graphics.Gloss.Internals.Interface.Window import Graphics.Gloss.Internals.Interface.Common.Exit+import Graphics.Gloss.Internals.Interface.ViewPort import Graphics.Gloss.Internals.Interface.ViewPort.KeyMouse import Graphics.Gloss.Internals.Interface.ViewPort.Motion import Graphics.Gloss.Internals.Interface.ViewPort.Reshape
Graphics/Gloss/Internals/Interface/Game.hs view
@@ -1,25 +1,22 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE RankNTypes #-} {-# OPTIONS_HADDOCK hide #-}  module Graphics.Gloss.Internals.Interface.Game 	( gameInWindow 	, Event(..)) where-import Graphics.Gloss.Color-import Graphics.Gloss.Picture-import Graphics.Gloss.ViewPort+import Graphics.Gloss.Data.Color+import Graphics.Gloss.Data.Picture import Graphics.Gloss.Internals.Render.Picture import Graphics.Gloss.Internals.Render.ViewPort import Graphics.Gloss.Internals.Interface.Window import Graphics.Gloss.Internals.Interface.Callback import Graphics.Gloss.Internals.Interface.Common.Exit-import Graphics.Gloss.Internals.Interface.ViewPort.KeyMouse-import Graphics.Gloss.Internals.Interface.ViewPort.Motion+import Graphics.Gloss.Internals.Interface.ViewPort import Graphics.Gloss.Internals.Interface.ViewPort.Reshape import Graphics.Gloss.Internals.Interface.Animate.Timing import Graphics.Gloss.Internals.Interface.Simulate.Idle import qualified Graphics.Gloss.Internals.Interface.Callback			as Callback-import qualified Graphics.Gloss.Internals.Interface.ViewPort.ControlState	as VPC import qualified Graphics.Gloss.Internals.Interface.Simulate.State		as SM import qualified Graphics.Gloss.Internals.Interface.Animate.State		as AN import qualified Graphics.Gloss.Internals.Render.Options			as RO@@ -70,7 +67,6 @@  	-- make the initial GL view and render states 	viewSR		<- newIORef viewPortInit-	viewControlSR	<- newIORef VPC.stateInit 	renderSR	<- newIORef RO.optionsInit 	animateSR	<- newIORef AN.stateInit @@ -118,18 +114,19 @@ callback_keyMouse worldRef viewRef eventFn  	= KeyMouse (handle_keyMouse worldRef viewRef eventFn) -handle_keyMouse worldRef viewRef eventFn key keyState keyMods pos- = do	size@(GLUT.Size sizeX_ sizeY_)	<- GL.get GLUT.windowSize-	let (sizeX, sizeY)		= (fromIntegral sizeX_, fromIntegral sizeY_) -	let GLUT.Position 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')-  +handle_keyMouse +	:: IORef a+	-> t+	-> (Event -> a -> a)+	-> GLUT.Key+	-> GLUT.KeyState+	-> GLUT.Modifiers+	-> GL.Position+	-> IO ()++handle_keyMouse worldRef _ eventFn key keyState keyMods pos+ = do	pos' <- convertPoint pos 	worldRef `modifyIORef` \world -> eventFn (EventKey key keyState keyMods pos') world  @@ -142,14 +139,29 @@ callback_motion worldRef eventFn  	= Motion (handle_motion worldRef eventFn) -handle_motion worldRef eventFn pos- = let	GLUT.Position x y	= pos-	pos'			= (fromIntegral x, fromIntegral y)-   in	worldRef `modifyIORef` \world -> eventFn (EventMotion pos') world -+handle_motion +	:: IORef a+	-> (Event -> a -> a)+	-> GL.Position+	-> IO () +handle_motion worldRef eventFn pos+ = do pos' <- convertPoint pos+      worldRef `modifyIORef` \world -> eventFn (EventMotion pos') world  +convertPoint :: GL.Position -> IO (Float,Float)+convertPoint pos+ = do	(GLUT.Size sizeX_ sizeY_) <- GL.get GLUT.windowSize+	let (sizeX, sizeY)		= (fromIntegral sizeX_, fromIntegral sizeY_) +	let GLUT.Position 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' 
Graphics/Gloss/Internals/Interface/Simulate.hs view
@@ -1,16 +1,16 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE RankNTypes #-} {-# OPTIONS_HADDOCK hide #-}  module Graphics.Gloss.Internals.Interface.Simulate 	(simulateInWindow) where-import Graphics.Gloss.Color-import Graphics.Gloss.Picture-import Graphics.Gloss.ViewPort+import Graphics.Gloss.Data.Color+import Graphics.Gloss.Data.Picture import Graphics.Gloss.Internals.Render.Picture import Graphics.Gloss.Internals.Render.ViewPort import Graphics.Gloss.Internals.Interface.Window import Graphics.Gloss.Internals.Interface.Common.Exit+import Graphics.Gloss.Internals.Interface.ViewPort import Graphics.Gloss.Internals.Interface.ViewPort.KeyMouse import Graphics.Gloss.Internals.Interface.ViewPort.Motion import Graphics.Gloss.Internals.Interface.ViewPort.Reshape@@ -21,26 +21,25 @@ import qualified Graphics.Gloss.Internals.Interface.Simulate.State		as SM import qualified Graphics.Gloss.Internals.Interface.Animate.State		as AN import qualified Graphics.Gloss.Internals.Render.Options			as RO-import qualified Graphics.UI.GLUT						as GLUT import Data.IORef import System.Mem --- | Run a finite-time-step simulation in a window. You decide how the world is represented,---	how to convert the world to a picture, and how to advance the world for each unit of time. +-- | Run a finite-time-step simulation in a window. You decide how the model is represented,+--	how to convert the model to a picture, and how to advance the model for each unit of time.  --	This function does the rest. -- --   Once the window is open you can use the same commands as with @displayInWindow@. -- simulateInWindow -	:: forall world+	:: forall model 	.  String			-- ^ Name of the window. 	-> (Int, Int)			-- ^ Initial size of the window, in pixels. 	-> (Int, Int)			-- ^ Initial position of the window, in pixels. 	-> Color			-- ^ Background color. 	-> Int				-- ^ Number of simulation steps to take for each second of real time.-	-> world 			-- ^ The initial world.-	-> (world -> Picture)	 	-- ^ A function to convert the world a picture.-	-> (ViewPort -> Float -> world -> world) -- ^ A function to step the world one iteration. It is passed the +	-> model 			-- ^ The initial model.+	-> (model -> Picture)	 	-- ^ A function to convert the model to a picture.+	-> (ViewPort -> Float -> model -> model) -- ^ A function to step the model one iteration. It is passed the  						 --	current viewport and the amount of time for this simulation 						 --     step (in seconds). 	-> IO ()
Graphics/Gloss/Internals/Interface/Simulate/Idle.hs view
@@ -3,11 +3,11 @@ module Graphics.Gloss.Internals.Interface.Simulate.Idle 	( callback_simulate_idle ) where-import Graphics.Gloss.ViewPort+import Graphics.Gloss.Internals.Interface.ViewPort import qualified Graphics.Gloss.Internals.Interface.Animate.State	as AN import qualified Graphics.Gloss.Internals.Interface.Simulate.State	as SM import qualified Graphics.UI.GLUT					as GLUT-import Graphics.UI.GLUT							(($=), get)+import Graphics.UI.GLUT							(get) import Data.IORef import Control.Monad @@ -45,6 +45,7 @@    -- reset the world to +simulate_reset :: IORef SM.State -> IORef a -> a -> IO () simulate_reset simSR worldSR worldStart  = do	writeIORef worldSR worldStart @@ -65,7 +66,7 @@ 	-> (ViewPort -> Float -> world -> world) 	-> IO () 	-simulate_run simSR animateSR viewSR worldSR worldAdvance+simulate_run simSR _ viewSR worldSR worldAdvance  = do	 	simS		<- readIORef simSR 	viewS		<- readIORef viewSR@@ -103,7 +104,7 @@  	-- keep advancing the world until we get to the final iteration number 	let (_, world')	= -		until 	(\(n, w) 	-> n >= nFinal)+		until 	(\(n, _) 	-> n >= nFinal) 			(\(n, w)	-> (n+1, worldAdvance viewS timePerStep w)) 			(nStart, worldS) 	@@ -132,9 +133,7 @@  simulate_step simSR viewSR worldSR worldAdvance singleStepTime  = do-	simS		<- readIORef simSR 	viewS		<- readIORef viewSR-	  	world		<- readIORef worldSR 	let world'	= worldAdvance viewS singleStepTime world 	@@ -146,5 +145,6 @@ 	GLUT.postRedisplay Nothing  +getsIORef :: IORef a -> (a -> r) -> IO r getsIORef ref fun  = liftM fun $ readIORef ref
Graphics/Gloss/Internals/Interface/Simulate/State.hs view
@@ -31,6 +31,7 @@ 	  -- | Initial control state+stateInit :: Int -> State stateInit resolution  	= State  	{ stateIteration		= 0
+ Graphics/Gloss/Internals/Interface/ViewPort.hs view
@@ -0,0 +1,29 @@++-- | 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'.+module Graphics.Gloss.Internals.Interface.ViewPort+	( ViewPort(..)+	, viewPortInit )+where+	+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 +	}
Graphics/Gloss/Internals/Interface/ViewPort/Command.hs view
@@ -1,4 +1,5 @@ {-# OPTIONS_HADDOCK hide #-}+{-# OPTIONS -fno-warn-missing-signatures #-} {-# LANGUAGE PatternGuards #-}  module Graphics.Gloss.Internals.Interface.ViewPort.Command@@ -6,7 +7,6 @@ 	, defaultCommandConfig 	, isCommand ) where-import Data.Map					(Map) import qualified Graphics.UI.GLUT		as GLUT import qualified Data.Map			as Map @@ -89,7 +89,7 @@ 	| otherwise 	= False -isCommand2 c key keyMods cMatch+isCommand2 _ key keyMods cMatch 	| (keyC, mModsC)	<- cMatch 	, keyC == key 	, case mModsC of
Graphics/Gloss/Internals/Interface/ViewPort/KeyMouse.hs view
@@ -4,9 +4,9 @@ module Graphics.Gloss.Internals.Interface.ViewPort.KeyMouse 	(callback_viewPort_keyMouse) where-import Graphics.Gloss.ViewPort+import Graphics.Gloss.Data.Vector import Graphics.Gloss.Geometry.Angle-import Graphics.Gloss.Geometry.Vector+import Graphics.Gloss.Internals.Interface.ViewPort import Graphics.Gloss.Internals.Interface.ViewPort.Command import Graphics.Gloss.Internals.Interface.Callback import qualified Graphics.Gloss.Internals.Interface.ViewPort.ControlState	as VPC@@ -27,6 +27,15 @@  	= KeyMouse (viewPort_keyMouse portRef controlRef)  +viewPort_keyMouse+	:: IORef ViewPort+	-> IORef VPC.State+	-> GLUT.Key+	-> GLUT.KeyState+	-> GLUT.Modifiers+	-> GL.Position+	-> IO ()+ viewPort_keyMouse portRef controlRef key keyState keyMods pos  = do	commands	<- controlRef `getsIORef` VPC.stateCommands  @@ -34,13 +43,9 @@ 		++ "keyMouse keyState = " ++ show keyState	++ "\n" 		++ "keyMouse keyMods  = " ++ show keyMods 	++ "\n" -}-	viewPort_keyMouse2 commands portRef controlRef key keyState keyMods pos-	-viewPort_keyMouse2-	commands portRef controlRef-	key keyState keyMods-	pos-+	viewPort_keyMouse2 commands+ where+   viewPort_keyMouse2 commands 	-- restore viewport 	| isCommand commands CRestore key keyMods 	, keyState	== GLUT.Down@@ -65,22 +70,22 @@ 	-- bump left 	| isCommand commands CBumpLeft key keyMods 	, keyState	== GLUT.Down-	= 	motionBump portRef controlRef (20, 0)+	= 	motionBump portRef (20, 0)  	-- bump right 	| isCommand commands CBumpRight key keyMods 	, keyState	== GLUT.Down-	= 	motionBump portRef controlRef (-20, 0)+	= 	motionBump portRef (-20, 0)  	-- bump up 	| isCommand commands CBumpUp key keyMods 	, keyState	== GLUT.Down-	= 	motionBump portRef controlRef (0, 20)+	= 	motionBump portRef (0, 20)  	-- bump down 	| isCommand commands CBumpDown key keyMods 	, keyState	== GLUT.Down-	= 	motionBump portRef controlRef (0, -20)+	= 	motionBump portRef (0, -20)  	-- bump clockwise 	| isCommand commands CBumpClockwise key keyMods@@ -141,6 +146,7 @@ 	= return ()  +controlZoomIn :: IORef ViewPort -> IORef VPC.State -> IO () controlZoomIn portRef controlRef  = do	scaleStep	<- controlRef `getsIORef` VPC.stateScaleStep 	portRef `modifyIORef` \s -> s { @@ -148,6 +154,7 @@ 	GLUT.postRedisplay Nothing  +controlZoomOut :: IORef ViewPort -> IORef VPC.State -> IO () controlZoomOut portRef controlRef  = do	scaleStep	<- controlRef `getsIORef` VPC.stateScaleStep  	portRef `modifyIORef` \s -> s {@@ -155,17 +162,18 @@ 	GLUT.postRedisplay Nothing  +motionBump :: IORef ViewPort -> (Float, Float) -> IO () motionBump-	portRef controlRef+	portRef 	(bumpX, bumpY)  = do 	(transX, transY) 		<- portRef `getsIORef` viewPortTranslate -	s	<- portRef `getsIORef` viewPortScale+	scale	<- portRef `getsIORef` viewPortScale 	r	<- portRef `getsIORef` viewPortRotate -	let offset	= (bumpX / s, bumpY / s)+	let offset	= (bumpX / scale, bumpY / scale)  	let (oX, oY)	= rotateV (degToRad r) offset @@ -175,7 +183,8 @@ 		 	, transY + oY) } 			 	GLUT.postRedisplay Nothing-  + +getsIORef :: IORef a -> (a -> r) -> IO r getsIORef ref fun  = liftM fun $ readIORef ref
Graphics/Gloss/Internals/Interface/ViewPort/Motion.hs view
@@ -1,11 +1,12 @@ {-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE ScopedTypeVariables #-}  module Graphics.Gloss.Internals.Interface.ViewPort.Motion 	(callback_viewPort_motion) where-import Graphics.Gloss.ViewPort+import Graphics.Gloss.Data.Vector import Graphics.Gloss.Geometry.Angle-import Graphics.Gloss.Geometry.Vector+import Graphics.Gloss.Internals.Interface.ViewPort import Graphics.Gloss.Internals.Interface.Callback import qualified Graphics.Gloss.Internals.Interface.ViewPort.ControlState	as VPC import qualified Graphics.UI.GLUT						as GLUT@@ -25,6 +26,12 @@  	= Motion (viewPort_motion portRef controlRef)  viewPort_motion+	:: IORef ViewPort+	-> IORef VPC.State+	-> GL.Position+	-> IO ()+	+viewPort_motion 	portRef controlRef 	pos  = do@@ -51,21 +58,28 @@ 		pos )  +motionTranslate+	:: IORef ViewPort+        -> IORef VPC.State+        -> (GL.GLint, GL.GLint)+        -> GL.Position+	-> IO ()+  motionTranslate  	portRef controlRef-	(markX, markY)+	(markX :: GL.GLint, markY :: GL.GLint) 	(GL.Position posX posY)  = do 	(transX, transY) 		<- portRef `getsIORef` viewPortTranslate -	s	<- portRef `getsIORef` viewPortScale+	scale	<- portRef `getsIORef` viewPortScale 	r	<- portRef `getsIORef` viewPortRotate  	let dX		= fromIntegral $ markX - posX 	let dY		= fromIntegral $ markY - posY -	let offset	= (dX / s, dY / s)+	let offset	= (dX / scale, dY / scale)  	let (oX, oY)	= rotateV (degToRad r) offset @@ -81,9 +95,16 @@ 	GLUT.postRedisplay Nothing  +motionRotate+	:: IORef ViewPort+	-> IORef VPC.State+	-> (GL.GLint, GL.GLint)+	-> GL.Position+	-> IO ()+ motionRotate  	portRef controlRef-	(markX, markY)+	(markX :: GL.GLint, _markY :: GL.GLint) 	(GL.Position posX posY)  = do  	rotate		<- portRef    `getsIORef` viewPortRotate@@ -100,5 +121,6 @@ 	GLUT.postRedisplay Nothing  +getsIORef :: IORef a -> (a -> r) -> IO r getsIORef ref fun  = liftM fun $ readIORef ref
Graphics/Gloss/Internals/Interface/ViewPort/Reshape.hs view
@@ -4,7 +4,7 @@ 	(callback_viewPort_reshape) where import Graphics.Gloss.Internals.Interface.Callback-import Graphics.UI.GLUT					(($=), get)+import Graphics.UI.GLUT					(($=)) import qualified Graphics.UI.GLUT			as GLUT import qualified Graphics.Rendering.OpenGL.GL		as GL @@ -12,10 +12,11 @@ -- | Callback to handle keyboard and mouse button events --	for controlling the viewport. callback_viewPort_reshape :: Callback- callback_viewPort_reshape  	= Reshape (viewPort_reshape) ++viewPort_reshape :: GL.Size -> IO () viewPort_reshape size  = do 	-- Setup the viewport
Graphics/Gloss/Internals/Interface/Window.hs view
@@ -4,8 +4,7 @@ module	Graphics.Gloss.Internals.Interface.Window 	( createWindow ) where--import Graphics.Gloss.Color+import Graphics.Gloss.Data.Color import Graphics.Gloss.Internals.Color import Graphics.Gloss.Internals.Interface.Debug import Graphics.Gloss.Internals.Interface.Callback		(Callback)@@ -29,8 +28,8 @@  createWindow 	windowName-	size@(sizeX, sizeY) -	pos @(posX,  posY)+	(sizeX, sizeY) +	(posX,  posY) 	clearColor 	callbacks  = do@@ -38,7 +37,7 @@ 	let debug	= False  	-- Initialize GLUT- 	(progName, args)	<- GLUT.getArgsAndInitialize+ 	(_progName, _args)	<- GLUT.getArgsAndInitialize 	glutVersion		<- get GLUT.glutVersion  	when debug@@ -76,7 +75,7 @@ 	when debug 	 $ do	putStr	$ "* creating window\n\n" -	GLUT.createWindow windowName+	_ <- GLUT.createWindow windowName 	GLUT.windowSize	 	 $= 	GL.Size  			(fromIntegral sizeX)@@ -123,7 +122,8 @@ 	return ()  -callbackDisplay clearColor callbacks+callbackDisplay :: t -> [Callback] -> IO ()+callbackDisplay _ callbacks  = do 	-- clear the display 	GL.clear [GL.ColorBuffer, GL.DepthBuffer]@@ -139,20 +139,41 @@  	return ()  +callbackReshape :: [Callback] -> GLUT.Size -> IO () callbackReshape callbacks size  	= sequence_ 	$ map 	(\f -> f size) 		[f | Callback.Reshape f 	<- callbacks] ++callbackKeyMouse+	:: [Callback]+	-> GLUT.Key+	-> GLUT.KeyState+	-> GLUT.Modifiers+	-> GLUT.Position+	-> IO ()+ callbackKeyMouse callbacks key keystate modifiers pos  	= sequence_  	$ map 	(\f -> f key keystate modifiers pos)  		[f | Callback.KeyMouse f 	<- callbacks] ++callbackMotion+	:: [Callback]+	-> GLUT.Position+	-> IO ()+ callbackMotion callbacks pos  	= sequence_ 	$ map	(\f -> f pos) 		[f | Callback.Motion f 		<- callbacks]+++callbackIdle+	:: [Callback]+	-> IO ()  callbackIdle callbacks  	= sequence_
Graphics/Gloss/Internals/Render/Circle.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE BangPatterns, MagicHash, PatternGuards #-} {-# OPTIONS_HADDOCK hide #-}  -- | Fast(ish) rendering of circles.@@ -7,9 +7,7 @@ import 	Graphics.Gloss.Internals.Render.Common import	qualified Graphics.Rendering.OpenGL.GL		as GL import	GHC.Exts-import	GHC.Prim - -- | Render a circle with the given thickness renderCircle :: Float -> Float -> Float -> Float -> Float -> IO () renderCircle posX posY scaleFactor radius thickness@@ -31,16 +29,6 @@ 	| otherwise	= 40  --- | 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#- renderCircleLine_step :: Float# -> Float# -> Float# -> Float# -> Float# -> Float# -> IO () renderCircleLine_step posX posY tStep tStop rad tt 	| tt `geFloat#` tStop@@ -53,7 +41,17 @@ 			(gf $ F# (posY `plusFloat#` (rad `timesFloat#` (sinFloat# tt))))  		renderCircleLine_step posX posY tStep tStop rad (tt `plusFloat#` tStep)- ++-- | 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#+  -- | Render a circle with a given thickness as a triangle strip renderCircleStrip :: Float -> Float -> Int -> Float -> Float -> IO ()
Graphics/Gloss/Internals/Render/Options.hs view
@@ -24,6 +24,7 @@ 	  -- | Default render options+optionsInit :: Options optionsInit 	= Options 	{ optionsColor		= True
Graphics/Gloss/Internals/Render/Picture.hs view
@@ -5,19 +5,16 @@ module Graphics.Gloss.Internals.Render.Picture 	( renderPicture ) where-import	Graphics.Gloss.Picture-import	Graphics.Gloss.Color-import	Graphics.Gloss.ViewPort+import	Graphics.Gloss.Data.Picture+import	Graphics.Gloss.Data.Color+import	Graphics.Gloss.Internals.Interface.ViewPort import	Graphics.Gloss.Internals.Render.Options import	Graphics.Gloss.Internals.Render.Common import	Graphics.Gloss.Internals.Render.Circle import	Graphics.UI.GLUT						(($=), get)-import  qualified Graphics.Rendering.OpenGL.GLU.Matrix 			as GLU import	qualified Graphics.Rendering.OpenGL.GL				as GL import	qualified Graphics.UI.GLUT					as GLUT -import 	Data.IORef-import	Control.Monad  -- ^ Render a picture using the given render options and viewport. renderPicture@@ -51,7 +48,13 @@ 	setBlendAlpha	(optionsBlendAlpha renderS) 	 	drawPicture picture-	  ++drawPicture +	:: ( ?modeWireframe::Bool+	   , ?scale::Float+	   , ?modeColor::Bool) +	=> Picture -> IO ()	  + drawPicture picture  = {-# SCC "drawComponent" #-}    case picture of@@ -93,13 +96,13 @@ 		GL.blend	$= GL.Enabled  	-- colors with float components.-	Color color p+	Color col p 	 |  ?modeColor 	 ->  {-# SCC "draw.color" #-}    	     do 		oldColor 	 <- get GL.currentColor -		let (r, g, b, a) = rgbaOfColor color+		let (r, g, b, a) = rgbaOfColor col  		GL.currentColor	 			$= GL.Color4 (gf r) (gf g) (gf b) (gf a)@@ -149,6 +152,7 @@  -- Utils ------------------------------------------------------------------------------------------ -- | Turn alpha blending on or off+setBlendAlpha :: Bool -> IO () setBlendAlpha state  	| state	  	= do	GL.blend	$= GL.Enabled@@ -159,6 +163,7 @@ 		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
Graphics/Gloss/Internals/Render/ViewPort.hs view
@@ -5,7 +5,7 @@ module Graphics.Gloss.Internals.Render.ViewPort 	( withViewPort ) where-import	Graphics.Gloss.ViewPort+import	Graphics.Gloss.Internals.Interface.ViewPort import	Graphics.Rendering.OpenGL					(GLfloat) import 	Graphics.UI.GLUT						(($=), get) import	qualified Graphics.UI.GLUT					as GLUT@@ -25,7 +25,7 @@ 	 $ do 		-- setup the co-ordinate system 	 	GL.loadIdentity-		size@(GL.Size sizeX sizeY) +		(GL.Size sizeX sizeY)  				<- get GLUT.windowSize 		let (sx, sy)	= (fromIntegral sizeX / 2, fromIntegral sizeY / 2) 
− Graphics/Gloss/Picture.hs
@@ -1,62 +0,0 @@---- | Data types for representing pictures.-module Graphics.Gloss.Picture-	( Point-	, Vector-	, Path-	, Picture(..))-where--import Graphics.Gloss.Color---- | A point on the x-y plane.-type Point	= (Float, Float)			---- | A vector can be treated as a point, and vis-versa.-type Vector	= Point---- | 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 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--	-- | Some text to draw with a vector font.-	| Text		String--	-- 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 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)-
− Graphics/Gloss/Shapes.hs
@@ -1,77 +0,0 @@---- | Functions for drawing shapes that aren't constructors of the `Picture` data type.-module Graphics.Gloss.Shapes-	( lineLoop-	, rectangleWire, 	rectangleSolid, 	rectanglePath-	, rectangleUpperWire, 	rectangleUpperSolid,	rectangleUpperPath )-where-import Graphics.Gloss.Picture---- | A closed loop along this path.-lineLoop :: Path -> Picture-lineLoop []	= Line []-lineLoop (x:xs)	= Line ((x:xs) ++ [x])----- Rectangles ---------------------------------------------------------------------------------------- | A wireframe rectangle centered about the origin.-rectangleWire -	:: Float 	-- ^ width-	-> Float 	-- ^ height-	-> Picture-rectangleWire sizeX sizeY-	= lineLoop $ rectanglePath sizeX sizeY----- | A solid rectangle centered about the origin.-rectangleSolid -	:: Float 	-- ^ width-	-> Float 	-- ^ height-	-> Picture--rectangleSolid sizeX sizeY-	= Polygon $ rectanglePath sizeX sizeY----- | A path representing a rectangle centered about the origin.-rectanglePath -	:: Float 	-- ^ width-	-> Float 	-- ^ height-	-> Path--rectanglePath sizeX sizeY			- = let	sx	= sizeX / 2-	sy	= sizeY / 2-   in	[(-sx, -sy), (-sx, sy), (sx, sy), (sx, -sy)]----- | A wireframe rectangle in the y > 0 half of the x-y plane.-rectangleUpperWire -	:: Float 	-- ^ width-	-> Float 	-- ^ height-	-> Picture--rectangleUpperWire sizeX sizeY-	= lineLoop $ rectangleUpperPath sizeX sizeY----- | A sold rectangle in the y > 0 half of the x-y plane.-rectangleUpperSolid -	:: Float 	-- ^ width-	-> Float 	-- ^ height-	-> Picture--rectangleUpperSolid sizeX sizeY-	= Polygon  $ rectangleUpperPath sizeX sizeY----- | A path representing a rectangle in the y > 0 half of the x-y plane.-rectangleUpperPath -	:: Float 	-- ^ width-	-> Float 	-- ^ height-	-> Path--rectangleUpperPath sizeX sy- = let 	sx	= sizeX / 2-   in  	[(-sx, 0), (-sx, sy), (sx, sy), (sx, 0)]-
− Graphics/Gloss/ViewPort.hs
@@ -1,29 +0,0 @@---- | 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'.-module Graphics.Gloss.ViewPort-	( ViewPort(..)-	, viewPortInit )-where-	-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 -	}
gloss.cabal view
@@ -1,9 +1,9 @@ Name:                gloss-Version:             1.1.1.0+Version:             1.2.0.0 License:             MIT License-file:        LICENSE Author:              Ben Lippmeier-Maintainer:          gloss@ouroborus.net+Maintainer:          benl@ouroborus.net Build-Type:          Simple Cabal-Version:       >=1.6 Stability:           provisional@@ -24,27 +24,27 @@   Build-Depends:          base       == 4.*,         ghc-prim   == 0.2.*,-        containers == 0.3.*,+        containers >= 0.3.0 && < 0.5.0,         OpenGL     == 2.4.*,         GLUT       == 2.2.* -  ghc-options:      -O2+  ghc-options:      -O2 -Wall    Exposed-modules:         Graphics.Gloss-        Graphics.Gloss.Game-        Graphics.Gloss.Color-        Graphics.Gloss.Picture-        Graphics.Gloss.Shapes-        Graphics.Gloss.ViewPort         Graphics.Gloss.Geometry         Graphics.Gloss.Geometry.Angle         Graphics.Gloss.Geometry.Line-        Graphics.Gloss.Geometry.Vector+        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.Algorithms.RayCast+        Graphics.Gloss.Interface.Simulate+        Graphics.Gloss.Interface.Game    Other-modules:         Graphics.Gloss.Internals.Color@@ -59,6 +59,7 @@         Graphics.Gloss.Internals.Interface.Simulate.Idle         Graphics.Gloss.Internals.Interface.Simulate.State         Graphics.Gloss.Internals.Interface.Game+        Graphics.Gloss.Internals.Interface.ViewPort         Graphics.Gloss.Internals.Interface.ViewPort.Command         Graphics.Gloss.Internals.Interface.ViewPort.ControlState         Graphics.Gloss.Internals.Interface.ViewPort.KeyMouse