packages feed

gloss (empty) → 1.0.0.0

raw patch · 34 files changed

+2387/−0 lines, 34 filesdep +GLUTdep +OpenGLdep +basesetup-changed

Dependencies added: GLUT, OpenGL, base, containers, ghc-prim

Files

+ Graphics/Gloss.hs view
@@ -0,0 +1,40 @@++-- | Gloss hides the pain of drawing simple vector graphics behind a nice data type and+--	a few display functions. +--+--   Getting something on the screen is as easy as:+--+--  @+--    import Graphics.Gloss+--    main = `displayInWindow` \"My Window\" (200, 200) (10, 10) `white` (`Circle` 80)+--  @+--+--   Once the window is open you can use the following:+--+-- 	* Quit - esc-key.+--+--	* Move Viewport - left-click drag, arrow keys.+--+--	* Rotate Viewport - right-click drag, control-left-click drag, or home\/end-keys.+--+--	* Zoom Viewport - mouse wheel, or page up\/down-keys.+--+--   Animations and simulations can be constructed similarly using the `animateInWindow` +--   and `simulateInWindow` functions. +--+--   Gloss uses OpenGL under the hood, but you don't have to worry about any of that.+--+module Graphics.Gloss +	( module Graphics.Gloss.Picture+	, module Graphics.Gloss.Color+	, module Graphics.Gloss.ViewPort+	, displayInWindow +	, animateInWindow+	, simulateInWindow)+where+import Graphics.Gloss.Picture+import Graphics.Gloss.Color+import Graphics.Gloss.ViewPort+import Graphics.Gloss.Internals.Interface.Display	(displayInWindow)+import Graphics.Gloss.Internals.Interface.Animate	(animateInWindow)+import Graphics.Gloss.Internals.Interface.Simulate	(simulateInWindow)
+ Graphics/Gloss/Color.hs view
@@ -0,0 +1,184 @@++-- | 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/Geometry.hs view
@@ -0,0 +1,10 @@++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/Angle.hs view
@@ -0,0 +1,32 @@++-- | 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 < 0	+	= normaliseAngle (f + 2 * pi)+	+	| f > 2 * pi+	= normaliseAngle (f - 2 * pi)++	| otherwise+	= f
+ Graphics/Gloss/Geometry/Line.hs view
@@ -0,0 +1,44 @@++-- | Geometric functions concerning lines.+module Graphics.Gloss.Geometry.Line+	( closestPointOnLine+	, closestPointOnLine_param )+where+import Graphics.Gloss.Picture	(Point)+import Graphics.Gloss.Geometry.Vector++-- | 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	= closestPointOnLine_param 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	  return 0+--	if P4 == P2	  return 1+--	if P4 is halfway between P1 and P2 then return 0.5+-- @+{-# INLINE closestPointOnLine_param #-}+closestPointOnLine_param +	:: Point 	-- ^ `P1`+	-> Point 	-- ^ `P2`+	-> Point 	-- ^ `P3`+	-> Float++closestPointOnLine_param p1 p2 p3+ 	= (p3 - p1) `dotV` (p2 - p1) + 	/ (p2 - p1) `dotV` (p2 - p1)
+ Graphics/Gloss/Geometry/Vector.hs view
@@ -0,0 +1,94 @@+{-# 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/Internals/Color.hs view
@@ -0,0 +1,19 @@+{-# OPTIONS_HADDOCK hide #-}++module Graphics.Gloss.Internals.Color where++import Graphics.Gloss.Color+import qualified Graphics.Rendering.OpenGL.GL		as GL++import Unsafe.Coerce++-- | Convert one of our Colors to OpenGL's representation.+glColor4OfColor :: Fractional a => Color -> GL.Color4 a+glColor4OfColor color+ = case rgbaOfColor color of+	(r, g, b, a)+	 -> let	rF	= unsafeCoerce r+		gF	= unsafeCoerce g+		bF	= unsafeCoerce b+		aF	= unsafeCoerce a+   	    in	GL.Color4 rF gF bF aF
+ Graphics/Gloss/Internals/Interface/Animate.hs view
@@ -0,0 +1,80 @@+{-# OPTIONS_HADDOCK hide #-}++module Graphics.Gloss.Internals.Interface.Animate+	(animateInWindow)+where	+import Graphics.Gloss.Color+import Graphics.Gloss.Picture+import Graphics.Gloss.ViewPort+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.KeyMouse+import Graphics.Gloss.Internals.Interface.ViewPort.Motion+import Graphics.Gloss.Internals.Interface.ViewPort.Reshape+import Graphics.Gloss.Internals.Interface.Animate.Timing+import qualified Graphics.Gloss.Internals.Render.Options			as RO+import qualified Graphics.Gloss.Internals.Interface.ViewPort.ControlState	as VPC+import qualified Graphics.Gloss.Internals.Interface.Animate.State		as AN+import qualified Graphics.Gloss.Internals.Interface.Callback			as Callback++import qualified Graphics.UI.GLUT				as GLUT+import Data.IORef+import Control.Monad+import System.Mem++-- | Open a new window and display the given animation.+--+--   Once the window is open you can use the same commands as with @displayInWindow@.+--+animateInWindow+	:: 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.+	-> (Float -> Picture)	-- ^ Function to produce the next frame of animation. +				--	It is passed the time in seconds since the program started.+	-> IO ()++animateInWindow name size pos backColor frameFun+ = do	+	viewSR		<- newIORef viewPortInit+	viewControlSR	<- newIORef VPC.stateInit+	renderSR	<- newIORef RO.optionsInit+	animateSR	<- newIORef AN.stateInit++ 	let displayFun = do+		-- extract the current time from the state+  	 	time		<- animateSR `getsIORef` AN.stateAnimateTime+		let timeS	= (fromIntegral time / 1000)++		-- call the user function to get the animation frame+		let picture	= frameFun timeS ++		renderS		<- readIORef renderSR+		viewS		<- readIORef viewSR++		-- render the frame+		withViewPort+			viewS+			(renderPicture renderS viewS picture)++		-- perform GC every frame to try and avoid long pauses+		performGC++	let callbacks+	     = 	[ Callback.Display	(animateBegin animateSR)+		, Callback.Display 	displayFun+		, Callback.Display	(animateEnd   animateSR)+		, Callback.Idle		(GLUT.postRedisplay Nothing)+		, callback_exit () +		, callback_viewPort_keyMouse viewSR viewControlSR +		, callback_viewPort_motion   viewSR viewControlSR +		, callback_viewPort_reshape ]++	createWindow name size pos backColor callbacks+++getsIORef ref fun+ = liftM fun $ readIORef ref
+ Graphics/Gloss/Internals/Interface/Animate/State.hs view
@@ -0,0 +1,51 @@+{-# OPTIONS_HADDOCK hide #-}++module Graphics.Gloss.Internals.Interface.Animate.State+	( State (..) +	, stateInit )+where++-- | Animation State+data State+	= State+	{+	-- | Whether the animation is running.+	  stateAnimate			:: Bool++	-- | Whether this is the first frame of the animation.+	, stateAnimateStart		:: Bool++	-- | Number of msec the animation has been running for+	, stateAnimateTime		:: Int++	-- | The time when we entered the display callback for the current frame.+	, stateDisplayTime		:: Int			+	, stateDisplayTimeLast		:: Int++	-- | Clamp the minimum time between frames to this value (in msec)+	--	Most LCD monitors refresh at around 50Hz so setting+	--	this to < 20msec probably isn't worthwhile.+	--+	, stateDisplayTimeClamp		:: Int			+							+	-- | The time when the last call to the users render function finished.+	, stateGateTimeStart		:: Int++	-- | The time when displayInWindow last finished (after sleeping to clamp fps).+	, stateGateTimeEnd		:: Int +	+	-- | How long it took to draw this frame+	, stateGateTimeElapsed		:: Int }+++stateInit+	= State+	{ stateAnimate			= True+	, stateAnimateStart		= True+	, stateAnimateTime		= 0+	, stateDisplayTime		= 0+	, stateDisplayTimeLast		= 0 +	, stateDisplayTimeClamp		= 20+	, stateGateTimeStart		= 0+	, stateGateTimeEnd		= 0 +	, stateGateTimeElapsed		= 0 }
+ Graphics/Gloss/Internals/Interface/Animate/Timing.hs view
@@ -0,0 +1,81 @@+{-# OPTIONS_HADDOCK hide #-}++-- | Handles timing of animation.+--	The main point is that we want to restrict the framerate to something+--	sensible, instead of just displaying at the machines maximum possible+--	rate and soaking up 100% cpu. +--+--	We also keep track of the elapsed time since the start of the program,+--	so we can pass this to the user's animation function.+-- +module Graphics.Gloss.Internals.Interface.Animate.Timing+	( animateBegin+	, animateEnd )+where+import Graphics.Gloss.Internals.Interface.Animate.State+import Control.Monad+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)+++-- | Handles animation timing details.+--	Call this function at the start of each frame.+animateBegin :: IORef State -> IO ()+animateBegin stateRef+ = do+	-- write the current time into the display state+	displayTime		<- get GLUT.elapsedTime+	displayTimeLast		<- stateRef `getsIORef` stateDisplayTime+	let displayTimeElapsed	= displayTime - displayTimeLast++	stateRef `modifyIORef` \s -> s +		{ stateDisplayTime	= displayTime +		, stateDisplayTimeLast	= displayTimeLast }++{-	putStr 	$  "  displayTime        = " ++ show displayTime 		++ "\n"+	 	++ "  displayTimeLast    = " ++ show displayTimeLast 		++ "\n"+		++ "  displayTimeElapsed = " ++ show displayTimeElapsed 	++ "\n"+-}++	-- increment the animation time+	animate			<- stateRef `getsIORef` stateAnimate+	animateTime		<- stateRef `getsIORef` stateAnimateTime+	animateStart		<- stateRef `getsIORef` stateAnimateStart+	+	when (animate && not animateStart)+	 $ do	stateRef `modifyIORef` \s -> s+			{ stateAnimateTime	= animateTime + displayTimeElapsed }+			+	when animate+	 $ do	stateRef `modifyIORef` \s -> s+	 		{ stateAnimateStart	= False }+++-- | Handles animation timing details.+--	Call this function at the end of each frame.+animateEnd :: IORef State -> IO ()+animateEnd stateRef+ = do+	-- timing gate, limits the maximum frame frequency (FPS)+	timeClamp	<- stateRef `getsIORef` stateDisplayTimeClamp++	gateTimeStart	<- get GLUT.elapsedTime				-- the start of this gate+	gateTimeEnd	<- stateRef `getsIORef` stateGateTimeEnd	-- end of the previous gate+	let gateTimeElapsed	+			= gateTimeStart - gateTimeEnd+	+	when (gateTimeElapsed < timeClamp)+	 $ do	threadDelay ((timeClamp - gateTimeElapsed) * 1000)++	gateTimeFinal	<- get GLUT.elapsedTime++	stateRef `modifyIORef` \s -> s +		{ stateGateTimeEnd	= gateTimeFinal +		, stateGateTimeElapsed	= gateTimeElapsed }+++getsIORef ref fun+ = liftM fun $ readIORef ref
+ Graphics/Gloss/Internals/Interface/Callback.hs view
@@ -0,0 +1,14 @@+{-# OPTIONS_HADDOCK hide #-}++-- | Event callbacks.+module Graphics.Gloss.Internals.Interface.Callback where++import qualified Graphics.UI.GLUT	as GLUT++-- | Holds callback functions.+data Callback+	= Display	GLUT.DisplayCallback+	| KeyMouse	GLUT.KeyboardMouseCallback+	| Idle		GLUT.IdleCallback+	| Motion	GLUT.MotionCallback	+	| Reshape	GLUT.ReshapeCallback
+ Graphics/Gloss/Internals/Interface/Common/Exit.hs view
@@ -0,0 +1,30 @@+{-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE PatternGuards #-}++-- | Callback for exiting the program.+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++callback_exit stateRef+ =	KeyMouse (keyMouse_exit stateRef)++keyMouse_exit+	stateRef+	key keyState keyMods+	pos++	-- exit+	| key		== GLUT.Char '\27'+	, keyState	== GLUT.Down+	= do+		-- non-freeglut doesn't like this+		-- GLUT.leaveMainLoop+		+		System.exitWith System.ExitSuccess++	| otherwise+	= return ()
+ Graphics/Gloss/Internals/Interface/Debug.hs view
@@ -0,0 +1,105 @@+{-# OPTIONS_HADDOCK hide #-}++-- | Implements functions to dump portions of the GLUT and OpenGL state to stdout. +--	Used for debugging.+module Graphics.Gloss.Internals.Interface.Debug+	( dumpGlutState+	, dumpFramebufferState+	, dumpFragmentState )+where++import qualified Graphics.Rendering.OpenGL.GL	as GL+import qualified Graphics.UI.GLUT		as GLUT+import Graphics.UI.GLUT			(($=), get)+++-- | Dump the internal state of GLUT+dumpGlutState :: IO ()+dumpGlutState + = do+	wbw		<- get GLUT.windowBorderWidth+ 	whh		<- get GLUT.windowHeaderHeight+	rgba		<- get GLUT.rgba++	rgbaBD		<- get GLUT.rgbaBufferDepths+	colorBD		<- get GLUT.colorBufferDepth+	depthBD		<- get GLUT.depthBufferDepth+	accumBD		<- get GLUT.accumBufferDepths+	stencilBD	<- get GLUT.stencilBufferDepth++	doubleBuffered	<- get GLUT.doubleBuffered++	colorMask	<- get GLUT.colorMask+	depthMask	<- get GLUT.depthMask+	+	putStr	$  "* dumpGlutState\n"+		++ "  windowBorderWidth  = " ++ show wbw		++ "\n"+		++ "  windowHeaderHeight = " ++ show whh		++ "\n"+		++ "  rgba               = " ++ show rgba		++ "\n"+		++ "  depth      rgba    = " ++ show rgbaBD		++ "\n"+		++ "             color   = " ++ show colorBD		++ "\n"+		++ "             depth   = " ++ show depthBD		++ "\n"+		++ "             accum   = " ++ show accumBD		++ "\n"+		++ "             stencil = " ++ show stencilBD		++ "\n"+		++ "  doubleBuffered     = " ++ show doubleBuffered	++ "\n"+		++ "  mask         color = " ++ show colorMask		++ "\n"+		++ "               depth = " ++ show depthMask		++ "\n"+		++ "\n"+		+		+-- | Dump internal state of the OpenGL framebuffer+dumpFramebufferState :: IO ()+dumpFramebufferState+ = do+ 	auxBuffers	<- get GL.auxBuffers+	doubleBuffer	<- get GL.doubleBuffer+	drawBuffer	<- get GL.drawBuffer++	rgbaBits	<- get GL.rgbaBits+	stencilBits	<- get GL.stencilBits+	depthBits	<- get GL.depthBits+	accumBits	<- get GL.accumBits+	+	clearColor	<- get GL.clearColor+	clearStencil	<- get GL.clearStencil+	clearDepth	<- get GL.clearDepth+	clearAccum	<- get GL.clearAccum+	+	colorMask	<- get GL.colorMask+	stencilMask	<- get GL.stencilMask+	depthMask	<- get GL.depthMask+	+	putStr	$  "* dumpFramebufferState\n"+		++ "  auxBuffers         = " ++ show auxBuffers		++ "\n"+		++ "  doubleBuffer       = " ++ show doubleBuffer	++ "\n"+		++ "  drawBuffer         = " ++ show drawBuffer		++ "\n"+		++ "\n"+		++ "  bits       rgba    = " ++ show rgbaBits		++ "\n"+		++ "             stencil = " ++ show stencilBits	++ "\n"+		++ "             depth   = " ++ show depthBits		++ "\n"+		++ "             accum   = " ++ show accumBits		++ "\n"+		++ "\n"+		++ "  clear      color   = " ++ show clearColor		++ "\n"+		++ "             stencil = " ++ show clearStencil	++ "\n"+		++ "             depth   = " ++ show clearDepth		++ "\n"+		++ "             accum   = " ++ show clearAccum		++ "\n"+		++ "\n"+		++ "  mask       color   = " ++ show colorMask		++ "\n"+		++ "             stencil = " ++ show stencilMask	++ "\n"+		++ "             depth   = " ++ show depthMask		++ "\n"+		++ "\n"+		++-- | Dump internal state of the fragment renderer.+dumpFragmentState :: IO ()+dumpFragmentState+ = do+ 	blend		<- get GL.blend+	blendEquation	<- get GL.blendEquation+	blendFunc	<- get GL.blendFunc+	+	putStr	$  "* dumpFragmentState\n"+		++ "  blend              = " ++ show blend		++ "\n"+		++ "  blend equation     = " ++ show blendEquation	++ "\n"+		++ "  blend func         = " ++ show blendFunc		++ "\n"+		++ "\n"
+ Graphics/Gloss/Internals/Interface/Display.hs view
@@ -0,0 +1,74 @@+{-# OPTIONS_HADDOCK hide #-}++module Graphics.Gloss.Internals.Interface.Display+	(displayInWindow)+where	+import Graphics.Gloss.Color+import Graphics.Gloss.Picture+import Graphics.Gloss.ViewPort+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.KeyMouse+import Graphics.Gloss.Internals.Interface.ViewPort.Motion+import Graphics.Gloss.Internals.Interface.ViewPort.Reshape+import qualified Graphics.Gloss.Internals.Render.Options			as RO+import qualified Graphics.Gloss.Internals.Interface.ViewPort.ControlState	as VPC+import qualified Graphics.Gloss.Internals.Interface.Callback			as Callback++import Data.IORef+import Control.Concurrent+++-- | Open a new window and display the given picture.+--+--   Use the following commands once the window is open:+--+-- 	* Quit - esc-key.+--+--	* Move Viewport - left-click drag, arrow keys.+--+--	* Rotate Viewport - right-click drag, control-left-click drag, or home\/end-keys.+--+--	* Zoom Viewport - mouse wheel, or page up\/down-keys.+--+displayInWindow+	:: 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.+	-> Picture	-- ^ The picture to draw.+	-> IO ()++displayInWindow name size pos background picture+ =  do+	viewSR		<- newIORef viewPortInit+	viewControlSR	<- newIORef VPC.stateInit+	renderSR	<- newIORef RO.optionsInit+	+	let renderFun = do+		view	<- readIORef viewSR+		options	<- readIORef renderSR+	 	withViewPort+	 		view+			(renderPicture options view picture)++	let callbacks+	     =	[ Callback.Display renderFun ++		-- Delay the thread for a bit to give the runtime+		--	a chance to switch back to the OS.+		, Callback.Idle	   (threadDelay 1000)++		-- Escape exits the program+		, callback_exit () +		+		-- Viewport control with mouse+		, callback_viewPort_keyMouse viewSR viewControlSR +		, callback_viewPort_motion   viewSR viewControlSR +		, callback_viewPort_reshape ]++	createWindow name size pos background callbacks++
+ Graphics/Gloss/Internals/Interface/Simulate.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE ExplicitForAll #-}+{-# 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.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.KeyMouse+import Graphics.Gloss.Internals.Interface.ViewPort.Motion+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+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. +--	This function does the rest.+--+--   Once the window is open you can use the same commands as with @displayInWindow@.+--+simulateInWindow +	:: forall world+	.  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 +						 --	current viewport and the amount of time for this simulation+						 --     step (in seconds).+	-> IO ()++simulateInWindow+	windowName+	windowSize+	windowPos+	backgroundColor+	simResolution+	worldStart+	worldToPicture+	worldAdvance+ = do+	let singleStepTime	= 1++	-- make the simulation state+	stateSR		<- newIORef $ SM.stateInit simResolution++	-- make a reference to the initial world+	worldSR		<- newIORef worldStart++	-- make the initial GL view and render states+	viewSR		<- newIORef viewPortInit+	viewControlSR	<- newIORef VPC.stateInit+	renderSR	<- newIORef RO.optionsInit+	animateSR	<- newIORef AN.stateInit++	let displayFun+	     = do+		-- convert the world to a picture+		world		<- readIORef worldSR+		let picture	= worldToPicture world+	+		-- display the picture in the current view+		renderS		<- readIORef renderSR+		viewS		<- readIORef viewSR++		-- render the frame+		withViewPort +			viewS+	 	 	(renderPicture renderS viewS picture)+ +		-- perform garbage collection+		performGC++	let callbacks+	     = 	[ Callback.Display	(animateBegin animateSR)+		, Callback.Display 	displayFun+		, Callback.Display	(animateEnd   animateSR)+		, Callback.Idle		(callback_simulate_idle +						stateSR animateSR viewSR +						worldSR worldStart worldAdvance+						singleStepTime)+		, callback_exit () +		, callback_viewPort_keyMouse viewSR viewControlSR +		, callback_viewPort_motion   viewSR viewControlSR +		, callback_viewPort_reshape ]++	createWindow windowName windowSize windowPos backgroundColor callbacks
+ Graphics/Gloss/Internals/Interface/Simulate/Idle.hs view
@@ -0,0 +1,149 @@+{-# OPTIONS_HADDOCK hide #-}++module Graphics.Gloss.Internals.Interface.Simulate.Idle+	( callback_simulate_idle )+where+import Graphics.Gloss.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 Data.IORef+import Control.Monad+++-- | The graphics library calls back on this function when it's finished drawing+--	and it's time to do some computation.+callback_simulate_idle+	:: IORef SM.State				-- ^ the simulation state+	-> IORef AN.State				-- ^ the animation statea+	-> IORef ViewPort				-- ^ the viewport state+	-> IORef world					-- ^ the current world+	-> world					-- ^ the initial world+	-> (ViewPort -> Float -> world -> world) 	-- ^ fn to advance the world+	-> Float					-- ^ how much time to advance world by +							--	in single step mode+	-> IO ()+	+callback_simulate_idle simSR animateSR viewSR worldSR worldStart worldAdvance singleStepTime+ = {-# SCC "callbackIdle" #-}+   do	simS		<- readIORef simSR+	let result+		| SM.stateReset simS+		= simulate_reset simSR worldSR worldStart++		| SM.stateRun   simS+		= simulate_run   simSR animateSR viewSR worldSR worldAdvance+		+		| SM.stateStep  simS+		= simulate_step  simSR viewSR worldSR worldAdvance singleStepTime+		+		| otherwise+		= return ()+		+	result+ ++-- reset the world to +simulate_reset simSR worldSR worldStart+ = do	writeIORef worldSR worldStart++ 	simSR `modifyIORef` \c -> c 	+		{ SM.stateReset		= False +	 	, SM.stateIteration	= 0 +		, SM.stateSimTime	= 0 }+	 +	GLUT.postRedisplay Nothing+	 + +-- take the number of steps specified by controlWarp+simulate_run +	:: IORef SM.State+	-> IORef AN.State+	-> IORef ViewPort+	-> IORef world+	-> (ViewPort -> Float -> world -> world)+	-> IO ()+	+simulate_run simSR animateSR viewSR worldSR worldAdvance+ = do	+	simS		<- readIORef simSR+	viewS		<- readIORef viewSR+	worldS		<- readIORef worldSR++	-- get the elapsed time since the start simulation (wall clock)+ 	elapsedTime_msec	<- get GLUT.elapsedTime+	let elapsedTime		= fromIntegral elapsedTime_msec / 1000++	-- get how far along the simulation is+	simTime			<- simSR `getsIORef` SM.stateSimTime+ + 	-- we want to simulate this much extra time to bring the simulation+	--	up to the wall clock.+	let thisTime	= elapsedTime - simTime+	 +	-- work out how many steps of simulation this equals+	resolution	<- simSR `getsIORef` SM.stateResolution+	let timePerStep	= 1 / fromIntegral resolution+	let thisSteps_	= truncate $ fromIntegral resolution * thisTime+	let thisSteps	= if thisSteps_ < 0 then 0 else thisSteps_++	let newSimTime	= simTime + fromIntegral thisSteps * timePerStep+	 +{-	putStr	$  "elapsed time    = " ++ show elapsedTime 	++ "\n"+		++ "sim time        = " ++ show simTime		++ "\n"+		++ "this time       = " ++ show thisTime	++ "\n"+		++ "this steps      = " ++ show thisSteps	++ "\n"+		++ "new sim time    = " ++ show newSimTime	++ "\n"+		++ "taking          = " ++ show thisSteps	++ "\n\n"+-}+ 	-- work out the final step number for this display cycle+	let nStart	= SM.stateIteration simS+	let nFinal 	= nStart + thisSteps++	-- keep advancing the world until we get to the final iteration number+	let (_, world')	= +		until 	(\(n, w) 	-> n >= nFinal)+			(\(n, w)	-> (n+1, worldAdvance viewS timePerStep w))+			(nStart, worldS)+	+	-- write the world back into its IORef+	writeIORef worldSR world'++	-- update the control state+	simSR `modifyIORef` \c -> c+		{ SM.stateIteration	= nFinal+		, SM.stateSimTime	= newSimTime +		, SM.stateStepsPerFrame	= fromIntegral thisSteps }+	+	-- tell glut we want to draw the window after returning+	GLUT.postRedisplay Nothing+++-- take a single step+simulate_step +	:: IORef SM.State+	-> IORef ViewPort+	-> IORef world+	-> (ViewPort -> Float -> world -> world) +	-> Float+	-> IO ()++simulate_step simSR viewSR worldSR worldAdvance singleStepTime+ = do+	simS		<- readIORef simSR+	viewS		<- readIORef viewSR+	+ 	world		<- readIORef worldSR+	let world'	= worldAdvance viewS singleStepTime world+	+	writeIORef worldSR world'+	simSR `modifyIORef` \c -> c 	+		{ SM.stateIteration 	= SM.stateIteration c + 1 +	 	, SM.stateStep		= False }+	 +	GLUT.postRedisplay Nothing+++getsIORef ref fun+ = liftM fun $ readIORef ref
+ Graphics/Gloss/Internals/Interface/Simulate/State.hs view
@@ -0,0 +1,44 @@+{-# OPTIONS_HADDOCK hide #-}++module Graphics.Gloss.Internals.Interface.Simulate.State+	( State (..)+	, stateInit )+where++-- | Simulation state+data State	+ = 	State+	{ -- | 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  }+	++-- | Initial control state+stateInit resolution+ 	= State+ 	{ stateIteration		= 0+	, stateRun			= True+	, stateStep			= False+	, stateReset			= False+	, stateResolution		= resolution +	, stateSimTime			= 0 +	, stateStepsPerFrame		= 0 }+	+
+ Graphics/Gloss/Internals/Interface/ViewPort/Command.hs view
@@ -0,0 +1,101 @@+{-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE PatternGuards #-}++module Graphics.Gloss.Internals.Interface.ViewPort.Command+	( Command (..)+	, defaultCommandConfig+	, isCommand )+where+import Data.Map					(Map)+import qualified Graphics.UI.GLUT		as GLUT+import qualified Data.Map			as Map++-- | The commands suported by the view controller+data Command+	= CRestore++	| CTranslate+	| CRotate++	-- bump zoom+	| CBumpZoomOut+	| CBumpZoomIn++	-- bump translate+	| CBumpLeft+	| CBumpRight+	| CBumpUp+	| CBumpDown++	-- bump rotate+	| CBumpClockwise+	| CBumpCClockwise+	deriving (Show, Eq, Ord)+++-- | The default commands+defaultCommandConfig+ =	[ (CRestore, 	+		[ (GLUT.Char 'r', 			Nothing) ])++	, (CTranslate,+		[ ( GLUT.MouseButton GLUT.LeftButton+		  , Just (GLUT.Modifiers { GLUT.shift = GLUT.Up, GLUT.ctrl = GLUT.Up, GLUT.alt = GLUT.Up }))+		])+	+	, (CRotate,+		[ ( GLUT.MouseButton GLUT.RightButton+		  , Nothing)+		, ( GLUT.MouseButton GLUT.LeftButton+		  , Just (GLUT.Modifiers { GLUT.shift = GLUT.Up, GLUT.ctrl = GLUT.Down, GLUT.alt = GLUT.Up }))+	 	])+	+	-- bump zoom+	, (CBumpZoomOut,	+		[ (GLUT.MouseButton GLUT.WheelDown,	Nothing)+		, (GLUT.SpecialKey  GLUT.KeyPageDown,	Nothing) ])++	, (CBumpZoomIn,+		[ (GLUT.MouseButton GLUT.WheelUp, 	Nothing)+		, (GLUT.SpecialKey  GLUT.KeyPageUp,	Nothing)] )+	+	-- bump translate+	, (CBumpLeft,+		[ (GLUT.SpecialKey  GLUT.KeyLeft,	Nothing) ])++	, (CBumpRight,+		[ (GLUT.SpecialKey  GLUT.KeyRight,	Nothing) ])++	, (CBumpUp,+		[ (GLUT.SpecialKey  GLUT.KeyUp,		Nothing) ])++	, (CBumpDown,+		[ (GLUT.SpecialKey  GLUT.KeyDown,	Nothing) ])++	-- bump rotate+	, (CBumpClockwise,+		[ (GLUT.SpecialKey  GLUT.KeyHome,	Nothing) ])+	+	, (CBumpCClockwise,+		[ (GLUT.SpecialKey  GLUT.KeyEnd,	Nothing) ])++	]+++isCommand commands c key keyMods+	| Just csMatch		<- Map.lookup c commands+	= or $ map (isCommand2 c key keyMods) csMatch ++	| otherwise+	= False++isCommand2 c key keyMods cMatch+	| (keyC, mModsC)	<- cMatch+	, keyC == key+	, case mModsC of+		Nothing		-> True+		Just modsC 	-> modsC == keyMods+	= True+	+	| otherwise+	= False
+ Graphics/Gloss/Internals/Interface/ViewPort/ControlState.hs view
@@ -0,0 +1,46 @@+{-# OPTIONS_HADDOCK hide #-}++module Graphics.Gloss.Internals.Interface.ViewPort.ControlState+	( State (..)+	, stateInit )+where+import Graphics.Gloss.Internals.Interface.ViewPort.Command+import qualified Graphics.UI.GLUT		as GLUT+import qualified Data.Map			as Map+import Data.Map					(Map)++-- ViewControl State ------------------------------------------------------------------------------+-- | State for controlling the viewport.+--	These are used by the viewport control component.+data State+	= State {+	-- | The command list for the viewport controller.+	--	These can be safely overwridden at any time by deleting / adding entries to the list.+	--	Entries at the front of the list take precedence.+	  stateCommands		:: Map Command [(GLUT.Key, Maybe GLUT.Modifiers)]++	-- | How much to scale the world by for each step of the mouse wheel.+	, stateScaleStep	:: Float	+							+	-- | How many degrees to rotate the world by for each pixel of x motion.+	, stateRotateFactor	:: Float++	-- | During viewport translation,+	--	where the mouse was clicked on the window.+	, stateTranslateMark	:: Maybe (Int, Int)	++	-- | During viewport rotation,	+	--	where the mouse was clicked on the window+	, stateRotateMark	:: Maybe (Int, Int)+	}+++-- | The initial view state.+stateInit :: State+stateInit+	= State+	{ stateCommands		= Map.fromList defaultCommandConfig+	, stateScaleStep	= 0.85+	, stateRotateFactor	= 0.6+	, stateTranslateMark	= Nothing+	, stateRotateMark	= Nothing }
+ Graphics/Gloss/Internals/Interface/ViewPort/KeyMouse.hs view
@@ -0,0 +1,181 @@+{-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE PatternGuards #-}++module Graphics.Gloss.Internals.Interface.ViewPort.KeyMouse+	(callback_viewPort_keyMouse)+where+import Graphics.Gloss.ViewPort+import Graphics.Gloss.Geometry.Angle+import Graphics.Gloss.Geometry.Vector+import Graphics.Gloss.Internals.Interface.ViewPort.Command+import Graphics.Gloss.Internals.Interface.Callback+import qualified Graphics.Gloss.Internals.Interface.ViewPort.ControlState	as VPC+import qualified Graphics.UI.GLUT						as GLUT+import qualified Graphics.Rendering.OpenGL.GL					as GL+import Data.IORef+import Control.Monad+++-- | Callback to handle keyboard and mouse button events+--	for controlling the viewport.+callback_viewPort_keyMouse +	:: IORef ViewPort 	-- ^ ref to ViewPort state+	-> IORef VPC.State 	-- ^ ref to ViewPort Control state+	-> Callback++callback_viewPort_keyMouse portRef controlRef + 	= KeyMouse (viewPort_keyMouse portRef controlRef)+++viewPort_keyMouse portRef controlRef key keyState keyMods pos+ = do	commands	<- controlRef `getsIORef` VPC.stateCommands ++{-	putStr 	$  "keyMouse key      = " ++ show key 		++ "\n"+		++ "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++	-- restore viewport+	| isCommand commands CRestore key keyMods+	, keyState	== GLUT.Down+	= do	portRef `modifyIORef` \s -> s +			{ viewPortScale		= 1+			, viewPortTranslate	= (0, 0) +			, viewPortRotate	= 0 }+		GLUT.postRedisplay Nothing++	-- zoom ----------------------------------------+	-- zoom out+	| isCommand commands CBumpZoomOut key keyMods+	, keyState	== GLUT.Down+	= 	controlZoomOut portRef controlRef++	-- zoom in+	| isCommand commands CBumpZoomIn key keyMods+	, keyState	== GLUT.Down+	= 	controlZoomIn portRef controlRef+	+	-- bump -------------------------------------+	-- bump left+	| isCommand commands CBumpLeft key keyMods+	, keyState	== GLUT.Down+	= 	motionBump portRef controlRef (20, 0)++	-- bump right+	| isCommand commands CBumpRight key keyMods+	, keyState	== GLUT.Down+	= 	motionBump portRef controlRef (-20, 0)++	-- bump up+	| isCommand commands CBumpUp key keyMods+	, keyState	== GLUT.Down+	= 	motionBump portRef controlRef (0, 20)++	-- bump down+	| isCommand commands CBumpDown key keyMods+	, keyState	== GLUT.Down+	= 	motionBump portRef controlRef (0, -20)++	-- bump clockwise+	| isCommand commands CBumpClockwise key keyMods+	, keyState	== GLUT.Down+	= do	portRef `modifyIORef` \s -> s {+			viewPortRotate+				= (\r -> r + 5)+				$ viewPortRotate s }+		GLUT.postRedisplay Nothing	++	-- bump anti-clockwise+	| isCommand commands CBumpCClockwise key keyMods+	, keyState	== GLUT.Down+	= do	portRef `modifyIORef` \s -> s {+			viewPortRotate+				= (\r -> r - 5)+				$ viewPortRotate s }+		GLUT.postRedisplay Nothing+		+	-- translation --------------------------------------+	-- start+	| isCommand commands CTranslate key keyMods+	, keyState	== GLUT.Down+	= do	let GL.Position posX posY	= pos+		controlRef `modifyIORef` \s -> s { +			VPC.stateTranslateMark +		 		= Just (  fromIntegral posX+				  	, fromIntegral posY) }+		GLUT.postRedisplay Nothing++	-- end+	| isCommand commands CTranslate key keyMods+	, keyState	== GLUT.Up+	= do	controlRef `modifyIORef` \s -> s { +		 	VPC.stateTranslateMark = Nothing }+		GLUT.postRedisplay Nothing++	-- rotation  ---------------------------------------+	-- start+	| isCommand commands CRotate key keyMods+	, keyState	== GLUT.Down+	= do	let GL.Position posX posY	= pos+		controlRef `modifyIORef` \s -> s { +			VPC.stateRotateMark +		 		= Just (  fromIntegral posX+				  	, fromIntegral posY) }+		GLUT.postRedisplay Nothing++	-- end+	| isCommand commands CRotate key keyMods+	, keyState	== GLUT.Up+	= do	controlRef `modifyIORef` \s -> s { +		 	VPC.stateRotateMark = Nothing }+		GLUT.postRedisplay Nothing++	-- carry on+	| otherwise+	= return ()+++controlZoomIn portRef controlRef+ = do	scaleStep	<- controlRef `getsIORef` VPC.stateScaleStep+	portRef `modifyIORef` \s -> s { +	 	viewPortScale = viewPortScale s * scaleStep }+	GLUT.postRedisplay Nothing+++controlZoomOut portRef controlRef+ = do	scaleStep	<- controlRef `getsIORef` VPC.stateScaleStep +	portRef `modifyIORef` \s -> s {+	 	viewPortScale = viewPortScale s / scaleStep }+	GLUT.postRedisplay Nothing+++motionBump+	portRef controlRef+	(bumpX, bumpY)+ = do+	(transX, transY)+		<- portRef `getsIORef` viewPortTranslate++	s	<- portRef `getsIORef` viewPortScale+	r	<- portRef `getsIORef` viewPortRotate++	let offset	= (bumpX / s, bumpY / s)++	let (oX, oY)	= rotateV (degToRad r) offset++	portRef `modifyIORef` \s -> s +		{ viewPortTranslate	+		   = 	( transX - oX+		 	, transY + oY) }+			+	GLUT.postRedisplay Nothing+ ++getsIORef ref fun+ = liftM fun $ readIORef ref
+ Graphics/Gloss/Internals/Interface/ViewPort/Motion.hs view
@@ -0,0 +1,104 @@+{-# OPTIONS_HADDOCK hide #-}++module Graphics.Gloss.Internals.Interface.ViewPort.Motion+	(callback_viewPort_motion)+where+import Graphics.Gloss.ViewPort+import Graphics.Gloss.Geometry.Angle+import Graphics.Gloss.Geometry.Vector+import Graphics.Gloss.Internals.Interface.Callback+import qualified Graphics.Gloss.Internals.Interface.ViewPort.ControlState	as VPC+import qualified Graphics.UI.GLUT						as GLUT+import qualified Graphics.Rendering.OpenGL.GL					as GL+import Control.Monad	+import Data.IORef+++-- | Callback to handle keyboard and mouse button events+--	for controlling the viewport.+callback_viewPort_motion +	:: IORef ViewPort 	-- ^ ref to ViewPort state+	-> IORef VPC.State 	-- ^ ref to ViewPort Control state+	-> Callback++callback_viewPort_motion portRef controlRef + 	= Motion (viewPort_motion portRef controlRef)++viewPort_motion+	portRef controlRef+	pos+ = do+--	putStr $ "motion pos = " ++ show pos ++ "\n"++	translateMark	<- controlRef `getsIORef` VPC.stateTranslateMark+	rotateMark	<- controlRef `getsIORef` VPC.stateRotateMark++	(case translateMark of+	 Nothing		-> return ()+	 Just (markX, markY)	+	  -> motionTranslate+	  	portRef controlRef +		(fromIntegral markX, fromIntegral markY) +		pos )+++	(case rotateMark of+	 Nothing		-> return ()+	 Just (markX, markY)+	  -> motionRotate+	  	portRef controlRef+		(fromIntegral markX, fromIntegral markY) +		pos )+++motionTranslate +	portRef controlRef+	(markX, markY)+	(GL.Position posX posY)+ = do+	(transX, transY)+		<- portRef `getsIORef` viewPortTranslate++	s	<- portRef `getsIORef` viewPortScale+	r	<- portRef `getsIORef` viewPortRotate++	let dX		= fromIntegral $ markX - posX+	let dY		= fromIntegral $ markY - posY++	let offset	= (dX / s, dY / s)++	let (oX, oY)	= rotateV (degToRad r) offset++	portRef `modifyIORef` \s -> s +		{ viewPortTranslate	+		   = 	( transX - oX+		 	, transY + oY) }+		+	controlRef `modifyIORef` \s -> s+		{ VPC.stateTranslateMark+		   =	Just (fromIntegral posX, fromIntegral posY) }++	GLUT.postRedisplay Nothing+++motionRotate +	portRef controlRef+	(markX, markY)+	(GL.Position posX posY)+ = do+ 	rotate		<- portRef    `getsIORef` viewPortRotate+	rotateFactor	<- controlRef `getsIORef` VPC.stateRotateFactor+	+	portRef `modifyIORef` \s -> s +		{ viewPortRotate+		   = 	rotate + rotateFactor * fromIntegral (posX - markX) }+		+	controlRef `modifyIORef` \s -> s+		{ VPC.stateRotateMark+		   = 	Just (fromIntegral posX, fromIntegral posY) }+	+	GLUT.postRedisplay Nothing+++getsIORef ref fun+ = liftM fun $ readIORef ref
+ Graphics/Gloss/Internals/Interface/ViewPort/Reshape.hs view
@@ -0,0 +1,26 @@+{-# OPTIONS_HADDOCK hide #-}++module Graphics.Gloss.Internals.Interface.ViewPort.Reshape+	(callback_viewPort_reshape)+where+import Graphics.Gloss.Internals.Interface.Callback+import Graphics.UI.GLUT					(($=), get)+import qualified Graphics.UI.GLUT			as GLUT+import qualified Graphics.Rendering.OpenGL.GL		as GL+++-- | Callback to handle keyboard and mouse button events+--	for controlling the viewport.+callback_viewPort_reshape :: Callback++callback_viewPort_reshape+ 	= Reshape (viewPort_reshape)++viewPort_reshape size+ = do+	-- Setup the viewport+	--	This controls what part of the window openGL renders to.+	--	We'll use the whole window.+	--+ 	GL.viewport 	$= (GL.Position 0 0, size)+	GLUT.postRedisplay Nothing
+ Graphics/Gloss/Internals/Interface/Window.hs view
@@ -0,0 +1,161 @@+{-# OPTIONS_HADDOCK hide #-}++-- | 	The main display function.+module	Graphics.Gloss.Internals.Interface.Window+	( createWindow )+where++import Graphics.Gloss.Color+import Graphics.Gloss.Internals.Color+import Graphics.Gloss.Internals.Interface.Debug+import Graphics.Gloss.Internals.Interface.Callback		(Callback)+import qualified Graphics.Gloss.Internals.Interface.Callback	as Callback++import Graphics.UI.GLUT					(($=), get)+import qualified Graphics.Rendering.OpenGL.GL		as GL+import qualified Graphics.UI.GLUT			as GLUT++import Control.Monad++-- | Open a window and use the supplied callbacks to handle window events.+createWindow	+	:: String 		-- ^ Name of the window.+	-> (Int, Int) 		-- ^ Initial size of the window, in pixels.+	-> (Int, Int)		-- ^ Initial position of the window, in pixels relative to +				--	the top left corner of the screen.+	-> Color		-- ^ Color to use when clearing.+	-> [Callback]		-- ^ Callbacks to use+	-> IO ()++createWindow+	windowName+	size@(sizeX, sizeY) +	pos @(posX,  posY)+	clearColor+	callbacks+ = do+	-- Turn this on to spew debugging info to stdout+	let debug	= False++	-- Initialize GLUT+ 	(progName, args)	<- GLUT.getArgsAndInitialize+	glutVersion		<- get GLUT.glutVersion++	when debug+	 $ do 	putStr	$ "* displayInWindow\n"+	 	putStr	$ "  glutVersion        = " ++ show glutVersion		++ "\n"++	-- Setup and create a new window.+	--	Be sure to set initialWindow{Position,Size} before calling+	--	createWindow. If we don't do this we get wierd half-created+	--	windows some of the time.+	--+	GLUT.initialWindowPosition	+	 $= 	GL.Position		+	 		(fromIntegral posX)+			(fromIntegral posY)++	GLUT.initialWindowSize	+	 $= 	GL.Size +			(fromIntegral sizeX) +			(fromIntegral sizeY)++	GLUT.initialDisplayMode+	 $= 	[ GLUT.RGBMode+		, GLUT.DoubleBuffered]++	-- See if our requested display mode is possible+	displayMode		<- get GLUT.initialDisplayMode+	displayModePossible	<- get GLUT.displayModePossible+	when debug+	 $ do	putStr	$  "  displayMode        = " ++ show displayMode ++ "\n"+	 		++ "       possible      = " ++ show displayModePossible ++ "\n"+			++ "\n"+		+	-- Here we go!+	when debug+	 $ do	putStr	$ "* creating window\n\n"++	GLUT.createWindow windowName+	GLUT.windowSize	+	 $= 	GL.Size +			(fromIntegral sizeX)+			(fromIntegral sizeY)+	+	-- Setup callbacks+	GLUT.displayCallback		$= callbackDisplay clearColor callbacks+	GLUT.reshapeCallback		$= Just (callbackReshape  	callbacks)+	GLUT.keyboardMouseCallback	$= Just (callbackKeyMouse 	callbacks)+	GLUT.motionCallback		$= Just (callbackMotion   	callbacks)+	GLUT.idleCallback		$= Just (callbackIdle 		callbacks)++	--  Switch some things.+	--  auto repeat interferes with key up / key down checks.+	--	BUGS: this doesn't seem to work?+	GLUT.perWindowKeyRepeat		$= GLUT.PerWindowKeyRepeatOff	++	-- we don't need the depth buffer for 2d.+	GL.depthFunc	$= Just GL.Always++	-- always clear the buffer to white+	GL.clearColor	$= glColor4OfColor clearColor++	-- Dump some debugging info+	when debug+	 $ do	dumpGlutState+	 	dumpFramebufferState+		dumpFragmentState++	---------------+	-- Call the GLUT mainloop. +	--	This function will return when something calls GLUT.leaveMainLoop+	--+	--	We can ask for this in freeglut, but it doesn't seem to work :(.+	--	GLUT.actionOnWindowClose	$= GLUT.MainLoopReturns+	when debug+	 $ do	putStr	$ "* entering mainloop..\n"+	+	GLUT.mainLoop++	when debug+	 $	putStr	$ "* all done\n"+	 +	return ()+++callbackDisplay clearColor callbacks+ = do+	-- clear the display+	GL.clear [GL.ColorBuffer, GL.DepthBuffer]+	GL.color $ GL.Color4 0 0 0 (1 :: GL.GLfloat)++	-- get the display callbacks from the chain+	let funs	= [f	| (Callback.Display f) <- callbacks]+	sequence_ funs++	-- swap front and back buffers+	GLUT.swapBuffers+	GLUT.reportErrors + 	return ()+++callbackReshape callbacks size+ 	= sequence_+	$ map 	(\f -> f size)+		[f | Callback.Reshape f 	<- callbacks]++callbackKeyMouse callbacks key keystate modifiers pos+ 	= sequence_ +	$ map 	(\f -> f key keystate modifiers pos) +		[f | Callback.KeyMouse f 	<- callbacks]++callbackMotion callbacks pos+ 	= sequence_+	$ map	(\f -> f pos)+		[f | Callback.Motion f 		<- callbacks]++callbackIdle callbacks+ 	= sequence_+	$ [f | Callback.Idle f 			<- callbacks]+	+
+ Graphics/Gloss/Internals/Render/Circle.hs view
@@ -0,0 +1,89 @@+{-# OPTIONS -fglasgow-exts #-}+{-# OPTIONS_HADDOCK hide #-}++-- | Fast(ish) rendering of circles.+module Graphics.Gloss.Internals.Render.Circle  where++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+ 	| radScreen	<- scaleFactor * radius+	, steps		<- circleSteps (2 * radScreen)+	= if thickness == 0 +		then renderCircleLine posX posY steps radius+		else renderCircleStrip posX posY steps radius thickness+++-- | Decide how many line segments to use to render the circle+circleSteps :: Float -> Int+circleSteps sDiam+	| sDiam < 1	= 1+	| sDiam < 2	= 4+	| sDiam < 10	= 8+	| sDiam < 20	= 16+	| sDiam < 30	= 32+	| otherwise	= 40+++-- | Render a circle with 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+	= return ()+	+	| otherwise+	= do	GL.vertex +			$ GL.Vertex2 +				(gf $ F# (posX `plusFloat#` (rad `timesFloat#` (cosFloat# tt))))+				(gf $ F# (posY `plusFloat#` (rad `timesFloat#` (sinFloat# tt))))++		renderCircleLine_step posX posY tStep tStop rad (tt `plusFloat#` tStep)+ ++-- | 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#)+   +renderCircleStrip_step +	:: Float# -> Float# +	-> Float# -> Float# +	-> Float# -> Float# -> Float# -> Float# -> IO ()++renderCircleStrip_step posX posY tStep tStop r1 t1 r2 t2+	| t1 `geFloat#` tStop+	= return ()+	+	| otherwise+	= do	GL.vertex $ GL.Vertex2 +				(gf $ F# (posX `plusFloat#` (r1 `timesFloat#` (cosFloat# t1)))) +				(gf $ F# (posY `plusFloat#` (r1 `timesFloat#` (sinFloat# t1))))++		GL.vertex $ GL.Vertex2 +				(gf $ F# (posX `plusFloat#` (r2 `timesFloat#` (cosFloat# t2))))+				(gf $ F# (posY `plusFloat#` (r2 `timesFloat#` (sinFloat# t2))))+		+		renderCircleStrip_step posX posY tStep tStop r1 (t1 `plusFloat#` tStep) r2 (t2 `plusFloat#` tStep)+
+ Graphics/Gloss/Internals/Render/Common.hs view
@@ -0,0 +1,16 @@+{-# OPTIONS_HADDOCK hide #-}+module Graphics.Gloss.Internals.Render.Common where++import qualified Graphics.Rendering.OpenGL.GL	as GL+import Unsafe.Coerce++-- | 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
+ Graphics/Gloss/Internals/Render/Options.hs view
@@ -0,0 +1,34 @@+{-# OPTIONS_HADDOCK hide #-}++-- | Rendering options+module Graphics.Gloss.Internals.Render.Options +	( Options (..)+	, optionsInit )+where++-- | Render options settings+data Options+	= Options+	{ -- | Whether to use color+	  optionsColor		:: Bool++	  -- | Whether to force wireframe mode only+	, optionsWireframe	:: Bool++	  -- | Whether to use alpha blending+	, optionsBlendAlpha	:: Bool++	  -- | Whether to use line smoothing+	, optionsLineSmooth	:: Bool+	}+	++-- | Default render options+optionsInit+	= Options+	{ optionsColor		= True+	, optionsWireframe	= False+	, optionsBlendAlpha	= True+	, optionsLineSmooth	= False }+	+
+ Graphics/Gloss/Internals/Render/Picture.hs view
@@ -0,0 +1,175 @@+{-# OPTIONS -fwarn-incomplete-patterns #-}+{-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE ImplicitParams, ScopedTypeVariables #-}++module Graphics.Gloss.Internals.Render.Picture+	( renderPicture )+where+import	Graphics.Gloss.Picture+import	Graphics.Gloss.Color+import	Graphics.Gloss.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+	:: Options 		-- ^ The render options to use+	-> ViewPort		-- ^ The current viewport.+	-> Picture 		-- ^ The picture to render.+	-> IO ()++renderPicture+	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_	<- get GLUT.windowSize++	-- +	let ?modeWireframe	= optionsWireframe renderS+	    ?modeColor		= optionsColor     renderS+	    ?scale		= viewPortScale    viewS+	    ?matProj		= matProj_+	    ?viewport		= viewport_+	    ?windowSize		= windowSize_+	+	-- setup render state for world+	setLineSmooth	(optionsLineSmooth renderS)+	setBlendAlpha	(optionsBlendAlpha renderS)+	+	drawPicture picture+	  +drawPicture 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 ?scale radius 0+	+	ThickCircle radius thickness+	 ->  renderCircle 0 0 ?scale radius thickness+	+	-- stroke text+	-- 	text looks wierd when we've got blend on,+	--	so disable it during the renderString call.+	Text str +	 -> do+	 	GL.blend	$= GL.Disabled+		GLUT.renderString GLUT.Roman str+		GL.blend	$= GL.Enabled++	-- colors with float components.+	Color color p+	 |  ?modeColor+	 ->  {-# SCC "draw.color" #-}+   	     do+		oldColor 	 <- get GL.currentColor++		let (r, g, b, a) = rgbaOfColor color++		GL.currentColor	+			$= GL.Color4 (gf r) (gf g) (gf b) (gf a)++		drawPicture p++		GL.currentColor	$= oldColor		++	 |  otherwise+	 -> 	drawPicture p+++	-- ease up on GL.preservingMatrix+	--	This is an important optimisation for the Eden example,+	--	as it draws lots of translated circles.+	Translate posX posY (Circle radius)+	 -> renderCircle posX posY ?scale radius 0++	Translate posX posY (ThickCircle radius thickness)+	 -> renderCircle posX posY ?scale radius 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 p++	-----+	Translate tx ty	p+	 -> GL.preservingMatrix+	     $ do	GL.translate (GL.Vector3 (gf tx) (gf ty) 0)+			drawPicture p++	Rotate deg p+	 -> GL.preservingMatrix+	     $ do	GL.rotate (gf deg) (GL.Vector3 0 0 (-1))+			drawPicture p++	Scale sx sy p+	 -> GL.preservingMatrix+	     $ do	GL.scale (gf sx) (gf sy) 1+			drawPicture p+			+	Pictures ps+	 -> mapM_ drawPicture ps+	++-- Utils ------------------------------------------------------------------------------------------+-- | Turn alpha blending on or off+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 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+++
+ Graphics/Gloss/Internals/Render/ViewPort.hs view
@@ -0,0 +1,54 @@+{-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Handling the current viewport during rendering.+module Graphics.Gloss.Internals.Render.ViewPort+	( withViewPort )+where+import	Graphics.Gloss.ViewPort+import	Graphics.Rendering.OpenGL					(GLfloat)+import 	Graphics.UI.GLUT						(($=), get)+import	qualified Graphics.UI.GLUT					as GLUT+import	qualified Graphics.Rendering.OpenGL.GL				as GL+++-- | Perform a rendering action whilst using the given viewport+withViewPort+	:: ViewPort 		-- ^ The viewport to use.+	-> IO () 		-- ^ The rendering action to perform.+	-> IO ()++withViewPort port action+ = do+ 	GL.matrixMode	$= GL.Projection+	GL.preservingMatrix+	 $ do+		-- setup the co-ordinate system+	 	GL.loadIdentity+		size@(GL.Size sizeX sizeY) +				<- get GLUT.windowSize+		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+		GL.preservingMatrix+		 $ do+			GL.loadIdentity+			let rotate :: GLfloat	= realToFrac $ viewPortRotate port+			let transX :: GLfloat	= realToFrac $ fst $ viewPortTranslate port+			let transY :: GLfloat   = realToFrac $ snd $ viewPortTranslate port+		 	let scale  :: GLfloat	= realToFrac $ viewPortScale port++			-- apply the global view transforms+			GL.scale     scale  scale  1+			GL.rotate    rotate (GL.Vector3 0 0 1)+			GL.translate (GL.Vector3 transX transY 0)++			-- call the client render action+			action ++		GL.matrixMode	$= GL.Projection+	+	GL.matrixMode	$= GL.Modelview 0
+ Graphics/Gloss/Picture.hs view
@@ -0,0 +1,62 @@++-- | 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 view
@@ -0,0 +1,77 @@++-- | 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 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.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 +	}
+ LICENSE view
@@ -0,0 +1,13 @@+Copyright (c) 2010 Benjamin Lippmeier ++ Permission is hereby granted, free of charge, to any person+ obtaining a copy of this software and associated documentation+ files (the "Software"), to deal in the Software without+ restriction, including without limitation the rights to use,+ copy, modify, merge, publish, distribute, sublicense, and/or sell+ copies of the Software, and to permit persons to whom the+ Software is furnished to do so, subject to the following+ condition:++ The above copyright notice and this permission notice shall be+ included in all copies or substantial portions of the Software.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ gloss.cabal view
@@ -0,0 +1,63 @@+Name:                gloss+Version:             1.0.0.0+License:             MIT+License-file:        LICENSE+Author:              Ben Lippmeier+Maintainer:          gloss@ouroborus.net+Build-Type:          Simple+Cabal-Version:       >=1.8+Stability:           provisional+Category:            Graphics+Description:+	Gloss hides the pain of drawing simple vector graphics behind a nice data type and+	a few display functions. Gloss uses OpenGL and GLUT under the hood, but you won't+	have to worry about any of that. Get something cool on the screen in under 10 minutes.++Synopsis:            Painless 2D vector graphics, animations and simulations.++Library+  Build-Depends: +           base       >= 3 && < 5,+           ghc-prim   >= 0.2,+           containers >= 0.3,+           OpenGL     >= 2.0,+           GLUT       >= 2.0++  ghc-options:    -O2++  Exposed-modules:+           Graphics.Gloss+           Graphics.Gloss.Color+           Graphics.Gloss.Geometry+           Graphics.Gloss.Geometry.Angle+           Graphics.Gloss.Geometry.Line+           Graphics.Gloss.Geometry.Vector+           Graphics.Gloss.Picture+           Graphics.Gloss.Shapes+           Graphics.Gloss.ViewPort++  Other-modules:+           Graphics.Gloss.Internals.Color+           Graphics.Gloss.Internals.Interface.Animate+           Graphics.Gloss.Internals.Interface.Animate.State+           Graphics.Gloss.Internals.Interface.Animate.Timing+           Graphics.Gloss.Internals.Interface.Callback+           Graphics.Gloss.Internals.Interface.Common.Exit+           Graphics.Gloss.Internals.Interface.Debug+           Graphics.Gloss.Internals.Interface.Display+           Graphics.Gloss.Internals.Interface.Simulate+           Graphics.Gloss.Internals.Interface.Simulate.Idle+           Graphics.Gloss.Internals.Interface.Simulate.State+           Graphics.Gloss.Internals.Interface.ViewPort.Command+           Graphics.Gloss.Internals.Interface.ViewPort.ControlState+           Graphics.Gloss.Internals.Interface.ViewPort.KeyMouse+           Graphics.Gloss.Internals.Interface.ViewPort.Motion+           Graphics.Gloss.Internals.Interface.ViewPort.Reshape+           Graphics.Gloss.Internals.Interface.Window+           Graphics.Gloss.Internals.Render.Circle+           Graphics.Gloss.Internals.Render.Common+           Graphics.Gloss.Internals.Render.Options+           Graphics.Gloss.Internals.Render.Picture+           Graphics.Gloss.Internals.Render.ViewPort++