gloss 1.10.2.5 → 1.13.2.2
raw patch · 39 files changed
Files
- Graphics/Gloss.hs +22/−13
- Graphics/Gloss/Data/Bitmap.hs +6/−1
- Graphics/Gloss/Data/Color.hs +8/−8
- Graphics/Gloss/Data/Display.hs +2/−2
- Graphics/Gloss/Data/Picture.hs +23/−22
- Graphics/Gloss/Data/Point.hs +4/−6
- Graphics/Gloss/Data/Point/Arithmetic.hs +55/−0
- Graphics/Gloss/Data/Vector.hs +3/−3
- Graphics/Gloss/Data/ViewPort.hs +11/−10
- Graphics/Gloss/Data/ViewState.hs +23/−20
- Graphics/Gloss/Geometry/Line.hs +42/−42
- Graphics/Gloss/Interface/Environment.hs +18/−0
- Graphics/Gloss/Interface/IO/Animate.hs +8/−7
- Graphics/Gloss/Interface/IO/Display.hs +2/−2
- Graphics/Gloss/Interface/IO/Game.hs +1/−1
- Graphics/Gloss/Interface/IO/Interact.hs +41/−0
- Graphics/Gloss/Interface/IO/Simulate.hs +3/−3
- Graphics/Gloss/Interface/Pure/Animate.hs +3/−3
- Graphics/Gloss/Interface/Pure/Game.hs +4/−4
- Graphics/Gloss/Interface/Pure/Simulate.hs +8/−8
- Graphics/Gloss/Internals/Interface/Animate.hs +8/−8
- Graphics/Gloss/Internals/Interface/Animate/State.hs +5/−5
- Graphics/Gloss/Internals/Interface/Animate/Timing.hs +10/−10
- Graphics/Gloss/Internals/Interface/Backend.hs +1/−1
- Graphics/Gloss/Internals/Interface/Backend/GLFW.hs +329/−208
- Graphics/Gloss/Internals/Interface/Backend/GLUT.hs +59/−44
- Graphics/Gloss/Internals/Interface/Backend/Types.hs +6/−3
- Graphics/Gloss/Internals/Interface/Common/Exit.hs +3/−2
- Graphics/Gloss/Internals/Interface/Debug.hs +6/−6
- Graphics/Gloss/Internals/Interface/Display.hs +7/−7
- Graphics/Gloss/Internals/Interface/Event.hs +1/−1
- Graphics/Gloss/Internals/Interface/Game.hs +13/−13
- Graphics/Gloss/Internals/Interface/Interact.hs +160/−0
- Graphics/Gloss/Internals/Interface/Simulate.hs +5/−5
- Graphics/Gloss/Internals/Interface/Simulate/Idle.hs +11/−11
- Graphics/Gloss/Internals/Interface/Simulate/State.hs +7/−7
- Graphics/Gloss/Internals/Interface/ViewState/KeyMouse.hs +2/−2
- Graphics/Gloss/Internals/Interface/ViewState/Motion.hs +4/−3
- gloss.cabal +39/−32
Graphics/Gloss.hs view
@@ -1,6 +1,6 @@ -- | Gloss hides the pain of drawing simple vector graphics behind a nice data type and--- a few display functions. +-- a few display functions. -- -- Getting something on the screen is as easy as: --@@ -12,10 +12,10 @@ -- Once the window is open you can use the following: -- -- @--- * Quit +-- * Quit -- - esc-key ----- * Move Viewport +-- * Move Viewport -- - arrow keys -- - left-click drag --@@ -40,7 +40,7 @@ -- `simulate`. -- -- If you want to manage your own key\/mouse events then use `play`.--- +-- -- Gloss uses OpenGL under the hood, but you don't have to worry about any of that. -- -- Gloss programs should be compiled with @-threaded@, otherwise the GHC runtime@@ -52,6 +52,22 @@ -- @ -- Release Notes: --+-- For 1.13.1:+-- Thanks to Thaler Jonathan+-- * Repaired GLFW backend.+-- Thanks to Samuel Gfrörer+-- * Support for bitmap sections.+-- Thanks to Basile Henry+-- * Handle resize events in playField driver.+--+-- For 1.12.1:+-- Thanks to Trevor McDonell+-- * Travis CI integration, general cleanups.+--+-- For 1.11.1:+-- Thanks to Lars Wyssard+-- * Use default display resolution in full-screen mode.+-- -- For 1.10.1: -- * Gloss no longer consumes CPU time when displaying static pictures. -- * Added displayIO wrapper for mostly static pictures, eg when@@ -65,19 +81,11 @@ -- * Allow bitmaps to be specified in RGBA byte order as well as ABGR. -- Thanks to Gabriel Gonzalez -- * Package definitions for building with Stack.------ For 1.9.1:--- Thanks to Elise Huard--- * Split rendering code into gloss-rendering package.------ For 1.8.0:--- Thanks to Francesco Mazzoli--- * Factored out ViewPort and ViewState handling into user visible modules. -- @ -- -- For more information, check out <http://gloss.ouroborus.net>. ---module Graphics.Gloss +module Graphics.Gloss ( module Graphics.Gloss.Data.Picture , module Graphics.Gloss.Data.Color , module Graphics.Gloss.Data.Bitmap@@ -95,3 +103,4 @@ import Graphics.Gloss.Interface.Pure.Animate import Graphics.Gloss.Interface.Pure.Simulate import Graphics.Gloss.Interface.Pure.Game+
Graphics/Gloss/Data/Bitmap.hs view
@@ -1,10 +1,15 @@ -- | Functions to load bitmap data from various places. module Graphics.Gloss.Data.Bitmap- ( BitmapData, BitmapFormat(..), RowOrder(..), PixelFormat(..)+ ( Rectangle(..)+ , BitmapData, bitmapSize+ , BitmapFormat(..), RowOrder(..), PixelFormat(..) , bitmapOfForeignPtr+ , bitmapDataOfForeignPtr , bitmapOfByteString+ , bitmapDataOfByteString , bitmapOfBMP+ , bitmapDataOfBMP , loadBMP) where import Graphics.Gloss.Rendering
Graphics/Gloss/Data/Color.hs view
@@ -26,7 +26,7 @@ -- *** Secondary , yellow, cyan, magenta- + -- *** Tertiary , rose, violet, azure, aquamarine, chartreuse, orange )@@ -37,7 +37,7 @@ -- Color functions ------------------------------------------------------------ -- | Mix two colors with the given ratios.-mixColors +mixColors :: Float -- ^ Proportion of first color. -> Float -- ^ Proportion of second color. -> Color -- ^ First color.@@ -67,14 +67,14 @@ -- | Add RGB components of a color component-wise,--- then normalise them to the highest resulting one. +-- then normalise them to the highest resulting one. -- The alpha components are averaged. addColors :: Color -> Color -> Color addColors c1 c2 = let (r1, g1, b1, a1) = rgbaOfColor c1 (r2, g2, b2, a2) = rgbaOfColor c2 - in normalizeColor + in normalizeColor (r1 + r2) (g1 + g2) (b1 + b2)@@ -87,7 +87,7 @@ = let (r, g, b, a) = rgbaOfColor c in makeColor (r / 1.2) (g / 1.2) (b / 1.2) a - + -- | Make a brighter version of a color, scaling towards white. bright :: Color -> Color bright c@@ -100,8 +100,8 @@ light c = let (r, g, b, a) = rgbaOfColor c in makeColor (r + 0.2) (g + 0.2) (b + 0.2) a- - ++ -- | Darken a color, adding black. dark :: Color -> Color dark c@@ -140,7 +140,7 @@ -- Pre-defined Colors --------------------------------------------------------- -- | A greyness of a given order.--- +-- -- Range is 0 = black, to 1 = white. greyN :: Float -> Color greyN n = makeRawColor n n n 1.0
Graphics/Gloss/Data/Display.hs view
@@ -8,6 +8,6 @@ -- | Display in a window with the given name, size and position. = InWindow String (Int, Int) (Int, Int) - -- | Display full screen with a drawing area of the given size.- | FullScreen (Int, Int) + -- | Display full screen.+ | FullScreen deriving (Eq, Read, Show)
Graphics/Gloss/Data/Picture.hs view
@@ -11,6 +11,8 @@ , arc, thickArc , text , bitmap+ , bitmapSection+ -- , bitmap , color , translate, rotate, scale , pictures@@ -55,7 +57,7 @@ thickCircle :: Float -> Float -> Picture thickCircle = ThickCircle --- | A circular arc drawn counter-clockwise between two angles (in degrees) +-- | A circular arc drawn counter-clockwise between two angles (in degrees) -- at the given radius. arc :: Float -> Float -> Float -> Picture arc = Arc@@ -70,17 +72,16 @@ text :: String -> Picture text = Text --- | A bitmap image with a width, height and a Vector holding the --- 32-bit RGBA bitmap data.--- --- The boolean flag controls whether Gloss should cache the data--- between frames for speed.--- If you are programatically generating the image for--- each frame then use `False`. --- If you have loaded it from a file then use `True`.-bitmap :: Int -> Int -> BitmapData -> Bool -> Picture-bitmap = Bitmap+-- | A bitmap image+bitmap :: BitmapData -> Picture+bitmap bitmapData = Bitmap bitmapData +-- | a subsection of a bitmap image+-- first argument selects a sub section in the bitmap+-- second argument determines the bitmap data+bitmapSection :: Rectangle -> BitmapData -> Picture+bitmapSection = BitmapSection+ -- | A picture drawn with this color. color :: Color -> Picture -> Picture color = Color@@ -112,29 +113,29 @@ -- Circles and Arcs ----------------------------------------------------------- -- | A solid circle with the given radius. circleSolid :: Float -> Picture-circleSolid r +circleSolid r = thickCircle (r/2) r --- | A solid arc, drawn counter-clockwise between two angles at the given radius.+-- | A solid arc, drawn counter-clockwise between two angles (in degrees) at the given radius. arcSolid :: Float -> Float -> Float -> Picture-arcSolid a1 a2 r - = thickArc a1 a2 (r/2) r +arcSolid a1 a2 r+ = thickArc a1 a2 (r/2) r --- | A wireframe sector of a circle. --- An arc is draw counter-clockwise from the first to the second angle at+-- | A wireframe sector of a circle.+-- An arc is draw counter-clockwise from the first to the second angle (in degrees) at -- the given radius. Lines are drawn from the origin to the ends of the arc. --- -- NOTE: We take the absolute value of the radius incase it's negative.--- It would also make sense to draw the sector flipped around the +-- It would also make sense to draw the sector flipped around the -- origin, but I think taking the absolute value will be less surprising -- for the user.--- +-- sectorWire :: Float -> Float -> Float -> Picture sectorWire a1 a2 r_ = let r = abs r_- in Pictures + in Pictures [ Arc a1 a2 r , Line [(0, 0), (r * cos (degToRad a1), r * sin (degToRad a1))] , Line [(0, 0), (r * cos (degToRad a2), r * sin (degToRad a2))] ]@@ -145,11 +146,11 @@ -- arguments to reduce the amount of noise in the extracted docs. -- | A path representing a rectangle centered about the origin-rectanglePath +rectanglePath :: Float -- ^ width of rectangle -> Float -- ^ height of rectangle -> Path-rectanglePath sizeX sizeY +rectanglePath sizeX sizeY = let sx = sizeX / 2 sy = sizeY / 2 in [(-sx, -sy), (-sx, sy), (sx, sy), (sx, -sy)]
Graphics/Gloss/Data/Point.hs view
@@ -1,5 +1,3 @@-{-# OPTIONS -fno-warn-missing-methods -fno-warn-orphans #-}-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} module Graphics.Gloss.Data.Point ( Point, Path , pointInBox)@@ -19,11 +17,11 @@ -- +-------+ P1 -- @ ---pointInBox - :: Point - -> Point +pointInBox+ :: Point+ -> Point -> Point -> Bool- + pointInBox (x0, y0) (x1, y1) (x2, y2) = x0 >= min x1 x2 && x0 <= max x1 x2
+ Graphics/Gloss/Data/Point/Arithmetic.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE BangPatterns #-}++-- |+-- == Point and vector arithmetic+--+-- Vectors aren't numbers according to Haskell, because they don't+-- support all numeric operations sensibly. We define component-wise+-- addition, subtraction, and negation along with scalar multiplication+-- in this module, which is intended to be imported qualified.+module Graphics.Gloss.Data.Point.Arithmetic+ (+ Point+ , (+)+ , (-)+ , (*)+ , negate+ ) where+import Prelude (Float)+import qualified Prelude as P+import Graphics.Gloss.Rendering (Point)++infixl 6 +, -+infixl 7 *++-- | Add two vectors, or add a vector to a point.+(+) :: Point -> Point -> Point+(x1, y1) + (x2, y2) =+ let+ !x = x1 P.+ x2+ !y = y1 P.+ y2+ in (x, y)++-- | Subtract two vectors, or subtract a vector from a point.+(-) :: Point -> Point -> Point+(x1, y1) - (x2, y2) =+ let+ !x = x1 P.- x2+ !y = y1 P.- y2+ in (x, y)++-- | Negate a vector.+negate :: Point -> Point+negate (x, y) =+ let+ !x' = P.negate x+ !y' = P.negate y+ in (x', y')++-- | Multiply a scalar by a vector.+(*) :: Float -> Point -> Point+(*) s (x, y) =+ let+ !x' = s P.* x+ !y' = s P.* y+ in (x', y')
Graphics/Gloss/Data/Vector.hs view
@@ -20,7 +20,7 @@ -- | The magnitude of a vector. magV :: Vector -> Float-magV (x, y) +magV (x, y) = sqrt (x * x + y * y) {-# INLINE magV #-} @@ -48,7 +48,7 @@ -- | Multiply a vector by a scalar. mulSV :: Float -> Vector -> Vector-mulSV s (x, y) +mulSV s (x, y) = (s * x, s * y) {-# INLINE mulSV #-} @@ -69,7 +69,7 @@ d = p1 `dotV` p2 aDiff = acos $ d / (m1 * m2) - in aDiff + in aDiff {-# INLINE angleVV #-}
Graphics/Gloss/Data/ViewPort.hs view
@@ -6,30 +6,31 @@ , invertViewPort ) where import Graphics.Gloss.Data.Picture+import qualified Graphics.Gloss.Data.Point.Arithmetic as Pt -- | The 'ViewPort' represents the global transformation applied to the displayed picture. -- When the user pans, zooms, or rotates the display then this changes the 'ViewPort'. data ViewPort- = ViewPort { + = ViewPort { -- | Global translation. viewPortTranslate :: !(Float, Float) -- | Global rotation (in degrees).- , viewPortRotate :: !Float + , viewPortRotate :: !Float -- | Global scaling (of both x and y coordinates).- , viewPortScale :: !Float + , viewPortScale :: !Float }- - ++ -- | The initial state of the viewport. viewPortInit :: ViewPort viewPortInit = ViewPort- { viewPortTranslate = (0, 0) + { viewPortTranslate = (0, 0) , viewPortRotate = 0- , viewPortScale = 1 + , viewPortScale = 1 } @@ -43,7 +44,7 @@ -- | Takes a point using screen coordinates, and uses the `ViewPort` to convert--- it to Picture coordinates. This is the inverse of `applyViewPortToPicture` +-- it to Picture coordinates. This is the inverse of `applyViewPortToPicture` -- for points. invertViewPort :: ViewPort -> Point -> Point invertViewPort@@ -51,7 +52,7 @@ , viewPortTranslate = vtrans , viewPortRotate = vrotate } pos- = rotateV (degToRad vrotate) (mulSV (1 / vscale) pos) - vtrans+ = rotateV (degToRad vrotate) (mulSV (1 / vscale) pos) Pt.- vtrans -- | Convert degrees to radians@@ -62,7 +63,7 @@ -- | Multiply a vector by a scalar. mulSV :: Float -> Vector -> Vector-mulSV s (x, y) +mulSV s (x, y) = (s * x, s * y) {-# INLINE mulSV #-}
Graphics/Gloss/Data/ViewState.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE PatternGuards #-}+ module Graphics.Gloss.Data.ViewState ( Command (..) , CommandConfig@@ -17,6 +19,7 @@ import Data.Map (Map) import Data.Maybe import Control.Monad (mplus)+import qualified Graphics.Gloss.Data.Point.Arithmetic as Pt -- | The commands suported by the view controller.@@ -63,7 +66,7 @@ , Just (Modifiers { shift = Up, ctrl = Down, alt = Up })) , ( MouseButton RightButton- , Just (Modifiers { shift = Up, ctrl = Up, alt = Up })) + , Just (Modifiers { shift = Up, ctrl = Up, alt = Up })) ]) , (CRotate,@@ -107,8 +110,8 @@ -- | Check if the provided key combination is some gloss viewport command.-isCommand - :: Map Command [(Key, Maybe Modifiers)] +isCommand+ :: Map Command [(Key, Maybe Modifiers)] -> Command -> Key -> Modifiers -> Bool isCommand commands c key keyMods@@ -157,7 +160,7 @@ -- where the mouse was clicked on the window to start the translate. , viewStateTranslateMark :: !(Maybe (Float, Float)) - -- | During viewport rotation, + -- | During viewport rotation, -- where the mouse was clicked on the window to starte the rotate. , viewStateRotateMark :: !(Maybe (Float, Float)) @@ -229,12 +232,12 @@ | isCommand commands CBumpClockwise key keyMods , keyState == Down- = Just $ viewState { viewStateViewPort + = Just $ viewState { viewStateViewPort = port { viewPortRotate = viewPortRotate port + 5 } } | isCommand commands CBumpCClockwise key keyMods , keyState == Down- = Just $ viewState { viewStateViewPort + = Just $ viewState { viewStateViewPort = port { viewPortRotate = viewPortRotate port - 5 } } @@ -284,47 +287,47 @@ motionTranslate (viewStateTranslateMark viewState) pos viewState `mplus` motionRotate (viewStateRotateMark viewState) pos viewState -updateViewStateWithEventMaybe (EventResize _) _ +updateViewStateWithEventMaybe (EventResize _) _ = Nothing -- | Zoom in a `ViewState` by the scale step. controlZoomIn :: ViewState -> ViewState-controlZoomIn - viewState@ViewState +controlZoomIn+ viewState@ViewState { viewStateViewPort = port , viewStateScaleStep = scaleStep }- = viewState - { viewStateViewPort + = viewState+ { viewStateViewPort = port { viewPortScale = viewPortScale port / scaleStep } } -- | Zoom out a `ViewState` by the scale step. controlZoomOut :: ViewState -> ViewState-controlZoomOut - viewState@ViewState +controlZoomOut+ viewState@ViewState { viewStateViewPort = port , viewStateScaleStep = scaleStep } = viewState- { viewStateViewPort + { viewStateViewPort = port { viewPortScale = viewPortScale port * scaleStep } } -- | Offset a viewport. motionBump :: ViewPort -> (Float, Float) -> ViewPort motionBump- port@ViewPort + port@ViewPort { viewPortTranslate = trans , viewPortScale = scale , viewPortRotate = r } (bumpX, bumpY)- = port { viewPortTranslate = trans - o }+ = port { viewPortTranslate = trans Pt.- o } where offset = (bumpX / scale, bumpY / scale) o = rotateV (degToRad r) offset -- | Apply a translation to the `ViewState`.-motionTranslate +motionTranslate :: Maybe (Float, Float) -- Location of first mark. -> (Float, Float) -- Current position. -> ViewState -> Maybe ViewState@@ -332,7 +335,7 @@ motionTranslate Nothing _ _ = Nothing motionTranslate (Just (markX, markY)) (posX, posY) viewState = Just $ viewState- { viewStateViewPort = port { viewPortTranslate = trans - o }+ { viewStateViewPort = port { viewPortTranslate = trans Pt.- o } , viewStateTranslateMark = Just (posX, posY) } where port = viewStateViewPort viewState@@ -346,7 +349,7 @@ -- | Apply a rotation to the `ViewState`.-motionRotate +motionRotate :: Maybe (Float, Float) -- Location of first mark. -> (Float, Float) -- Current position. -> ViewState -> Maybe ViewState@@ -354,7 +357,7 @@ motionRotate Nothing _ _ = Nothing motionRotate (Just (markX, _markY)) (posX, posY) viewState = Just $ viewState- { viewStateViewPort + { viewStateViewPort = port { viewPortRotate = rotate - rotateFactor * (posX - markX) } , viewStateRotateMark = Just (posX, posY) }
Graphics/Gloss/Geometry/Line.hs view
@@ -3,13 +3,13 @@ -- | 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. +-- line segment represented by its two endpoints. module Graphics.Gloss.Geometry.Line ( segClearsBox -- * Closest points , closestPointOnLine- , closestPointOnLineParam + , closestPointOnLineParam -- * Line-Line intersection , intersectLineLine@@ -23,15 +23,15 @@ , intersectSegSeg , intersectSegHorzSeg , intersectSegVertSeg)- + where import Graphics.Gloss.Data.Point import Graphics.Gloss.Data.Vector-+import qualified Graphics.Gloss.Data.Point.Arithmetic as Pt -- | Check if line segment (P1-P2) clears a box (P3-P4) by being well outside it.-segClearsBox - :: Point -- ^ P1 First point of segment. +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.@@ -56,7 +56,7 @@ {-# INLINE closestPointOnLine #-} closestPointOnLine p1 p2 p3- = p1 + (u `mulSV` (p2 - p1))+ = p1 Pt.+ (u `mulSV` (p2 Pt.- p1)) where u = closestPointOnLineParam p1 p2 p3 @@ -74,9 +74,9 @@ -- @ -- | -- P1--- | --- P4 +---- P3 -- |+-- P4 +---- P3+-- | -- P2 -- | -- @@@ -89,8 +89,8 @@ -> Float closestPointOnLineParam p1 p2 p3- = (p3 - p1) `dotV` (p2 - p1) - / (p2 - p1) `dotV` (p2 - p1)+ = (p3 Pt.- p1) `dotV` (p2 Pt.- p1)+ / (p2 Pt.- p1) `dotV` (p2 Pt.- p1) @@ -110,7 +110,7 @@ -- / \\ -- @ ---intersectLineLine +intersectLineLine :: Point -- ^ `P1` -> Point -- ^ `P2` -> Point -- ^ `P3`@@ -123,14 +123,14 @@ 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 + det34 = x3*y4 - y3*x4 numx = det12 * dx34 - dx12 * det34 numy = det12 * dy34 - dy12 * det34@@ -154,14 +154,14 @@ , 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 -- / -- -------+---------@@ -169,29 +169,29 @@ -- P2 + -- @ ---intersectSegHorzLine +intersectSegHorzLine :: Point -- ^ P1 First point of segment. -> Point -- ^ P2 Second point of segment. -> Float -- ^ y value of line. -> Maybe Point intersectSegHorzLine (x1, y1) (x2, y2) y0- + -- seg is on line | y1 == y0, y2 == y0 = Nothing- + -- seg is above line | y1 > y0, y2 > y0 = Nothing- + -- seg is below line | y1 < y0, y2 < y0 = Nothing- + -- seg is a single point on the line.- -- this should be caught by the first case, + -- this should be caught by the first case, -- but we'll test for it anyway.- | y2 - y1 == 0 + | y2 - y1 == 0 = Just (x1, y1)- - | otherwise ++ | otherwise = Just ( (y0 - y1) * (x2 - x1) / (y2 - y1) + x1 , y0) @@ -209,30 +209,30 @@ -- | x0 -- @ ---intersectSegVertLine +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, + -- this should be caught by the first case, -- but we'll test for it anyway.- | x2 - x1 == 0 + | x2 - x1 == 0 = Just (x1, y1)- - | otherwise ++ | otherwise = Just ( x0 , (x0 - x1) * (y2 - y1) / (x2 - x1) + y1) @@ -256,7 +256,7 @@ , t12 >= 0 && t12 <= 1 , t23 >= 0 && t23 <= 1 = Just p0- + | otherwise = Nothing @@ -269,7 +269,7 @@ -- (xa, y3) +---+----+ (xb, y3) -- / -- P1 +--- @ +-- @ intersectSegHorzSeg :: Point -- ^ P1 First point of segment.@@ -278,7 +278,7 @@ -> Float -- ^ (xa) Leftmost x value of horizontal segment. -> Float -- ^ (xb) Rightmost x value of horizontal segment. -> Maybe Point -- ^ (x3, y3) Intersection point, if any.- + intersectSegHorzSeg p1@(x1, y1) p2@(x2, y2) y0 xa xb | segClearsBox p1 p2 (xa, y0) (xb, y0) = Nothing@@ -286,7 +286,7 @@ | x0 < xa = Nothing | x0 > xb = Nothing | otherwise = Just (x0, y0)- + where x0 | (y2 - y1) == 0 = x1 | otherwise = (y0 - y1) * (x2 - x1) / (y2 - y1) + x1 @@ -301,7 +301,7 @@ -- / | -- P2 + | -- + (x3, ya)--- @ +-- @ intersectSegVertSeg :: Point -- ^ P1 First point of segment.@@ -314,11 +314,11 @@ intersectSegVertSeg p1@(x1, y1) p2@(x2, y2) x0 ya yb | segClearsBox p1 p2 (x0, ya) (x0, yb) = Nothing- + | y0 < ya = Nothing | y0 > yb = Nothing | otherwise = Just (x0, y0)- + where y0 | (x2 - x1) == 0 = y1 | otherwise = (x0 - x1) * (y2 - y1) / (x2 - x1) + y1
+ Graphics/Gloss/Interface/Environment.hs view
@@ -0,0 +1,18 @@+module Graphics.Gloss.Interface.Environment where++import Data.IORef (newIORef)++import qualified Graphics.Gloss.Internals.Interface.Backend.Types as Backend.Types+import Graphics.Gloss.Internals.Interface.Backend (defaultBackendState)++-- | Get the size of the screen, in pixels.+--+-- This will be the size of the rendered gloss image when+-- fullscreen mode is enabled.+--+getScreenSize :: IO (Int, Int)+getScreenSize = do+ backendStateRef <- newIORef defaultBackendState+ Backend.Types.initializeBackend backendStateRef False+ Backend.Types.getScreenSize backendStateRef+
Graphics/Gloss/Interface/IO/Animate.hs view
@@ -20,18 +20,18 @@ -- -- Once the window is open you can use the same commands as with @display@. ---animateIO +animateIO :: Display -- ^ Display mode. -> Color -- ^ Background color.- -> (Float -> IO Picture) -- ^ Function to produce the next frame of animation. + -> (Float -> IO Picture) -- ^ Function to produce the next frame of animation. -- It is passed the time in seconds since the program started. -> (Controller -> IO ()) -- ^ Callback to take the display controller. -> IO () animateIO display backColor frameFunIO eatControllerIO- = animateWithBackendIO - defaultBackendState + = animateWithBackendIO+ defaultBackendState True -- pannable display backColor frameFunIO@@ -43,16 +43,17 @@ animateFixedIO :: Display -- ^ Display mode. -> Color -- ^ Background color.- -> (Float -> IO Picture) -- ^ Function to produce the next frame of animation. + -> (Float -> IO Picture) -- ^ Function to produce the next frame of animation. -- It is passed the time in seconds since the program started. -> (Controller -> IO ()) -- ^ Callback to take the display controller. -> IO () animateFixedIO display backColor frameFunIO eatControllerIO- = animateWithBackendIO - defaultBackendState + = animateWithBackendIO+ defaultBackendState False display backColor frameFunIO eatControllerIO+
Graphics/Gloss/Interface/IO/Display.hs view
@@ -33,7 +33,7 @@ -- between the last redraw, and one second from that. -- -- * Note that calling `controllerSetRedraw` indicates that the picture should--- be redrawn, but does not cause this to happen immediately, due to +-- be redrawn, but does not cause this to happen immediately, due to -- limitations in the GLUT and GLFW window managers. The display runs on -- a one second timer interrupt, and if there have been no display events -- we need to wait for the next timer interrupt before redrawing.@@ -41,7 +41,7 @@ -- due to the context switches at under 1%. -- -- * Also note that the picture generating action is called for every display--- event, so if the user pans the display then it will be invoked at 10hz +-- event, so if the user pans the display then it will be invoked at 10hz -- or more during the pan. If you are generating the picture by reading some -- on-disk files then you should track when the files were last updated -- and cache the picture between updates. Caching the picture avoids
Graphics/Gloss/Interface/IO/Game.hs view
@@ -16,7 +16,7 @@ import Graphics.Gloss.Internals.Interface.Backend --- | Play a game in a window, using IO actions to build the pictures. +-- | Play a game in a window, using IO actions to build the pictures. playIO :: forall world . Display -- ^ Display mode. -> Color -- ^ Background color.
+ Graphics/Gloss/Interface/IO/Interact.hs view
@@ -0,0 +1,41 @@++-- | Display mode is for drawing a static picture.+module Graphics.Gloss.Interface.IO.Interact+ ( module Graphics.Gloss.Data.Display+ , module Graphics.Gloss.Data.Picture+ , module Graphics.Gloss.Data.Color+ , interactIO+ , Controller (..)+ , Event(..), Key(..), SpecialKey(..), MouseButton(..), KeyState(..), Modifiers(..))+where+import Graphics.Gloss.Data.Display+import Graphics.Gloss.Data.Controller+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import Graphics.Gloss.Internals.Interface.Event+import Graphics.Gloss.Internals.Interface.Interact+import Graphics.Gloss.Internals.Interface.Backend+++-- | Open a new window and interact with an infrequently updated picture.+--+-- Similar to `displayIO`, except that you manage your own events.+--+interactIO+ :: Display -- ^ Display mode.+ -> Color -- ^ Background color.+ -> world -- ^ Initial world state.+ -> (world -> IO Picture) -- ^ A function to produce the current picture.+ -> (Event -> world -> IO world) -- ^ A function to handle input events.+ -> (Controller -> IO ()) -- ^ Callback to take the display controller.+ -> IO ()++interactIO dis backColor worldInit makePicture handleEvent eatController+ = interactWithBackend+ defaultBackendState+ dis+ backColor+ worldInit+ makePicture+ handleEvent+ eatController
Graphics/Gloss/Interface/IO/Simulate.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE RankNTypes #-} --- We export this stuff separately so we don't clutter up the +-- 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@@ -27,8 +27,8 @@ -> Int -- ^ Number of simulation steps to take for each second of real time. -> model -- ^ The initial model. -> (model -> IO Picture) -- ^ A function to convert the model to a picture.- -> (ViewPort -> Float -> model -> IO model) - -- ^ A function to step the model one iteration. It is passed the + -> (ViewPort -> Float -> model -> IO model)+ -- ^ A function to step the model one iteration. It is passed the -- current viewport and the amount of time for this simulation -- step (in seconds). -> IO ()
Graphics/Gloss/Interface/Pure/Animate.hs view
@@ -19,14 +19,14 @@ -- animate :: Display -- ^ Display mode. -> Color -- ^ Background color.- -> (Float -> Picture) -- ^ Function to produce the next frame of animation. + -> (Float -> Picture) -- ^ Function to produce the next frame of animation. -- It is passed the time in seconds since the program started. -> IO () animate display backColor frameFun- = animateWithBackendIO + = animateWithBackendIO defaultBackendState True -- pannable display backColor- (return . frameFun) + (return . frameFun) (const (return ()))
Graphics/Gloss/Interface/Pure/Game.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE ExplicitForAll #-} --- We export this stuff separately so we don't clutter up the +-- 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,@@ -25,7 +25,7 @@ -> Int -- ^ Number of simulation steps to take for each second of real time. -> world -- ^ The initial world. -> (world -> Picture) -- ^ A function to convert the world a picture.- -> (Event -> world -> world) + -> (Event -> world -> world) -- ^ A function to handle input events. -> (Float -> world -> world) -- ^ A function to step the world one iteration.@@ -35,9 +35,9 @@ play display backColor simResolution worldStart worldToPicture worldHandleEvent worldAdvance - = do _ <- playWithBackendIO defaultBackendState + = do _ <- playWithBackendIO defaultBackendState display backColor simResolution- worldStart + worldStart (return . worldToPicture) (\event world -> return $ worldHandleEvent event world) (\time world -> return $ worldAdvance time world)
Graphics/Gloss/Interface/Pure/Simulate.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE RankNTypes #-} --- We export this stuff separately so we don't clutter up the +-- 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@@ -22,25 +22,25 @@ -- | 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. +-- how to convert the model to a picture, and how to advance the model for each unit of time. -- This function does the rest. -- -- Once the window is open you can use the same commands as with `display`. ---simulate +simulate :: Display -- ^ Display mode. -> Color -- ^ Background color. -> Int -- ^ Number of simulation steps to take for each second of real time. -> model -- ^ The initial model.- -> (model -> Picture) + -> (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 + -> (ViewPort -> Float -> model -> model)+ -- ^ A function to step the model one iteration. It is passed the -- current viewport and the amount of time for this simulation -- step (in seconds). -> IO () -simulate display backColor simResolution +simulate display backColor simResolution modelStart modelToPicture modelStep = do _ <- simulateWithBackendIO defaultBackendState@@ -50,4 +50,4 @@ (\view time model -> return $ modelStep view time model) return () - +
Graphics/Gloss/Internals/Interface/Animate.hs view
@@ -1,7 +1,7 @@ module Graphics.Gloss.Internals.Interface.Animate (animateWithBackendIO)-where +where import Graphics.Gloss.Data.Color import Graphics.Gloss.Data.Controller import Graphics.Gloss.Data.Picture@@ -37,8 +37,8 @@ animateWithBackendIO backend pannable display backColor frameOp eatController- = do - -- + = do+ -- viewSR <- newIORef viewStateInit animateSR <- newIORef AN.stateInit renderS_ <- initState@@ -72,22 +72,22 @@ , Callback.Display displayFun , Callback.Display (animateEnd animateSR) , Callback.Idle (\s -> postRedisplay s)- , callback_exit () + , callback_exit () , callback_viewState_motion viewSR , callback_viewState_reshape ]- - ++ (if pannable ++ ++ (if pannable then [callback_viewState_keyMouse viewSR] else []) - createWindow backend display backColor callbacks + createWindow backend display backColor callbacks $ \ backendRef -> eatController $ Controller { controllerSetRedraw = postRedisplay backendRef - , controllerModifyViewPort + , controllerModifyViewPort = \modViewPort -> do viewState <- readIORef viewSR port' <- modViewPort $ viewStateViewPort viewState
Graphics/Gloss/Internals/Interface/Animate/State.hs view
@@ -1,7 +1,7 @@ {-# OPTIONS_HADDOCK hide #-} module Graphics.Gloss.Internals.Interface.Animate.State- ( State (..) + ( State (..) , stateInit ) where @@ -28,13 +28,13 @@ -- | Clamp the minimum time between frames to this value (in seconds) -- Setting this to < 10ms probably isn't worthwhile. , stateDisplayTimeClamp :: !Double- + -- | The time when the last call to the users render function finished. , stateGateTimeStart :: !Double -- | The time when displayInWindow last finished (after sleeping to clamp fps). , stateGateTimeEnd :: !Double- + -- | How long it took to draw this frame , stateGateTimeElapsed :: !Double } @@ -47,8 +47,8 @@ , stateAnimateStart = True , stateAnimateTime = 0 , stateDisplayTime = 0- , stateDisplayTimeLast = 0 + , stateDisplayTimeLast = 0 , stateDisplayTimeClamp = 0.01 , stateGateTimeStart = 0- , stateGateTimeEnd = 0 + , stateGateTimeEnd = 0 , stateGateTimeElapsed = 0 }
Graphics/Gloss/Internals/Interface/Animate/Timing.hs view
@@ -4,11 +4,11 @@ -- | 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. +-- 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 )@@ -29,8 +29,8 @@ displayTimeLast <- stateRef `getsIORef` stateDisplayTime let displayTimeElapsed = displayTime - displayTimeLast - modifyIORef' stateRef $ \s -> s - { stateDisplayTime = displayTime + modifyIORef' stateRef $ \s -> s+ { stateDisplayTime = displayTime , stateDisplayTimeLast = displayTimeLast } -- increment the animation time@@ -44,11 +44,11 @@ ++ " displayTimeLast = " ++ show displayTimeLast ++ "\n" ++ " displayTimeElapsed = " ++ show displayTimeElapsed ++ "\n" ++ " fps = " ++ show (truncate $ 1 / displayTimeElapsed) ++ "\n"--} +-} when (animate && not animateStart) $ modifyIORef' stateRef $ \s -> s { stateAnimateTime = animateTime + displayTimeElapsed }- + when animate $ modifyIORef' stateRef $ \s -> s { stateAnimateCount = animateCount + 1@@ -65,10 +65,10 @@ timeClamp <- stateRef `getsIORef` stateDisplayTimeClamp -- the start of this gate- gateTimeStart <- elapsedTime backendRef + gateTimeStart <- elapsedTime backendRef -- end of the previous gate- gateTimeEnd <- stateRef `getsIORef` stateGateTimeEnd + gateTimeEnd <- stateRef `getsIORef` stateGateTimeEnd let gateTimeElapsed = gateTimeStart - gateTimeEnd when (gateTimeElapsed < timeClamp)@@ -76,8 +76,8 @@ gateTimeFinal <- elapsedTime backendRef - modifyIORef' stateRef $ \s -> s - { stateGateTimeEnd = gateTimeFinal + modifyIORef' stateRef $ \s -> s+ { stateGateTimeEnd = gateTimeFinal , stateGateTimeElapsed = gateTimeElapsed }
Graphics/Gloss/Internals/Interface/Backend.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} --- Import window managed backend specific modules. +-- Import window managed backend specific modules. -- We need to use #ifdef here because if the backend library hasn't been installed -- then we won't be able to build it, so it can't be in the import list. module Graphics.Gloss.Internals.Interface.Backend
Graphics/Gloss/Internals/Interface/Backend/GLFW.hs view
@@ -6,11 +6,12 @@ (GLFWState) where import Data.IORef-import Data.Char (toLower)+import Data.Maybe (fromJust)+import Control.Concurrent import Control.Monad import Graphics.Gloss.Data.Display-import Graphics.UI.GLFW (WindowValue(..)) import qualified Graphics.UI.GLFW as GLFW+import Graphics.Rendering.OpenGL (($=)) import qualified Graphics.Rendering.OpenGL as GL import qualified Control.Exception as X @@ -22,7 +23,7 @@ -- initialize GLUT before we can use any of it's functions. -- --- We also need to deinitialize (exit) GLUT when we close the GLFW--- window, otherwise opening a gloss window again from GHCi will crash. +-- window, otherwise opening a gloss window again from GHCi will crash. -- For the OS X and Windows version of GLUT there are no such restrictions. -- -- We assume also assume that only linux installations use freeglut.@@ -54,6 +55,9 @@ -- | Action perforrmed when idling , idle :: IO ()++ -- | The Window Handle+ , optWinHdl :: Maybe GLFW.Window } @@ -66,10 +70,18 @@ , mouseWheelPos = 0 , dirtyScreen = True , display = return ()- , idle = return () }+ , idle = return ()+ , optWinHdl = Nothing } +-- | Fetch the window handle from the state if it has been initialized.+winHdl :: GLFWState -> GLFW.Window+winHdl state =+ case optWinHdl state of+ Just handle -> handle+ Nothing -> error "GLFW backend: requested uninitialized window handle" + instance Backend GLFWState where initBackendState = glfwStateInit initializeBackend = initializeGLFW@@ -84,19 +96,24 @@ installIdleCallback = installIdleCallbackGLFW runMainLoop = runMainLoopGLFW postRedisplay = postRedisplayGLFW- getWindowDimensions = (\_ -> GLFW.getWindowDimensions)- elapsedTime = (\_ -> GLFW.getTime)- sleep = (\_ sec -> GLFW.sleep sec)-+ getWindowDimensions = (\ref -> windowHandle ref >>= \win -> GLFW.getWindowSize win)+ getScreenSize = getScreenSizeGLFW+ elapsedTime = (\_ -> GLFW.getTime >>= \mt -> return $ fromJust mt)+ sleep = (\_ sec -> threadDelay (floor (sec * 1000000.0))) --GLFW.sleep sec) -- Initialise ----------------------------------------------------------------- -- | Initialise the GLFW backend. initializeGLFW :: IORef GLFWState -> Bool-> IO () initializeGLFW _ debug = do- _ <- GLFW.initialize- glfwVersion <- GLFW.getGlfwVersion + let simpleErrorCallback e s =+ putStrLn $ unwords [ "GLFW backend: ", show e, show s ]+ GLFW.setErrorCallback (Just simpleErrorCallback)++ _ <- GLFW.init+ glfwVersion <- GLFW.getVersion+ #ifdef linux_HOST_OS -- See [Note: FreeGlut] for why we need this. (_progName, _args) <- GLUT.getArgsAndInitialize@@ -109,73 +126,111 @@ -- Exit ----------------------------------------------------------------------- -- | Tell the GLFW backend to close the window and exit. exitGLFW :: IORef GLFWState -> IO ()-exitGLFW _+exitGLFW ref = do #ifdef linux_HOST_OS -- See [Note: FreeGlut] on why we exit GLUT for Linux GLUT.exit #endif- GLFW.closeWindow+ win <- windowHandle ref+ GLFW.setWindowShouldClose win True -- Open Window ---------------------------------------------------------------- -- | Open a new window.-openWindowGLFW +openWindowGLFW :: IORef GLFWState -> Display -> IO () -openWindowGLFW _ (InWindow title (sizeX, sizeY) pos)- = do _ <- GLFW.openWindow- GLFW.defaultDisplayOptions- { GLFW.displayOptions_width = sizeX- , GLFW.displayOptions_height = sizeY- , GLFW.displayOptions_displayMode = GLFW.Window }- - uncurry GLFW.setWindowPosition pos- GLFW.setWindowTitle title+openWindowGLFW ref (InWindow title (sizeX, sizeY) pos)+ = do win <- GLFW.createWindow+ sizeX+ sizeY+ title+ Nothing+ Nothing - -- Try to enable sync-to-vertical-refresh by setting the number + modifyIORef' ref (\s -> s { optWinHdl = win })+ uncurry (GLFW.setWindowPos (fromJust win)) pos+ GLFW.makeContextCurrent win++ -- Try to enable sync-to-vertical-refresh by setting the number -- of buffer swaps per vertical refresh to 1.- GLFW.setWindowBufferSwapInterval 1+ GLFW.swapInterval 1 -openWindowGLFW _ (FullScreen (sizeX, sizeY))- = do _ <- GLFW.openWindow- GLFW.defaultDisplayOptions- { GLFW.displayOptions_width = sizeX- , GLFW.displayOptions_height = sizeY- , GLFW.displayOptions_displayMode = GLFW.Fullscreen }- - -- Try to enable sync-to-vertical-refresh by setting the number +openWindowGLFW ref FullScreen+ = do mon <- GLFW.getPrimaryMonitor+ vmode <- GLFW.getVideoMode (fromJust mon)++ let sizeX = GLFW.videoModeWidth (fromJust vmode)+ let sizeY = GLFW.videoModeHeight (fromJust vmode)++ win <- GLFW.createWindow+ sizeX+ sizeY+ ""+ mon+ Nothing++ modifyIORef' ref (\s -> s { optWinHdl = win})+ GLFW.makeContextCurrent win++ -- Try to enable sync-to-vertical-refresh by setting the number -- of buffer swaps per vertical refresh to 1.- GLFW.setWindowBufferSwapInterval 1- GLFW.enableMouseCursor+ GLFW.swapInterval 1+ --GLFW.enableMouseCursor+ GLFW.setCursorInputMode (fromJust win) GLFW.CursorInputMode'Normal ++windowHandle :: IORef GLFWState -> IO GLFW.Window+windowHandle ref+ = do s <- readIORef ref+ return $ winHdl s+++getScreenSizeGLFW :: IORef GLFWState -> IO (Int,Int)+getScreenSizeGLFW _state = do+ monitor <- GLFW.getPrimaryMonitor+ vmode <- GLFW.getVideoMode (fromJust monitor)++ let sizeX = GLFW.videoModeWidth (fromJust vmode)+ let sizeY = GLFW.videoModeHeight (fromJust vmode)++ pure (sizeX, sizeY)++ -- Dump State ----------------------------------------------------------------- -- | Print out the internal GLFW state.-dumpStateGLFW :: IORef a -> IO ()-dumpStateGLFW _- = do (ww,wh) <- GLFW.getWindowDimensions+dumpStateGLFW :: IORef GLFWState -> IO ()+dumpStateGLFW ref+ = do win <- windowHandle ref+ (ww,wh) <- GLFW.getWindowSize win - r <- GLFW.getWindowValue NumRedBits- g <- GLFW.getWindowValue NumGreenBits- b <- GLFW.getWindowValue NumBlueBits- a <- GLFW.getWindowValue NumAlphaBits+-- GLFW-b does not provide a general function to query windowHints+-- could be added by adding additional getWindowHint which+-- uses glfwGetWindowAttrib behind the scenes as has been done+-- already for e.g. getWindowVisible which uses glfwGetWindowAttrib+{-+ r <- GLFW.getWindowHint NumRedBits+ g <- GLFW.getWindowHint NumGreenBits+ b <- GLFW.getWindowHint NumBlueBits+ a <- GLFW.getWindowHint NumAlphaBits let rgbaBD = [r,g,b,a] - depthBD <- GLFW.getWindowValue NumDepthBits+ depthBD <- GLFW.getWindowHint NumDepthBits - ra <- GLFW.getWindowValue NumAccumRedBits- ga <- GLFW.getWindowValue NumAccumGreenBits- ba <- GLFW.getWindowValue NumAccumBlueBits- aa <- GLFW.getWindowValue NumAccumAlphaBits+ ra <- GLFW.getWindowHint NumAccumRedBits+ ga <- GLFW.getWindowHint NumAccumGreenBits+ ba <- GLFW.getWindowHint NumAccumBlueBits+ aa <- GLFW.getWindowHint NumAccumAlphaBits let accumBD = [ra,ga,ba,aa] - stencilBD <- GLFW.getWindowValue NumStencilBits+ stencilBD <- GLFW.getWindowHint NumStencilBits - auxBuffers <- GLFW.getWindowValue NumAuxBuffers+ auxBuffers <- GLFW.getWindowHint NumAuxBuffers - fsaaSamples <- GLFW.getWindowValue NumFsaaSamples+ fsaaSamples <- GLFW.getWindowHint NumFsaaSamples putStr $ "* dumpGlfwState\n" ++ " windowWidth = " ++ show ww ++ "\n"@@ -187,7 +242,12 @@ ++ " aux Buffers = " ++ show auxBuffers ++ "\n" ++ " FSAA Samples = " ++ show fsaaSamples ++ "\n" ++ "\n"+-} + putStr $ "* dumpGlfwState\n"+ ++ " windowWidth = " ++ show ww ++ "\n"+ ++ " windowHeight = " ++ show wh ++ "\n"+ ++ "\n" -- Display Callback ----------------------------------------------------------- -- | Callback for when GLFW needs us to redraw the contents of the window.@@ -208,6 +268,11 @@ GL.clear [GL.ColorBuffer, GL.DepthBuffer] GL.color $ GL.Color4 0 0 0 (1 :: GL.GLfloat) + -- set the OpenGL viewport to account for any HiDPI discrepancy+ (width, height) <- windowHandle stateRef >>= GLFW.getFramebufferSize+ GL.viewport $= ( GL.Position 0 0+ , GL.Size (fromIntegral width) (fromIntegral height))+ -- get the display callbacks from the chain let funs = [f stateRef | (Display f) <- callbacks] sequence_ funs@@ -218,35 +283,35 @@ -- Close Callback ------------------------------------------------------------- -- | Callback for when the user closes the window. -- We can do some cleanup here.-installWindowCloseCallbackGLFW +installWindowCloseCallbackGLFW :: IORef GLFWState -> IO () -installWindowCloseCallbackGLFW _- = GLFW.setWindowCloseCallback - $ do+installWindowCloseCallbackGLFW ref+ = do win <- windowHandle ref+ GLFW.setWindowCloseCallback win (Just winClosed)+ where+ winClosed :: GLFW.WindowCloseCallback+ winClosed _win = do #ifdef linux_HOST_OS -- See [Note: FreeGlut] for why we need this. GLUT.exit #endif- return True-+ return () -- Reshape -------------------------------------------------------------------- -- | Callback for when the user reshapes the window. installReshapeCallbackGLFW- :: Backend a- => IORef a -> [Callback] -> IO ()+ :: IORef GLFWState -> [Callback] -> IO () installReshapeCallbackGLFW stateRef callbacks- = GLFW.setWindowSizeCallback (callbackReshape stateRef callbacks)+ = do win <- windowHandle stateRef+ GLFW.setWindowSizeCallback win (Just $ callbackReshape stateRef callbacks) -callbackReshape - :: Backend a- => IORef a -> [Callback]- -> Int -> Int- -> IO ()+callbackReshape+ :: IORef GLFWState -> [Callback]+ -> GLFW.WindowSizeCallback -- = Window -> Int -> Int -> IO () -callbackReshape glfwState callbacks sizeX sizeY+callbackReshape glfwState callbacks _win sizeX sizeY = sequence_ $ map (\f -> f (sizeX, sizeY)) [f glfwState | Reshape f <- callbacks]@@ -257,7 +322,7 @@ -- This is a bit verbose because we have to do impedence matching between -- GLFW's event system, and the one use by Gloss which was originally -- based on GLUT. The main problem is that GLUT only provides a single callback--- slot for character keys, arrow keys, mouse buttons and mouse wheel movement, +-- slot for character keys, arrow keys, mouse buttons and mouse wheel movement, -- while GLFW provides a single slot for each. -- installKeyMouseCallbackGLFW@@ -265,21 +330,24 @@ -> IO () installKeyMouseCallbackGLFW stateRef callbacks- = do GLFW.setKeyCallback $ (callbackKeyboard stateRef callbacks)- GLFW.setCharCallback $ (callbackChar stateRef callbacks)- GLFW.setMouseButtonCallback $ (callbackMouseButton stateRef callbacks)- GLFW.setMouseWheelCallback $ (callbackMouseWheel stateRef callbacks)+ = do win <- windowHandle stateRef+ GLFW.setKeyCallback win (Just $ callbackKeyboard stateRef callbacks)+ GLFW.setCharCallback win (Just $ callbackChar stateRef callbacks)+ GLFW.setMouseButtonCallback win (Just $ callbackMouseButton stateRef callbacks)+ GLFW.setScrollCallback win (Just $ callbackMouseWheel stateRef callbacks) -- GLFW calls this on a non-character keyboard action.-callbackKeyboard +callbackKeyboard :: IORef GLFWState -> [Callback]- -> GLFW.Key -> Bool- -> IO ()+ -> GLFW.KeyCallback -- = Window -> Key -> Int -> KeyState -> ModifierKeys -> IO ()+ -- -> GLFW.Key -> Bool+ -- -> IO () -callbackKeyboard stateRef callbacks key keystate- = do (modsSet, GLFWState mods pos _ _ _ _)- <- setModifiers stateRef key keystate +callbackKeyboard stateRef callbacks _win key _scancode keystateglfw _modifiers+ = do let keystate = keystateglfw == GLFW.KeyState'Pressed+ (modsSet, GLFWState mods pos _ _ _ _ _)+ <- setModifiers stateRef key keystate let key' = fromGLFW key let keystate' = if keystate then Down else Up let isCharKey (Char _) = True@@ -287,12 +355,12 @@ -- Call the Gloss KeyMouse actions with the new state. unless (modsSet || isCharKey key' && keystate)- $ sequence_ + $ sequence_ $ map (\f -> f key' keystate' mods pos) [f stateRef | KeyMouse f <- callbacks] -setModifiers +setModifiers :: IORef GLFWState -> GLFW.Key -> Bool -> IO (Bool, GLFWState)@@ -301,10 +369,10 @@ = do glfwState <- readIORef stateRef let mods = modifiers glfwState let mods' = case key of- GLFW.KeyLeftShift -> mods {shift = if pressed then Down else Up}- GLFW.KeyLeftCtrl -> mods {ctrl = if pressed then Down else Up}- GLFW.KeyLeftAlt -> mods {alt = if pressed then Down else Up}- _ -> mods+ GLFW.Key'LeftShift -> mods {shift = if pressed then Down else Up}+ GLFW.Key'LeftControl -> mods {ctrl = if pressed then Down else Up}+ GLFW.Key'LeftAlt -> mods {alt = if pressed then Down else Up}+ _ -> mods if (mods' /= mods) then do@@ -315,13 +383,19 @@ -- GLFW calls this on a when the user presses or releases a character key.-callbackChar +callbackChar :: IORef GLFWState -> [Callback]- -> Char -> Bool -> IO ()+ -> GLFW.CharCallback+ -- Window -> Char -> IO ()+ -- -> Char -> Bool -> IO () -callbackChar stateRef callbacks char keystate- = do (GLFWState mods pos _ _ _ _) <- readIORef stateRef+callbackChar stateRef callbacks _win char -- keystate+ = do (GLFWState mods pos _ _ _ _ _) <- readIORef stateRef let key' = charToSpecial char+ -- TODO: is this correct? GLFW does not provide the keystate+ -- in a character callback, here we asume that its pressed+ let keystate = True+ -- Only key presses of characters are passed to this callback, -- character key releases are caught by the 'keyCallback'. This is an -- intentional feature of GLFW. What this means that a key press of@@ -331,25 +405,23 @@ let keystate' = if keystate then Down else Up -- Call all the Gloss KeyMouse actions with the new state.- sequence_ - $ map (\f -> f key' keystate' mods pos) + sequence_+ $ map (\f -> f key' keystate' mods pos) [f stateRef | KeyMouse f <- callbacks] -- GLFW calls on this when the user clicks or releases a mouse button.-callbackMouseButton +callbackMouseButton :: IORef GLFWState -> [Callback]- -> GLFW.MouseButton- -> Bool- -> IO ()+ -> GLFW.MouseButtonCallback -- = Window -> MouseButton -> MouseButtonState -> ModifierKeys -> IO () -callbackMouseButton stateRef callbacks key keystate- = do (GLFWState mods pos _ _ _ _) <- readIORef stateRef+callbackMouseButton stateRef callbacks _win key keystate _modifier+ = do (GLFWState mods pos _ _ _ _ _) <- readIORef stateRef let key' = fromGLFW key- let keystate' = if keystate then Down else Up+ let keystate' = if keystate == GLFW.MouseButtonState'Pressed then Down else Up -- Call all the Gloss KeyMouse actions with the new state.- sequence_ + sequence_ $ map (\f -> f key' keystate' mods pos) [f stateRef | KeyMouse f <- callbacks] @@ -357,15 +429,16 @@ -- GLFW calls on this when the user moves the mouse wheel. callbackMouseWheel :: IORef GLFWState -> [Callback]- -> Int- -> IO ()--callbackMouseWheel stateRef callbacks w- = do (key, keystate) <- setMouseWheel stateRef w- (GLFWState mods pos _ _ _ _) <- readIORef stateRef+ -> GLFW.ScrollCallback+ -- -> Int+ -- -> IO ()+-- ScrollCallback = Window -> Double -> Double -> IO ()+callbackMouseWheel stateRef callbacks _win x _y+ = do (key, keystate) <- setMouseWheel stateRef (floor x)+ (GLFWState mods pos _ _ _ _ _) <- readIORef stateRef -- Call all the Gloss KeyMouse actions with the new state.- sequence_ + sequence_ $ map (\f -> f key keystate mods pos) [f stateRef | KeyMouse f <- callbacks] @@ -385,22 +458,24 @@ -- Motion Callback ------------------------------------------------------------ -- | Callback for when the user moves the mouse.-installMotionCallbackGLFW +installMotionCallbackGLFW :: IORef GLFWState -> [Callback] -> IO () installMotionCallbackGLFW stateRef callbacks- = GLFW.setMousePositionCallback $ (callbackMotion stateRef callbacks)+ = do win <- windowHandle stateRef+ GLFW.setCursorPosCallback win (Just $ callbackMotion stateRef callbacks) -callbackMotion +--CursorPosCallback = Window -> Double -> Double -> IO ()++callbackMotion :: IORef GLFWState -> [Callback]- -> Int -> Int- -> IO ()-callbackMotion stateRef callbacks x y- = do pos <- setMousePos stateRef x y+ -> GLFW.CursorPosCallback+callbackMotion stateRef callbacks _win x y+ = do pos <- setMousePos stateRef (floor x) (floor y) -- Call all the Gloss Motion actions with the new state.- sequence_ + sequence_ $ map (\f -> f pos) [f stateRef | Motion f <- callbacks] @@ -411,7 +486,7 @@ setMousePos stateRef x y = do let pos = (x,y) - modifyIORef' stateRef $ \s -> s + modifyIORef' stateRef $ \s -> s { mousePosition = pos } return pos@@ -424,11 +499,11 @@ :: IORef GLFWState -> [Callback] -> IO () -installIdleCallbackGLFW stateRef callbacks - = modifyIORef' stateRef $ \s -> s +installIdleCallbackGLFW stateRef callbacks+ = modifyIORef' stateRef $ \s -> s { idle = callbackIdle stateRef callbacks } -callbackIdle +callbackIdle :: IORef GLFWState -> [Callback] -> IO () @@ -438,43 +513,64 @@ -- Main Loop -------------------------------------------------------------------runMainLoopGLFW- :: IORef GLFWState- -> IO () -runMainLoopGLFW stateRef - = X.catch go exit- where- exit :: X.SomeException -> IO ()- exit e = print e >> exitGLFW stateRef+runMainLoopGLFW :: IORef GLFWState -> IO ()+runMainLoopGLFW stateRef = do+ X.catch go handleException+ GLFW.destroyWindow =<< windowHandle stateRef+ GLFW.terminate - go :: IO ()- go - = do windowIsOpen <- GLFW.windowIsOpen- when windowIsOpen - $ do GLFW.pollEvents- dirty <- fmap dirtyScreen $ readIORef stateRef+ where+ handleException :: X.SomeException -> IO ()+ handleException = print - when dirty- $ do s <- readIORef stateRef- display s- GLFW.swapBuffers+ clearDirtyFlag :: IO ()+ clearDirtyFlag = modifyIORef'+ stateRef+ (\state -> state { dirtyScreen = False }) - modifyIORef' stateRef $ \s -> s - { dirtyScreen = False }+ display' :: IO ()+ display' = readIORef stateRef >>= display - (readIORef stateRef) >>= (\s -> idle s)- GLFW.sleep 0.001- runMainLoopGLFW stateRef+ idle' :: IO ()+ idle' = readIORef stateRef >>= idle + swapBuffers' :: IO ()+ swapBuffers' = windowHandle stateRef >>= GLFW.swapBuffers + windowShouldClose :: IO Bool+ windowShouldClose = windowHandle stateRef >>= GLFW.windowShouldClose++ unlessM :: Monad m => m Bool -> m () -> m ()+ unlessM testAction action = do+ sentinel <- testAction+ unless sentinel action++ go :: IO ()+ go = do+ -- Perform drawing, clear the dirty flag, do idle processing+ display'+ clearDirtyFlag+ idle'++ -- Swap buffers. This swaps the GL buffers and will block+ -- until the next v-sync. In GLFW, this effectively pegs the+ -- maximum frame rate to 60fps, but will also stop the+ -- application from consuming 100% CPU.+ swapBuffers'++ -- Poll for GLFW events; quit if necessary.+ GLFW.pollEvents+ unlessM windowShouldClose go++ -- Redisplay -------------------------------------------------------------------postRedisplayGLFW +postRedisplayGLFW :: IORef GLFWState -> IO () postRedisplayGLFW stateRef- = modifyIORef' stateRef $ \s -> s + = modifyIORef' stateRef $ \s -> s { dirtyScreen = True } @@ -483,70 +579,95 @@ fromGLFW :: a -> Key instance GLFWKey GLFW.Key where- fromGLFW key + fromGLFW key = case key of- GLFW.CharKey c -> charToSpecial (toLower c)- GLFW.KeySpace -> SpecialKey KeySpace- GLFW.KeyEsc -> SpecialKey KeyEsc- GLFW.KeyF1 -> SpecialKey KeyF1- GLFW.KeyF2 -> SpecialKey KeyF2- GLFW.KeyF3 -> SpecialKey KeyF3- GLFW.KeyF4 -> SpecialKey KeyF4- GLFW.KeyF5 -> SpecialKey KeyF5- GLFW.KeyF6 -> SpecialKey KeyF6- GLFW.KeyF7 -> SpecialKey KeyF7- GLFW.KeyF8 -> SpecialKey KeyF8- GLFW.KeyF9 -> SpecialKey KeyF9- GLFW.KeyF10 -> SpecialKey KeyF10- GLFW.KeyF11 -> SpecialKey KeyF11- GLFW.KeyF12 -> SpecialKey KeyF12- GLFW.KeyF13 -> SpecialKey KeyF13- GLFW.KeyF14 -> SpecialKey KeyF14- GLFW.KeyF15 -> SpecialKey KeyF15- GLFW.KeyF16 -> SpecialKey KeyF16- GLFW.KeyF17 -> SpecialKey KeyF17- GLFW.KeyF18 -> SpecialKey KeyF18- GLFW.KeyF19 -> SpecialKey KeyF19- GLFW.KeyF20 -> SpecialKey KeyF20- GLFW.KeyF21 -> SpecialKey KeyF21- GLFW.KeyF22 -> SpecialKey KeyF22- GLFW.KeyF23 -> SpecialKey KeyF23- GLFW.KeyF24 -> SpecialKey KeyF24- GLFW.KeyF25 -> SpecialKey KeyF25- GLFW.KeyUp -> SpecialKey KeyUp- GLFW.KeyDown -> SpecialKey KeyDown- GLFW.KeyLeft -> SpecialKey KeyLeft- GLFW.KeyRight -> SpecialKey KeyRight- GLFW.KeyTab -> SpecialKey KeyTab- GLFW.KeyEnter -> SpecialKey KeyEnter- GLFW.KeyBackspace -> SpecialKey KeyBackspace- GLFW.KeyInsert -> SpecialKey KeyInsert- GLFW.KeyDel -> SpecialKey KeyDelete- GLFW.KeyPageup -> SpecialKey KeyPageUp- GLFW.KeyPagedown -> SpecialKey KeyPageDown- GLFW.KeyHome -> SpecialKey KeyHome- GLFW.KeyEnd -> SpecialKey KeyEnd- GLFW.KeyPad0 -> SpecialKey KeyPad0- GLFW.KeyPad1 -> SpecialKey KeyPad1- GLFW.KeyPad2 -> SpecialKey KeyPad2- GLFW.KeyPad3 -> SpecialKey KeyPad3- GLFW.KeyPad4 -> SpecialKey KeyPad4- GLFW.KeyPad5 -> SpecialKey KeyPad5- GLFW.KeyPad6 -> SpecialKey KeyPad6- GLFW.KeyPad7 -> SpecialKey KeyPad7- GLFW.KeyPad8 -> SpecialKey KeyPad8- GLFW.KeyPad9 -> SpecialKey KeyPad9- GLFW.KeyPadDivide -> SpecialKey KeyPadDivide- GLFW.KeyPadMultiply -> SpecialKey KeyPadMultiply- GLFW.KeyPadSubtract -> SpecialKey KeyPadSubtract- GLFW.KeyPadAdd -> SpecialKey KeyPadAdd- GLFW.KeyPadDecimal -> SpecialKey KeyPadDecimal- GLFW.KeyPadEqual -> Char '='- GLFW.KeyPadEnter -> SpecialKey KeyPadEnter- _ -> SpecialKey KeyUnknown+ GLFW.Key'A -> charToSpecial 'a'+ GLFW.Key'B -> charToSpecial 'b'+ GLFW.Key'C -> charToSpecial 'c'+ GLFW.Key'D -> charToSpecial 'd'+ GLFW.Key'E -> charToSpecial 'e'+ GLFW.Key'F -> charToSpecial 'f'+ GLFW.Key'G -> charToSpecial 'g'+ GLFW.Key'H -> charToSpecial 'h'+ GLFW.Key'I -> charToSpecial 'i'+ GLFW.Key'J -> charToSpecial 'j'+ GLFW.Key'K -> charToSpecial 'k'+ GLFW.Key'L -> charToSpecial 'l'+ GLFW.Key'M -> charToSpecial 'm'+ GLFW.Key'N -> charToSpecial 'n'+ GLFW.Key'O -> charToSpecial 'o'+ GLFW.Key'P -> charToSpecial 'p'+ GLFW.Key'Q -> charToSpecial 'q'+ GLFW.Key'R -> charToSpecial 'r'+ GLFW.Key'S -> charToSpecial 's'+ GLFW.Key'T -> charToSpecial 't'+ GLFW.Key'U -> charToSpecial 'u'+ GLFW.Key'V -> charToSpecial 'v'+ GLFW.Key'W -> charToSpecial 'w'+ GLFW.Key'X -> charToSpecial 'x'+ GLFW.Key'Y -> charToSpecial 'y'+ GLFW.Key'Z -> charToSpecial 'z'+ GLFW.Key'Space -> SpecialKey KeySpace+ GLFW.Key'Escape -> SpecialKey KeyEsc+ GLFW.Key'F1 -> SpecialKey KeyF1+ GLFW.Key'F2 -> SpecialKey KeyF2+ GLFW.Key'F3 -> SpecialKey KeyF3+ GLFW.Key'F4 -> SpecialKey KeyF4+ GLFW.Key'F5 -> SpecialKey KeyF5+ GLFW.Key'F6 -> SpecialKey KeyF6+ GLFW.Key'F7 -> SpecialKey KeyF7+ GLFW.Key'F8 -> SpecialKey KeyF8+ GLFW.Key'F9 -> SpecialKey KeyF9+ GLFW.Key'F10 -> SpecialKey KeyF10+ GLFW.Key'F11 -> SpecialKey KeyF11+ GLFW.Key'F12 -> SpecialKey KeyF12+ GLFW.Key'F13 -> SpecialKey KeyF13+ GLFW.Key'F14 -> SpecialKey KeyF14+ GLFW.Key'F15 -> SpecialKey KeyF15+ GLFW.Key'F16 -> SpecialKey KeyF16+ GLFW.Key'F17 -> SpecialKey KeyF17+ GLFW.Key'F18 -> SpecialKey KeyF18+ GLFW.Key'F19 -> SpecialKey KeyF19+ GLFW.Key'F20 -> SpecialKey KeyF20+ GLFW.Key'F21 -> SpecialKey KeyF21+ GLFW.Key'F22 -> SpecialKey KeyF22+ GLFW.Key'F23 -> SpecialKey KeyF23+ GLFW.Key'F24 -> SpecialKey KeyF24+ GLFW.Key'F25 -> SpecialKey KeyF25+ GLFW.Key'Up -> SpecialKey KeyUp+ GLFW.Key'Down -> SpecialKey KeyDown+ GLFW.Key'Left -> SpecialKey KeyLeft+ GLFW.Key'Right -> SpecialKey KeyRight+ GLFW.Key'Tab -> SpecialKey KeyTab+ GLFW.Key'Enter -> SpecialKey KeyEnter+ GLFW.Key'Backspace -> SpecialKey KeyBackspace+ GLFW.Key'Insert -> SpecialKey KeyInsert+ GLFW.Key'Delete -> SpecialKey KeyDelete+ GLFW.Key'PageUp -> SpecialKey KeyPageUp+ GLFW.Key'PageDown -> SpecialKey KeyPageDown+ GLFW.Key'Home -> SpecialKey KeyHome+ GLFW.Key'End -> SpecialKey KeyEnd+ GLFW.Key'Pad0 -> SpecialKey KeyPad0+ GLFW.Key'Pad1 -> SpecialKey KeyPad1+ GLFW.Key'Pad2 -> SpecialKey KeyPad2+ GLFW.Key'Pad3 -> SpecialKey KeyPad3+ GLFW.Key'Pad4 -> SpecialKey KeyPad4+ GLFW.Key'Pad5 -> SpecialKey KeyPad5+ GLFW.Key'Pad6 -> SpecialKey KeyPad6+ GLFW.Key'Pad7 -> SpecialKey KeyPad7+ GLFW.Key'Pad8 -> SpecialKey KeyPad8+ GLFW.Key'Pad9 -> SpecialKey KeyPad9+ GLFW.Key'PadDivide -> SpecialKey KeyPadDivide+ GLFW.Key'PadMultiply -> SpecialKey KeyPadMultiply+ GLFW.Key'PadSubtract -> SpecialKey KeyPadSubtract+ GLFW.Key'PadAdd -> SpecialKey KeyPadAdd+ GLFW.Key'PadDecimal -> SpecialKey KeyPadDecimal+ GLFW.Key'PadEqual -> Char '='+ GLFW.Key'PadEnter -> SpecialKey KeyPadEnter+ _ -> SpecialKey KeyUnknown --- | Convert char keys to special keys to work around a bug in +-- | Convert char keys to special keys to work around a bug in -- GLFW 2.7. On OS X, GLFW sometimes registers special keys as char keys, -- so we convert them back here. -- GLFW 2.7 is current as of Nov 2011, and is shipped with the Hackage@@ -581,11 +702,11 @@ instance GLFWKey GLFW.MouseButton where fromGLFW mouse = case mouse of- GLFW.MouseButton0 -> MouseButton LeftButton- GLFW.MouseButton1 -> MouseButton RightButton- GLFW.MouseButton2 -> MouseButton MiddleButton- GLFW.MouseButton3 -> MouseButton $ AdditionalButton 3- GLFW.MouseButton4 -> MouseButton $ AdditionalButton 4- GLFW.MouseButton5 -> MouseButton $ AdditionalButton 5- GLFW.MouseButton6 -> MouseButton $ AdditionalButton 6- GLFW.MouseButton7 -> MouseButton $ AdditionalButton 7+ GLFW.MouseButton'1 -> MouseButton LeftButton+ GLFW.MouseButton'2 -> MouseButton RightButton+ GLFW.MouseButton'3 -> MouseButton MiddleButton+ GLFW.MouseButton'4 -> MouseButton $ AdditionalButton 4+ GLFW.MouseButton'5 -> MouseButton $ AdditionalButton 5+ GLFW.MouseButton'6 -> MouseButton $ AdditionalButton 6+ GLFW.MouseButton'7 -> MouseButton $ AdditionalButton 7+ GLFW.MouseButton'8 -> MouseButton $ AdditionalButton 8
Graphics/Gloss/Internals/Interface/Backend/GLUT.hs view
@@ -1,6 +1,6 @@ {-# OPTIONS_HADDOCK hide #-} module Graphics.Gloss.Internals.Interface.Backend.GLUT- (GLUTState)+ (GLUTState,glutStateInit,initializeGLUT) where import Data.IORef@@ -11,16 +11,26 @@ import qualified Graphics.UI.GLUT as GLUT import qualified System.Exit as System import Graphics.Gloss.Internals.Interface.Backend.Types+import System.IO.Unsafe +-- Were we to support freeglut only, we could use GLUT.get to discover+-- whether we are initialized or not. If not, we do a quick initialize,+-- get the screenzie, and then do GLUT.exit. This avoids the use of+-- global variables. Unfortunately, there is no failsafe way to check+-- whether glut is initialized in some older versions of glut, which is+-- what we'd use instead of the global variable to get the required info.+glutInitialized :: IORef Bool+{-# NOINLINE glutInitialized #-}+glutInitialized = unsafePerformIO $ do newIORef False -- | State information for the GLUT backend.-data GLUTState +data GLUTState = GLUTState { -- Count of total number of frames that we have drawn. glutStateFrameCount :: !Int -- Bool to remember if we've set the timeout callback.- , glutStateHasTimeout :: Bool + , glutStateHasTimeout :: Bool -- Bool to remember if we've set the idle callback. , glutStateHasIdle :: Bool }@@ -29,10 +39,10 @@ -- | Initial GLUT state. glutStateInit :: GLUTState-glutStateInit +glutStateInit = GLUTState- { glutStateFrameCount = 0 - , glutStateHasTimeout = False + { glutStateFrameCount = 0+ , glutStateHasTimeout = False , glutStateHasIdle = False } @@ -68,6 +78,10 @@ = do GL.Size sizeX sizeY <- get GLUT.windowSize return (fromEnum sizeX,fromEnum sizeY) + getScreenSize _+ = do GL.Size width height <- get GLUT.screenSize+ return (fromIntegral width, fromIntegral height)+ elapsedTime _ = do t <- get GLUT.elapsedTime return $ (fromIntegral t) / 1000@@ -82,25 +96,28 @@ -> Bool -> IO () -initializeGLUT _ debug - = do (_progName, _args) <- GLUT.getArgsAndInitialize-- glutVersion <- get GLUT.glutVersion- when debug- $ putStr $ " glutVersion = " ++ show glutVersion ++ "\n"+initializeGLUT _ debug+ = do initialized <- readIORef glutInitialized+ if not initialized+ then do (_progName, _args) <- GLUT.getArgsAndInitialize+ glutVersion <- get GLUT.glutVersion+ when debug+ $ putStr $ " glutVersion = " ++ show glutVersion ++ "\n" - GLUT.initialDisplayMode- $= [ GLUT.RGBMode- , GLUT.DoubleBuffered]+ 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"+ writeIORef glutInitialized True + -- 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"+ else when debug (putStrLn "Already initialized") -- Open Window ---------------------------------------------------------------- openWindowGLUT@@ -115,7 +132,7 @@ -- createWindow. If we don't do this we get wierd half-created -- windows some of the time. case display of- InWindow windowName (sizeX, sizeY) (posX, posY) -> + InWindow windowName (sizeX, sizeY) (posX, posY) -> do GLUT.initialWindowSize $= GL.Size (fromIntegral sizeX)@@ -133,11 +150,9 @@ (fromIntegral sizeX) (fromIntegral sizeY) - FullScreen (sizeX, sizeY) -> - do GLUT.initialWindowSize- $= GL.Size- (fromIntegral sizeX)- (fromIntegral sizeY)+ FullScreen ->+ do size <- get GLUT.screenSize+ GLUT.initialWindowSize $= size _ <- GLUT.createWindow "Gloss Application" GLUT.fullScreen @@ -148,11 +163,11 @@ -- Dump State ------------------------------------------------------------------dumpStateGLUT +dumpStateGLUT :: IORef GLUTState -> IO () -dumpStateGLUT _ +dumpStateGLUT _ = do wbw <- get GLUT.windowBorderWidth whh <- get GLUT.windowHeaderHeight@@ -184,19 +199,19 @@ ++ "\n" -- Display Callback ------------------------------------------------------------installDisplayCallbackGLUT +installDisplayCallbackGLUT :: IORef GLUTState -> [Callback] -> IO () installDisplayCallbackGLUT ref callbacks = GLUT.displayCallback $= callbackDisplay ref callbacks -callbackDisplay +callbackDisplay :: IORef GLUTState -> [Callback] -> IO () -callbackDisplay refState callbacks - = do +callbackDisplay refState callbacks+ = do -- Clear the display GL.clear [GL.ColorBuffer, GL.DepthBuffer] GL.color $ GL.Color4 0 0 0 (1 :: GL.GLfloat)@@ -227,7 +242,7 @@ state <- readIORef refState when ( (not $ glutStateHasTimeout state) && (not $ glutStateHasIdle state))- $ do + $ do -- Setting the timer interrupt to 1sec keeps CPU usage for a -- single process to < 0.5% or so on OSX. This is the rate -- that the process is woken up, but GLUT will only actually@@ -235,7 +250,7 @@ let msecHeartbeat = 1000 -- We're installing this callback on the first display- -- call because it's a GLUT specific mechanism. + -- call because it's a GLUT specific mechanism. -- We don't do the same thing for other Backends. GLUT.addTimerCallback msecHeartbeat $ timerCallback msecHeartbeat@@ -246,7 +261,7 @@ -- Don't report errors by default.- -- The windows OpenGL implementation seems to complain for no reason. + -- The windows OpenGL implementation seems to complain for no reason. -- GLUT.reportErrors atomicModifyIORef' refState@@ -283,7 +298,7 @@ -- KeyMouse Callback -----------------------------------------------------------installKeyMouseCallbackGLUT +installKeyMouseCallbackGLUT :: IORef GLUTState -> [Callback] -> IO () @@ -310,7 +325,7 @@ -- Motion Callback -------------------------------------------------------------installMotionCallbackGLUT +installMotionCallbackGLUT :: IORef GLUTState -> [Callback] -> IO () @@ -349,7 +364,7 @@ -- | Call back when glut is idle.-callbackIdle +callbackIdle :: IORef GLUTState -> [Callback] -> IO () @@ -361,7 +376,7 @@ ------------------------------------------------------------------------------- -- | Convert GLUTs key codes to our internal ones. glutKeyToKey :: GLUT.Key -> Key-glutKeyToKey key +glutKeyToKey key = case key of GLUT.Char '\32' -> SpecialKey KeySpace GLUT.Char '\13' -> SpecialKey KeyEnter@@ -416,11 +431,11 @@ -- | Convert GLUTs key states to our internal ones.-glutModifiersToModifiers +glutModifiersToModifiers :: GLUT.Modifiers -> Modifiers- -glutModifiersToModifiers (GLUT.Modifiers a b c) ++glutModifiersToModifiers (GLUT.Modifiers a b c) = Modifiers (glutKeyStateToKeyState a) (glutKeyStateToKeyState b) (glutKeyStateToKeyState c)
Graphics/Gloss/Internals/Interface/Backend/Types.hs view
@@ -64,6 +64,9 @@ -- | Function that returns (width,height) of the window in pixels. getWindowDimensions :: IORef a -> IO (Int,Int) + -- | Function that returns (width,height) of a fullscreen window in pixels.+ getScreenSize :: IORef a -> IO (Int,Int)+ -- | Function that reports the time elapsed since the application started. -- (in seconds) elapsedTime :: IORef a -> IO Double@@ -81,7 +84,7 @@ = forall a . Backend a => IORef a -> IO () -- | Arguments: KeyType, Key Up \/ Down, Ctrl \/ Alt \/ Shift pressed, latest mouse location.-type KeyboardMouseCallback +type KeyboardMouseCallback = forall a . Backend a => IORef a -> Key -> KeyState -> Modifiers -> (Int,Int) -> IO () -- | Arguments: (PosX,PosY) in pixels.@@ -109,7 +112,7 @@ -- | Check if this is an `Idle` callback. isIdleCallback :: Callback -> Bool isIdleCallback cc- = case cc of + = case cc of Idle _ -> True _ -> False @@ -118,7 +121,7 @@ -- This is Glosses view of mouse and keyboard events. -- The actual events provided by the backends are converted to this form -- by the backend module.- + data Key = Char Char | SpecialKey SpecialKey
Graphics/Gloss/Internals/Interface/Common/Exit.hs view
@@ -1,5 +1,6 @@+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE RankNTypes #-} {-# OPTIONS_HADDOCK hide #-}-{-# LANGUAGE PatternGuards, RankNTypes #-} -- | Callback for exiting the program. module Graphics.Gloss.Internals.Interface.Common.Exit@@ -20,6 +21,6 @@ | key == SpecialKey KeyEsc , keyState == Down = exitBackend backend- + | otherwise = return ()
Graphics/Gloss/Internals/Interface/Debug.hs view
@@ -8,7 +8,7 @@ where import qualified Graphics.Rendering.OpenGL.GL as GL import Graphics.Rendering.OpenGL (get)- + -- | Dump internal state of the OpenGL framebuffer dumpFramebufferState :: IO () dumpFramebufferState@@ -21,16 +21,16 @@ 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"@@ -50,8 +50,8 @@ ++ " stencil = " ++ show stencilMask ++ "\n" ++ " depth = " ++ show depthMask ++ "\n" ++ "\n"- + -- | Dump internal state of the fragment renderer. dumpFragmentState :: IO () dumpFragmentState@@ -59,7 +59,7 @@ blend <- get GL.blend blendEquation <- get GL.blendEquation blendFunc <- get GL.blendFunc- + putStr $ "* dumpFragmentState\n" ++ " blend = " ++ show blend ++ "\n" ++ " blend equation = " ++ show blendEquation ++ "\n"
Graphics/Gloss/Internals/Interface/Display.hs view
@@ -1,7 +1,7 @@ module Graphics.Gloss.Internals.Interface.Display (displayWithBackend)-where +where import Graphics.Gloss.Data.Color import Graphics.Gloss.Data.Controller import Graphics.Gloss.Data.Picture@@ -36,14 +36,14 @@ = do viewSR <- newIORef viewStateInit renderS <- initState renderSR <- newIORef renderS- + let renderFun backendRef = do port <- viewStateViewPort <$> readIORef viewSR options <- readIORef renderSR windowSize <- getWindowDimensions backendRef picture <- makePicture - displayPicture + displayPicture windowSize background options@@ -54,11 +54,11 @@ performGC let callbacks- = [ Callback.Display renderFun + = [ Callback.Display renderFun -- Escape exits the program- , callback_exit () - + , callback_exit ()+ -- Viewport control with mouse , callback_viewState_keyMouse viewSR , callback_viewState_motion viewSR@@ -74,7 +74,7 @@ { controllerSetRedraw = do postRedisplay backendRef - , controllerModifyViewPort + , controllerModifyViewPort = \modViewPort -> do viewState <- readIORef viewSR port' <- modViewPort $ viewStateViewPort viewState
Graphics/Gloss/Internals/Interface/Event.hs view
@@ -45,7 +45,7 @@ let (px_, py_) = pos let px = fromIntegral px_ let py = sizeY - fromIntegral py_- + let px' = px - sizeX / 2 let py' = py - sizeY / 2 let pos' = (px', py')
Graphics/Gloss/Internals/Interface/Game.hs view
@@ -29,11 +29,11 @@ -> Color -- ^ Background color. -> Int -- ^ Number of simulation steps to take for each second of real time. -> world -- ^ The initial world.- -> (world -> IO Picture) + -> (world -> IO Picture) -- ^ A function to convert the world to a picture.- -> (Event -> world -> IO world) + -> (Event -> world -> IO world) -- ^ A function to handle input events.- -> (Float -> world -> IO world) + -> (Float -> world -> IO world) -- ^ A function to step the world one iteration. -- It is passed the period of time (in seconds) needing to be advanced. -> Bool -- ^ Whether to use the callback_exit or not.@@ -69,7 +69,7 @@ -- convert the world to a picture world <- readIORef worldSR picture <- worldToPicture world- + -- display the picture in the current view renderS <- readIORef renderSR viewPort <- readIORef viewSR@@ -83,7 +83,7 @@ renderS (viewPortScale viewPort) (applyViewPortToPicture viewPort picture)- + -- perform GC every frame to try and avoid long pauses performGC @@ -91,7 +91,7 @@ = [ Callback.Display (animateBegin animateSR) , Callback.Display displayFun , Callback.Display (animateEnd animateSR)- , Callback.Idle (callback_simulate_idle + , Callback.Idle (callback_simulate_idle stateSR animateSR (readIORef viewSR) worldSR (\_ -> worldAdvance) singleStepTime)@@ -102,17 +102,17 @@ let exitCallback = if withCallbackExit then [callback_exit ()] else [] - createWindow - backend - display - backgroundColor + createWindow+ backend+ display+ backgroundColor (callbacks ++ exitCallback) (\_ -> return ()) -- | Callback for KeyMouse events.-callback_keyMouse +callback_keyMouse :: IORef world -- ^ ref to world state -> IORef ViewPort -> (Event -> world -> IO world) -- ^ fn to handle input events@@ -122,7 +122,7 @@ = KeyMouse (handle_keyMouse worldRef viewRef eventFn) -handle_keyMouse +handle_keyMouse :: IORef a -> t -> (Event -> a -> IO a)@@ -145,7 +145,7 @@ = Motion (handle_motion worldRef eventFn) -handle_motion +handle_motion :: IORef a -> (Event -> a -> IO a) -> MotionCallback
+ Graphics/Gloss/Internals/Interface/Interact.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE RankNTypes #-}++module Graphics.Gloss.Internals.Interface.Interact+ (interactWithBackend)+where+import Graphics.Gloss.Data.Color+import Graphics.Gloss.Data.Controller+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.ViewPort+import Graphics.Gloss.Data.ViewState+import Graphics.Gloss.Rendering+import Graphics.Gloss.Internals.Interface.Event+import Graphics.Gloss.Internals.Interface.Backend+import Graphics.Gloss.Internals.Interface.Window+import Graphics.Gloss.Internals.Interface.ViewState.Reshape+import qualified Graphics.Gloss.Internals.Interface.Callback as Callback+import Data.IORef+import System.Mem+++interactWithBackend+ :: Backend a+ => a -- ^ Initial state of the backend.+ -> Display -- ^ Display config.+ -> Color -- ^ Background color.+ -> world -- ^ The initial world.+ -> (world -> IO Picture) -- ^ A function to produce the current picture.+ -> (Event -> world -> IO world) -- ^ A function to handle input events.+ -> (Controller -> IO ()) -- ^ Eat the controller+ -> IO ()++interactWithBackend+ backend displayMode background+ worldStart+ worldToPicture+ worldHandleEvent+ eatController++ = do viewSR <- newIORef viewStateInit+ worldSR <- newIORef worldStart+ renderS <- initState+ renderSR <- newIORef renderS++ let displayFun backendRef = do+ world <- readIORef worldSR+ picture <- worldToPicture world++ renderS' <- readIORef renderSR+ viewState <- readIORef viewSR+ let viewPort = viewStateViewPort viewState++ windowSize <- getWindowDimensions backendRef++ displayPicture+ windowSize+ background+ renderS'+ (viewPortScale viewPort)+ (applyViewPortToPicture viewPort picture)++ -- perform GC every frame to try and avoid long pauses+ performGC++ let callbacks+ = [ Callback.Display displayFun++ -- Viewport control with mouse+ , callback_keyMouse worldSR viewSR worldHandleEvent+ , callback_motion worldSR worldHandleEvent+ , callback_reshape worldSR worldHandleEvent ]++ -- When we create the window we can pass a function to get a+ -- reference to the backend state. Using this we make a controller+ -- so the client can control the window asynchronously.+ createWindow backend displayMode background callbacks+ $ \ backendRef+ -> eatController+ $ Controller+ { controllerSetRedraw+ = do postRedisplay backendRef++ , controllerModifyViewPort+ = \modViewPort+ -> do viewState <- readIORef viewSR+ port' <- modViewPort $ viewStateViewPort viewState+ let viewState' = viewState { viewStateViewPort = port' }+ writeIORef viewSR viewState'+ postRedisplay backendRef+ }+++-- | Callback for KeyMouse events.+callback_keyMouse+ :: IORef world -- ^ ref to world state+ -> IORef ViewState+ -> (Event -> world -> IO world) -- ^ fn to handle input events+ -> Callback++callback_keyMouse worldRef viewRef eventFn+ = KeyMouse (handle_keyMouse worldRef viewRef eventFn)+++handle_keyMouse+ :: IORef a+ -> t+ -> (Event -> a -> IO a)+ -> KeyboardMouseCallback++handle_keyMouse worldRef _ eventFn backendRef key keyState keyMods pos+ = do ev <- keyMouseEvent backendRef key keyState keyMods pos+ world <- readIORef worldRef+ world' <- eventFn ev world+ writeIORef worldRef world'+ postRedisplay backendRef+++-- | Callback for Motion events.+callback_motion+ :: IORef world -- ^ ref to world state+ -> (Event -> world -> IO world) -- ^ fn to handle input events+ -> Callback++callback_motion worldRef eventFn+ = Motion (handle_motion worldRef eventFn)+++handle_motion+ :: IORef a+ -> (Event -> a -> IO a)+ -> MotionCallback++handle_motion worldRef eventFn backendRef pos+ = do ev <- motionEvent backendRef pos+ world <- readIORef worldRef+ world' <- eventFn ev world+ writeIORef worldRef world'+ postRedisplay backendRef+++-- | Callback for Handle reshape event.+callback_reshape+ :: IORef world+ -> (Event -> world -> IO world)+ -> Callback++callback_reshape worldRef eventFN+ = Reshape (handle_reshape worldRef eventFN)+++handle_reshape+ :: IORef world+ -> (Event -> world -> IO world)+ -> ReshapeCallback+handle_reshape worldRef eventFn backendRef (width,height)+ = do world <- readIORef worldRef+ world' <- eventFn (EventResize (width, height)) world+ writeIORef worldRef world'+ viewState_reshape backendRef (width, height)+ postRedisplay backendRef+
Graphics/Gloss/Internals/Interface/Simulate.hs view
@@ -32,9 +32,9 @@ -> Color -- ^ Background color. -> Int -- ^ Number of simulation steps to take for each second of real time. -> model -- ^ The initial model.- -> (model -> IO Picture) + -> (model -> IO Picture) -- ^ A function to convert the model to a picture.- -> (ViewPort -> Float -> model -> IO model) + -> (ViewPort -> Float -> model -> IO model) -- ^ A function to step the model one iteration. It is passed the -- current viewport and the amount of time for this simulation -- step (in seconds).@@ -82,7 +82,7 @@ renderS (viewPortScale port) (applyViewPortToPicture port picture)- + -- perform GC every frame to try and avoid long pauses performGC @@ -90,12 +90,12 @@ = [ Callback.Display (animateBegin animateSR) , Callback.Display displayFun , Callback.Display (animateEnd animateSR)- , Callback.Idle (callback_simulate_idle + , Callback.Idle (callback_simulate_idle stateSR animateSR (viewStateViewPort <$> readIORef viewSR) worldSR worldAdvance singleStepTime)- , callback_exit () + , callback_exit () , callback_viewState_keyMouse viewSR , callback_viewState_motion viewSR , callback_viewState_reshape ]
Graphics/Gloss/Internals/Interface/Simulate/Idle.hs view
@@ -25,24 +25,24 @@ -- Game) and sometimes a ref to a 'ViewState'. -> IORef world -- ^ the current world -> (ViewPort -> Float -> world -> IO world) -- ^ fn to advance the world- -> Float -- ^ how much time to advance world by + -> Float -- ^ how much time to advance world by -- in single step mode -> IdleCallback- + callback_simulate_idle simSR animateSR viewSA worldSR worldAdvance _singleStepTime backendRef = {-# SCC "callbackIdle" #-} do simulate_run simSR animateSR viewSA worldSR worldAdvance backendRef- + -- take the number of steps specified by controlWarp-simulate_run +simulate_run :: IORef SM.State -> IORef AN.State -> IO ViewPort -> IORef world -> (ViewPort -> Float -> world -> IO world) -> IdleCallback- + simulate_run simSR _ viewSA worldSR worldAdvance backendRef = do viewS <- viewSA simS <- readIORef simSR@@ -53,11 +53,11 @@ -- 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@@ -65,7 +65,7 @@ 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"@@ -78,7 +78,7 @@ let nFinal = nStart + thisSteps -- keep advancing the world until we get to the final iteration number- (_,world') + (_,world') <- untilM (\(n, _) -> n >= nFinal) (\(n, w) -> liftM (\w' -> (n+1,w')) ( worldAdvance viewS timePerStep w)) (nStart, worldS)@@ -91,7 +91,7 @@ modifyIORef' simSR $ \c -> c { SM.stateIteration = nFinal , SM.stateSimTime = newSimTime }- + -- tell glut we want to draw the window after returning Backend.postRedisplay backendRef @@ -105,4 +105,4 @@ where go x | test x = return x | otherwise = op x >>= go- +
Graphics/Gloss/Internals/Interface/Simulate/State.hs view
@@ -6,24 +6,24 @@ where -- | Simulation state-data State +data State = State { -- | The iteration number we're up to. stateIteration :: !Integer -- | How many simulation setps to take for each second of real time- , stateResolution :: !Int - + , stateResolution :: !Int+ -- | How many seconds worth of simulation we've done so far , stateSimTime :: !Float }- + -- | Initial control state stateInit :: Int -> State stateInit resolution = State { stateIteration = 0- , stateResolution = resolution + , stateResolution = resolution , stateSimTime = 0 }- - ++
Graphics/Gloss/Internals/Interface/ViewState/KeyMouse.hs view
@@ -12,7 +12,7 @@ -- | Callback to handle keyboard and mouse button events -- for controlling the 'ViewState'.-callback_viewState_keyMouse +callback_viewState_keyMouse :: IORef ViewState -> Callback @@ -26,7 +26,7 @@ ev <- keyMouseEvent stateRef key keyState keyMods pos case updateViewStateWithEventMaybe ev viewState of Nothing -> return ()- Just viewState' + Just viewState' -> do viewStateRef `writeIORef` viewState' postRedisplay stateRef
Graphics/Gloss/Internals/Interface/ViewState/Motion.hs view
@@ -1,5 +1,6 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_HADDOCK hide #-}-{-# LANGUAGE ScopedTypeVariables, RankNTypes #-} module Graphics.Gloss.Internals.Interface.ViewState.Motion (callback_viewState_motion)@@ -13,7 +14,7 @@ -- | Callback to handle keyboard and mouse button events -- for controlling the viewport.-callback_viewState_motion +callback_viewState_motion :: IORef ViewState -> Callback @@ -27,7 +28,7 @@ ev <- motionEvent stateRef pos case updateViewStateWithEventMaybe ev viewState of Nothing -> return ()- Just viewState' + Just viewState' -> do viewStateRef `writeIORef` viewState' postRedisplay stateRef
gloss.cabal view
@@ -1,54 +1,58 @@ Name: gloss-Version: 1.10.2.5+Version: 1.13.2.2 License: MIT License-file: LICENSE Author: Ben Lippmeier Maintainer: benl@ouroborus.net Build-Type: Simple-Cabal-Version: >=1.6+Cabal-Version: >=1.10 Stability: stable Category: Graphics Homepage: http://gloss.ouroborus.net Bug-reports: gloss@ouroborus.net Description:- Gloss hides the pain of drawing simple vector graphics behind a nice data type and- a few display functions. Gloss uses OpenGL under the hood, but you won't need to- worry about any of that. Get something cool on the screen in under 10 minutes.+ Gloss hides the pain of drawing simple vector graphics behind a nice data type and+ a few display functions. Gloss uses OpenGL under the hood, but you won't need to+ worry about any of that. Get something cool on the screen in under 10 minutes. Synopsis: Painless 2D vector graphics, animations and simulations. source-repository head- type: git- location: https://github.com/benl23x5/gloss+ type: git+ location: https://github.com/benl23x5/gloss +source-repository this+ type: git+ tag: v1.13.0.0+ location: https://github.com/benl23x5/gloss+ Flag GLUT- Description: Enable the GLUT backend- Default: True+ Description: Enable the GLUT backend+ Default: True Flag GLFW- Description: Enable the GLFW backend- Default: False--Flag ExplicitBackend- Description: Expose versions of 'display' and friends that allow- you to choose what window manager backend to use.- Default: False+ Description: Enable the GLFW backend+ Default: False Library- Build-Depends: - base >= 4.8 && < 4.10,- ghc-prim >= 0.4 && < 0.6,- containers == 0.5.*,- bytestring == 0.10.*,- OpenGL >= 2.12 && < 3.1,- GLUT == 2.7.*,- bmp == 1.2.*,- gloss-rendering == 1.10.*+ Build-Depends:+ base >= 4.8 && < 5+ , ghc-prim+ , bmp == 1.2.*+ , bytestring == 0.11.*+ , containers >= 0.5 && < 0.7+ , gloss-rendering == 1.13.*+ , GLUT == 2.7.*+ , OpenGL >= 2.12 && < 3.1 ghc-options:- -O2 -Wall+ -O2+ -Wall + Default-Language:+ Haskell2010+ Exposed-modules: Graphics.Gloss Graphics.Gloss.Data.Bitmap@@ -57,6 +61,7 @@ Graphics.Gloss.Data.Display Graphics.Gloss.Data.Picture Graphics.Gloss.Data.Point+ Graphics.Gloss.Data.Point.Arithmetic Graphics.Gloss.Data.Vector Graphics.Gloss.Data.ViewPort Graphics.Gloss.Data.ViewState@@ -68,8 +73,10 @@ Graphics.Gloss.Interface.Pure.Game Graphics.Gloss.Interface.IO.Animate Graphics.Gloss.Interface.IO.Display+ Graphics.Gloss.Interface.IO.Interact Graphics.Gloss.Interface.IO.Simulate Graphics.Gloss.Interface.IO.Game+ Graphics.Gloss.Interface.Environment Other-modules: Graphics.Gloss.Internals.Color@@ -88,23 +95,23 @@ Graphics.Gloss.Internals.Interface.Window Graphics.Gloss.Internals.Interface.Display Graphics.Gloss.Internals.Interface.Animate+ Graphics.Gloss.Internals.Interface.Interact Graphics.Gloss.Internals.Interface.Simulate Graphics.Gloss.Internals.Interface.Game Graphics.Gloss.Internals.Interface.Backend - Extensions:- DeriveDataTypeable- PatternGuards- If flag(GLUT) CPP-Options: -DWITHGLUT Other-modules:- Graphics.Gloss.Internals.Interface.Backend.GLUT+ Graphics.Gloss.Internals.Interface.Backend.GLUT + -- NOTE: GLUT is still required for text rendering, and must be initialized+ -- on Linux platforms. Thus, the GLFW backend still requires GLUT. If flag(GLFW) Build-Depends:- GLFW-b >= 1.4.1.0 && < 2+ GLFW-b >= 1.4.1.0 && < 2 CPP-Options: -DWITHGLFW Other-modules: Graphics.Gloss.Internals.Interface.Backend.GLFW +-- vim: nospell