diff --git a/Graphics/Gloss.hs b/Graphics/Gloss.hs --- a/Graphics/Gloss.hs +++ b/Graphics/Gloss.hs @@ -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 . -- -module Graphics.Gloss +module Graphics.Gloss ( module Graphics.Gloss.Data.Picture , module Graphics.Gloss.Data.Color , module Graphics.Gloss.Data.Bitmap diff --git a/Graphics/Gloss/Data/Color.hs b/Graphics/Gloss/Data/Color.hs --- a/Graphics/Gloss/Data/Color.hs +++ b/Graphics/Gloss/Data/Color.hs @@ -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 diff --git a/Graphics/Gloss/Data/Picture.hs b/Graphics/Gloss/Data/Picture.hs --- a/Graphics/Gloss/Data/Picture.hs +++ b/Graphics/Gloss/Data/Picture.hs @@ -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)] diff --git a/Graphics/Gloss/Data/Point.hs b/Graphics/Gloss/Data/Point.hs --- a/Graphics/Gloss/Data/Point.hs +++ b/Graphics/Gloss/Data/Point.hs @@ -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 diff --git a/Graphics/Gloss/Data/Point/Arithmetic.hs b/Graphics/Gloss/Data/Point/Arithmetic.hs new file mode 100644 --- /dev/null +++ b/Graphics/Gloss/Data/Point/Arithmetic.hs @@ -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') diff --git a/Graphics/Gloss/Data/Vector.hs b/Graphics/Gloss/Data/Vector.hs --- a/Graphics/Gloss/Data/Vector.hs +++ b/Graphics/Gloss/Data/Vector.hs @@ -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 #-} diff --git a/Graphics/Gloss/Data/ViewPort.hs b/Graphics/Gloss/Data/ViewPort.hs --- a/Graphics/Gloss/Data/ViewPort.hs +++ b/Graphics/Gloss/Data/ViewPort.hs @@ -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 #-} diff --git a/Graphics/Gloss/Data/ViewState.hs b/Graphics/Gloss/Data/ViewState.hs --- a/Graphics/Gloss/Data/ViewState.hs +++ b/Graphics/Gloss/Data/ViewState.hs @@ -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) } diff --git a/Graphics/Gloss/Geometry/Line.hs b/Graphics/Gloss/Geometry/Line.hs --- a/Graphics/Gloss/Geometry/Line.hs +++ b/Graphics/Gloss/Geometry/Line.hs @@ -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 diff --git a/Graphics/Gloss/Interface/Environment.hs b/Graphics/Gloss/Interface/Environment.hs --- a/Graphics/Gloss/Interface/Environment.hs +++ b/Graphics/Gloss/Interface/Environment.hs @@ -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) + diff --git a/Graphics/Gloss/Interface/IO/Animate.hs b/Graphics/Gloss/Interface/IO/Animate.hs --- a/Graphics/Gloss/Interface/IO/Animate.hs +++ b/Graphics/Gloss/Interface/IO/Animate.hs @@ -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 + diff --git a/Graphics/Gloss/Interface/IO/Display.hs b/Graphics/Gloss/Interface/IO/Display.hs --- a/Graphics/Gloss/Interface/IO/Display.hs +++ b/Graphics/Gloss/Interface/IO/Display.hs @@ -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 diff --git a/Graphics/Gloss/Interface/IO/Game.hs b/Graphics/Gloss/Interface/IO/Game.hs --- a/Graphics/Gloss/Interface/IO/Game.hs +++ b/Graphics/Gloss/Interface/IO/Game.hs @@ -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. diff --git a/Graphics/Gloss/Interface/IO/Interact.hs b/Graphics/Gloss/Interface/IO/Interact.hs new file mode 100644 --- /dev/null +++ b/Graphics/Gloss/Interface/IO/Interact.hs @@ -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 diff --git a/Graphics/Gloss/Interface/IO/Simulate.hs b/Graphics/Gloss/Interface/IO/Simulate.hs --- a/Graphics/Gloss/Interface/IO/Simulate.hs +++ b/Graphics/Gloss/Interface/IO/Simulate.hs @@ -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 () diff --git a/Graphics/Gloss/Interface/Pure/Animate.hs b/Graphics/Gloss/Interface/Pure/Animate.hs --- a/Graphics/Gloss/Interface/Pure/Animate.hs +++ b/Graphics/Gloss/Interface/Pure/Animate.hs @@ -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 ())) diff --git a/Graphics/Gloss/Interface/Pure/Game.hs b/Graphics/Gloss/Interface/Pure/Game.hs --- a/Graphics/Gloss/Interface/Pure/Game.hs +++ b/Graphics/Gloss/Interface/Pure/Game.hs @@ -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) diff --git a/Graphics/Gloss/Interface/Pure/Simulate.hs b/Graphics/Gloss/Interface/Pure/Simulate.hs --- a/Graphics/Gloss/Interface/Pure/Simulate.hs +++ b/Graphics/Gloss/Interface/Pure/Simulate.hs @@ -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 () - + diff --git a/Graphics/Gloss/Internals/Interface/Animate.hs b/Graphics/Gloss/Internals/Interface/Animate.hs --- a/Graphics/Gloss/Internals/Interface/Animate.hs +++ b/Graphics/Gloss/Internals/Interface/Animate.hs @@ -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 diff --git a/Graphics/Gloss/Internals/Interface/Animate/State.hs b/Graphics/Gloss/Internals/Interface/Animate/State.hs --- a/Graphics/Gloss/Internals/Interface/Animate/State.hs +++ b/Graphics/Gloss/Internals/Interface/Animate/State.hs @@ -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 } diff --git a/Graphics/Gloss/Internals/Interface/Animate/Timing.hs b/Graphics/Gloss/Internals/Interface/Animate/Timing.hs --- a/Graphics/Gloss/Internals/Interface/Animate/Timing.hs +++ b/Graphics/Gloss/Internals/Interface/Animate/Timing.hs @@ -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 } diff --git a/Graphics/Gloss/Internals/Interface/Backend.hs b/Graphics/Gloss/Internals/Interface/Backend.hs --- a/Graphics/Gloss/Internals/Interface/Backend.hs +++ b/Graphics/Gloss/Internals/Interface/Backend.hs @@ -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 diff --git a/Graphics/Gloss/Internals/Interface/Backend/GLFW.hs b/Graphics/Gloss/Internals/Interface/Backend/GLFW.hs --- a/Graphics/Gloss/Internals/Interface/Backend/GLFW.hs +++ b/Graphics/Gloss/Internals/Interface/Backend/GLFW.hs @@ -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 diff --git a/Graphics/Gloss/Internals/Interface/Backend/GLUT.hs b/Graphics/Gloss/Internals/Interface/Backend/GLUT.hs --- a/Graphics/Gloss/Internals/Interface/Backend/GLUT.hs +++ b/Graphics/Gloss/Internals/Interface/Backend/GLUT.hs @@ -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) diff --git a/Graphics/Gloss/Internals/Interface/Backend/Types.hs b/Graphics/Gloss/Internals/Interface/Backend/Types.hs --- a/Graphics/Gloss/Internals/Interface/Backend/Types.hs +++ b/Graphics/Gloss/Internals/Interface/Backend/Types.hs @@ -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 diff --git a/Graphics/Gloss/Internals/Interface/Common/Exit.hs b/Graphics/Gloss/Internals/Interface/Common/Exit.hs --- a/Graphics/Gloss/Internals/Interface/Common/Exit.hs +++ b/Graphics/Gloss/Internals/Interface/Common/Exit.hs @@ -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 () diff --git a/Graphics/Gloss/Internals/Interface/Debug.hs b/Graphics/Gloss/Internals/Interface/Debug.hs --- a/Graphics/Gloss/Internals/Interface/Debug.hs +++ b/Graphics/Gloss/Internals/Interface/Debug.hs @@ -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" diff --git a/Graphics/Gloss/Internals/Interface/Display.hs b/Graphics/Gloss/Internals/Interface/Display.hs --- a/Graphics/Gloss/Internals/Interface/Display.hs +++ b/Graphics/Gloss/Internals/Interface/Display.hs @@ -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 diff --git a/Graphics/Gloss/Internals/Interface/Event.hs b/Graphics/Gloss/Internals/Interface/Event.hs --- a/Graphics/Gloss/Internals/Interface/Event.hs +++ b/Graphics/Gloss/Internals/Interface/Event.hs @@ -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') diff --git a/Graphics/Gloss/Internals/Interface/Game.hs b/Graphics/Gloss/Internals/Interface/Game.hs --- a/Graphics/Gloss/Internals/Interface/Game.hs +++ b/Graphics/Gloss/Internals/Interface/Game.hs @@ -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 diff --git a/Graphics/Gloss/Internals/Interface/Interact.hs b/Graphics/Gloss/Internals/Interface/Interact.hs new file mode 100644 --- /dev/null +++ b/Graphics/Gloss/Internals/Interface/Interact.hs @@ -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 + diff --git a/Graphics/Gloss/Internals/Interface/Simulate.hs b/Graphics/Gloss/Internals/Interface/Simulate.hs --- a/Graphics/Gloss/Internals/Interface/Simulate.hs +++ b/Graphics/Gloss/Internals/Interface/Simulate.hs @@ -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 ] diff --git a/Graphics/Gloss/Internals/Interface/Simulate/Idle.hs b/Graphics/Gloss/Internals/Interface/Simulate/Idle.hs --- a/Graphics/Gloss/Internals/Interface/Simulate/Idle.hs +++ b/Graphics/Gloss/Internals/Interface/Simulate/Idle.hs @@ -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 - + diff --git a/Graphics/Gloss/Internals/Interface/Simulate/State.hs b/Graphics/Gloss/Internals/Interface/Simulate/State.hs --- a/Graphics/Gloss/Internals/Interface/Simulate/State.hs +++ b/Graphics/Gloss/Internals/Interface/Simulate/State.hs @@ -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 } - - + + diff --git a/Graphics/Gloss/Internals/Interface/ViewState/KeyMouse.hs b/Graphics/Gloss/Internals/Interface/ViewState/KeyMouse.hs --- a/Graphics/Gloss/Internals/Interface/ViewState/KeyMouse.hs +++ b/Graphics/Gloss/Internals/Interface/ViewState/KeyMouse.hs @@ -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 diff --git a/Graphics/Gloss/Internals/Interface/ViewState/Motion.hs b/Graphics/Gloss/Internals/Interface/ViewState/Motion.hs --- a/Graphics/Gloss/Internals/Interface/ViewState/Motion.hs +++ b/Graphics/Gloss/Internals/Interface/ViewState/Motion.hs @@ -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 diff --git a/gloss.cabal b/gloss.cabal --- a/gloss.cabal +++ b/gloss.cabal @@ -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