gloss 1.11.1.1 → 1.12.0.0

raw patch · 37 files changed

+578/−310 lines, 37 filesdep ~basedep ~ghc-primdep ~gloss-renderingnew-uploaderPVP ok

version bump matches the API change (PVP)

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

API changes (from Hackage documentation)

Files

• Graphics/Gloss.hs +5/−5
• Graphics/Gloss/Data/Color.hs +8/−8
• Graphics/Gloss/Data/Picture.hs +13/−13
• 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 +3/−2
• 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 +35/−35
• Graphics/Gloss/Internals/Interface/Backend/GLUT.hs +26/−26
• Graphics/Gloss/Internals/Interface/Backend/Types.hs +3/−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 +34/−28

@@ -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@@ -73,7 +73,7 @@ -- -- 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

@@ -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

@@ -55,7 +55,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,13 +70,13 @@ text :: String -> Picture text = Text --- | A bitmap image with a width, height and a Vector holding the +-- | 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`.  +--  each frame then use `False`. --  If you have loaded it from a file then use `True`. bitmap  :: Int -> Int -> BitmapData -> Bool -> Picture bitmap = Bitmap@@ -112,29 +112,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. 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. +-- | A wireframe sector of a circle. --   An arc is draw counter-clockwise from the first to the second angle at --   the given radius. Lines are drawn from the origin to the ends of the arc. --- --   NOTE: We take the absolute value of the radius incase it's negative.---   It would also make sense to draw the sector flipped around the +--   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 +145,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)]

@@ -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

@@ -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')

@@ -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 #-}  

@@ -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 #-} 

@@ -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) }

@@ -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 

@@ -7,12 +7,13 @@  -- | Get the size of the screen, in pixels. -----   This will be the size of the rendered gloss image when +--   This will be the size of the rendered gloss image when --   fullscreen mode is enabled. -- getScreenSize :: IO (Int, Int)-getScreenSize +getScreenSize  = do   backendStateRef         <- newIORef glutStateInit         initializeGLUT backendStateRef False         GL.Size width height    <- GLUT.get GLUT.screenSize         return (fromIntegral width, fromIntegral height)+

@@ -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+

@@ -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

@@ -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.

@@ -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

@@ -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 ()

@@ -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 ()))

@@ -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)

@@ -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 () -        +

@@ -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

@@ -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 }

@@ -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 }  

@@ -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

@@ -22,7 +22,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.@@ -120,7 +120,7 @@  -- Open Window ---------------------------------------------------------------- -- | Open a new window.-openWindowGLFW +openWindowGLFW         :: IORef GLFWState         -> Display         -> IO ()@@ -131,11 +131,11 @@                  { GLFW.displayOptions_width        = sizeX                  , GLFW.displayOptions_height       = sizeY                  , GLFW.displayOptions_displayMode  = GLFW.Window }-        +         uncurry GLFW.setWindowPosition pos         GLFW.setWindowTitle title -        -- Try to enable sync-to-vertical-refresh by setting the number +        -- Try to enable sync-to-vertical-refresh by setting the number         -- of buffer swaps per vertical refresh to 1.         GLFW.setWindowBufferSwapInterval 1 @@ -145,8 +145,8 @@                  { GLFW.displayOptions_width        = sizeX                  , GLFW.displayOptions_height       = sizeY                  , GLFW.displayOptions_displayMode  = GLFW.Fullscreen }-        -        -- Try to enable sync-to-vertical-refresh by setting the number ++        -- Try to enable sync-to-vertical-refresh by setting the number         -- of buffer swaps per vertical refresh to 1.         GLFW.setWindowBufferSwapInterval 1         GLFW.enableMouseCursor@@ -218,11 +218,11 @@ -- Close Callback ------------------------------------------------------------- -- | Callback for when the user closes the window. --   We can do some cleanup here.-installWindowCloseCallbackGLFW +installWindowCloseCallbackGLFW         :: IORef GLFWState -> IO ()  installWindowCloseCallbackGLFW _- = GLFW.setWindowCloseCallback + = GLFW.setWindowCloseCallback  $ do #ifdef linux_HOST_OS -- See [Note: FreeGlut] for why we need this.@@ -240,7 +240,7 @@ installReshapeCallbackGLFW stateRef callbacks         = GLFW.setWindowSizeCallback (callbackReshape stateRef callbacks) -callbackReshape +callbackReshape         :: Backend a         => IORef a -> [Callback]         -> Int -> Int@@ -257,7 +257,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@@ -272,14 +272,14 @@   -- GLFW calls this on a non-character keyboard action.-callbackKeyboard +callbackKeyboard         :: IORef GLFWState -> [Callback]         -> GLFW.Key -> Bool         -> IO ()  callbackKeyboard stateRef callbacks key keystate  = do   (modsSet, GLFWState mods pos _ _ _ _)-                <- setModifiers stateRef key keystate     +                <- setModifiers stateRef key keystate         let key'      = fromGLFW key         let keystate' = if keystate then Down else Up         let isCharKey (Char _) = True@@ -287,12 +287,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)@@ -315,7 +315,7 @@   -- GLFW calls this on a when the user presses or releases a character key.-callbackChar +callbackChar         :: IORef GLFWState -> [Callback]         -> Char -> Bool -> IO () @@ -331,13 +331,13 @@         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@@ -349,7 +349,7 @@         let keystate' = if keystate 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] @@ -365,7 +365,7 @@         (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,14 +385,14 @@  -- Motion Callback ------------------------------------------------------------ -- | Callback for when the user moves the mouse.-installMotionCallbackGLFW +installMotionCallbackGLFW         :: IORef GLFWState -> [Callback]         -> IO ()  installMotionCallbackGLFW stateRef callbacks         = GLFW.setMousePositionCallback $ (callbackMotion stateRef callbacks) -callbackMotion +callbackMotion         :: IORef GLFWState -> [Callback]         -> Int -> Int         -> IO ()@@ -400,7 +400,7 @@  = do   pos <- setMousePos stateRef x y          -- Call all the Gloss Motion actions with the new state.-        sequence_ +        sequence_          $ map  (\f -> f pos)                 [f stateRef | Motion f <- callbacks] @@ -411,7 +411,7 @@ setMousePos stateRef x y  = do   let pos = (x,y) -        modifyIORef' stateRef $ \s -> s +        modifyIORef' stateRef $ \s -> s                 { mousePosition = pos }          return pos@@ -424,11 +424,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 () @@ -442,16 +442,16 @@         :: IORef GLFWState         -> IO () -runMainLoopGLFW stateRef +runMainLoopGLFW stateRef  = X.catch go exit  where   exit :: X.SomeException -> IO ()   exit e = print e >> exitGLFW stateRef    go   :: IO ()-  go +  go    = do windowIsOpen <- GLFW.windowIsOpen-        when windowIsOpen +        when windowIsOpen          $ do  GLFW.pollEvents                dirty <- fmap dirtyScreen $ readIORef stateRef @@ -460,7 +460,7 @@                        display s                        GLFW.swapBuffers -               modifyIORef' stateRef $ \s -> s +               modifyIORef' stateRef $ \s -> s                         { dirtyScreen = False }                 (readIORef stateRef) >>= (\s -> idle s)@@ -469,12 +469,12 @@   -- Redisplay -------------------------------------------------------------------postRedisplayGLFW +postRedisplayGLFW         :: IORef GLFWState         -> IO ()  postRedisplayGLFW stateRef-        = modifyIORef' stateRef $ \s -> s +        = modifyIORef' stateRef $ \s -> s                 { dirtyScreen = True }  @@ -483,7 +483,7 @@   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@@ -546,7 +546,7 @@         _                   -> 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

@@ -18,19 +18,19 @@ -- 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.  +-- 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 }@@ -39,7 +39,7 @@  -- | Initial GLUT state. glutStateInit :: GLUTState-glutStateInit  +glutStateInit         = GLUTState         { glutStateFrameCount   = 0         , glutStateHasTimeout   = False@@ -92,20 +92,20 @@         -> Bool         -> IO () -initializeGLUT _ debug +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]                    writeIORef glutInitialized True-                  +                   -- See if our requested display mode is possible                   displayMode         <- get GLUT.initialDisplayMode                   displayModePossible <- get GLUT.displayModePossible@@ -114,7 +114,7 @@                                 ++ "       possible      = " ++ show displayModePossible ++ "\n"                                 ++ "\n"          else when debug (putStrLn "Already initialized")-         + -- Open Window ---------------------------------------------------------------- openWindowGLUT         :: IORef GLUTState@@ -128,7 +128,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)@@ -146,7 +146,7 @@                           (fromIntegral sizeX)                           (fromIntegral sizeY) -          FullScreen -> +          FullScreen ->             do size <- get GLUT.screenSize                GLUT.initialWindowSize $= size                _ <- GLUT.createWindow "Gloss Application"@@ -159,11 +159,11 @@   -- Dump State ------------------------------------------------------------------dumpStateGLUT +dumpStateGLUT         :: IORef GLUTState         -> IO () -dumpStateGLUT _ +dumpStateGLUT _  = do         wbw             <- get GLUT.windowBorderWidth         whh             <- get GLUT.windowHeaderHeight@@ -195,19 +195,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)@@ -238,7 +238,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@@ -246,7 +246,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@@ -257,7 +257,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@@ -294,7 +294,7 @@   -- KeyMouse Callback -----------------------------------------------------------installKeyMouseCallbackGLUT +installKeyMouseCallbackGLUT         :: IORef GLUTState -> [Callback]         -> IO () @@ -321,7 +321,7 @@   -- Motion Callback -------------------------------------------------------------installMotionCallbackGLUT +installMotionCallbackGLUT         :: IORef GLUTState -> [Callback]         -> IO () @@ -360,7 +360,7 @@   -- | Call back when glut is idle.-callbackIdle +callbackIdle         :: IORef GLUTState -> [Callback]         -> IO () @@ -372,7 +372,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@@ -427,11 +427,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)

@@ -81,7 +81,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 +109,7 @@ -- | Check if this is an `Idle` callback. isIdleCallback :: Callback -> Bool isIdleCallback cc- = case cc of + = case cc of         Idle _  -> True         _       -> False @@ -118,7 +118,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

@@ -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 ()

@@ -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"

@@ -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

@@ -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')

@@ -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

@@ -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+

@@ -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 ]

@@ -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-        +

@@ -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 }-        -        ++

@@ -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 

@@ -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 

@@ -1,5 +1,5 @@ Name:                gloss-Version:             1.11.1.1+Version:             1.12.0.0 License:             MIT License-file:        LICENSE Author:              Ben Lippmeier@@ -11,43 +11,49 @@ 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.12.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+  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:  Expose versions of 'display' and friends that allow+                you to choose what window manager backend to use.+  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.11.*+  Build-Depends:+          base                          >= 4.8 && < 4.12+        , bmp                           == 1.2.*+        , bytestring                    == 0.10.*+        , containers                    == 0.5.*+        , ghc-prim+        , gloss-rendering               == 1.12.*+        , GLUT                          == 2.7.*+        , OpenGL                        >= 2.12 && < 3.1    ghc-options:-        -O2 -Wall+        -O2+        -Wall    Exposed-modules:         Graphics.Gloss@@ -57,6 +63,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,10 +75,11 @@         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         Graphics.Gloss.Internals.Interface.Animate.State@@ -89,14 +97,11 @@         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:@@ -109,3 +114,4 @@     Other-modules:         Graphics.Gloss.Internals.Interface.Backend.GLFW +-- vim: nospell