gloss 1.1.1.0 → 1.2.0.0
raw patch · 40 files changed
+974/−646 lines, 40 filesdep ~containersPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: containers
API changes (from Hackage documentation)
- Graphics.Gloss: simulateInWindow :: String -> (Int, Int) -> (Int, Int) -> Color -> Int -> world -> (world -> Picture) -> (ViewPort -> Float -> world -> world) -> IO ()
- Graphics.Gloss.Color: addColors :: Color -> Color -> Color
- Graphics.Gloss.Color: aquamarine :: Color
- Graphics.Gloss.Color: azure :: Color
- Graphics.Gloss.Color: black :: Color
- Graphics.Gloss.Color: blue :: Color
- Graphics.Gloss.Color: bright :: Color -> Color
- Graphics.Gloss.Color: chartreuse :: Color
- Graphics.Gloss.Color: cyan :: Color
- Graphics.Gloss.Color: dark :: Color -> Color
- Graphics.Gloss.Color: data Color
- Graphics.Gloss.Color: dim :: Color -> Color
- Graphics.Gloss.Color: green :: Color
- Graphics.Gloss.Color: greyN :: Float -> Color
- Graphics.Gloss.Color: instance Eq Color
- Graphics.Gloss.Color: instance Show Color
- Graphics.Gloss.Color: light :: Color -> Color
- Graphics.Gloss.Color: magenta :: Color
- Graphics.Gloss.Color: makeColor :: Float -> Float -> Float -> Float -> Color
- Graphics.Gloss.Color: makeColor8 :: Int -> Int -> Int -> Int -> Color
- Graphics.Gloss.Color: mixColors :: Float -> Float -> Color -> Color -> Color
- Graphics.Gloss.Color: orange :: Color
- Graphics.Gloss.Color: red :: Color
- Graphics.Gloss.Color: rgbaOfColor :: Color -> (Float, Float, Float, Float)
- Graphics.Gloss.Color: rose :: Color
- Graphics.Gloss.Color: violet :: Color
- Graphics.Gloss.Color: white :: Color
- Graphics.Gloss.Color: yellow :: Color
- Graphics.Gloss.Data.QuadTree: instance (Show a) => Show (QuadTree a)
- Graphics.Gloss.Game: AdditionalButton :: Int -> MouseButton
- Graphics.Gloss.Game: Char :: Char -> Key
- Graphics.Gloss.Game: Down :: KeyState
- Graphics.Gloss.Game: EventKey :: Key -> KeyState -> Modifiers -> (Float, Float) -> Event
- Graphics.Gloss.Game: EventMotion :: (Float, Float) -> Event
- Graphics.Gloss.Game: KeyBegin :: SpecialKey
- Graphics.Gloss.Game: KeyDelete :: SpecialKey
- Graphics.Gloss.Game: KeyDown :: SpecialKey
- Graphics.Gloss.Game: KeyEnd :: SpecialKey
- Graphics.Gloss.Game: KeyF1 :: SpecialKey
- Graphics.Gloss.Game: KeyF10 :: SpecialKey
- Graphics.Gloss.Game: KeyF11 :: SpecialKey
- Graphics.Gloss.Game: KeyF12 :: SpecialKey
- Graphics.Gloss.Game: KeyF2 :: SpecialKey
- Graphics.Gloss.Game: KeyF3 :: SpecialKey
- Graphics.Gloss.Game: KeyF4 :: SpecialKey
- Graphics.Gloss.Game: KeyF5 :: SpecialKey
- Graphics.Gloss.Game: KeyF6 :: SpecialKey
- Graphics.Gloss.Game: KeyF7 :: SpecialKey
- Graphics.Gloss.Game: KeyF8 :: SpecialKey
- Graphics.Gloss.Game: KeyF9 :: SpecialKey
- Graphics.Gloss.Game: KeyHome :: SpecialKey
- Graphics.Gloss.Game: KeyInsert :: SpecialKey
- Graphics.Gloss.Game: KeyLeft :: SpecialKey
- Graphics.Gloss.Game: KeyNumLock :: SpecialKey
- Graphics.Gloss.Game: KeyPageDown :: SpecialKey
- Graphics.Gloss.Game: KeyPageUp :: SpecialKey
- Graphics.Gloss.Game: KeyRight :: SpecialKey
- Graphics.Gloss.Game: KeyUp :: SpecialKey
- Graphics.Gloss.Game: LeftButton :: MouseButton
- Graphics.Gloss.Game: MiddleButton :: MouseButton
- Graphics.Gloss.Game: Modifiers :: KeyState -> KeyState -> KeyState -> Modifiers
- Graphics.Gloss.Game: MouseButton :: MouseButton -> Key
- Graphics.Gloss.Game: RightButton :: MouseButton
- Graphics.Gloss.Game: SpecialKey :: SpecialKey -> Key
- Graphics.Gloss.Game: Up :: KeyState
- Graphics.Gloss.Game: WheelDown :: MouseButton
- Graphics.Gloss.Game: WheelUp :: MouseButton
- Graphics.Gloss.Game: alt :: Modifiers -> KeyState
- Graphics.Gloss.Game: ctrl :: Modifiers -> KeyState
- Graphics.Gloss.Game: data Event
- Graphics.Gloss.Game: data Key :: *
- Graphics.Gloss.Game: data KeyState :: *
- Graphics.Gloss.Game: data Modifiers :: *
- Graphics.Gloss.Game: data MouseButton :: *
- Graphics.Gloss.Game: data SpecialKey :: *
- Graphics.Gloss.Game: gameInWindow :: String -> (Int, Int) -> (Int, Int) -> Color -> Int -> world -> (world -> Picture) -> (Event -> world -> world) -> (Float -> world -> world) -> IO ()
- Graphics.Gloss.Game: shift :: Modifiers -> KeyState
- Graphics.Gloss.Geometry.Vector: angleVV :: Vector -> Vector -> Float
- Graphics.Gloss.Geometry.Vector: argV :: Vector -> Float
- Graphics.Gloss.Geometry.Vector: detV :: Vector -> Vector -> Float
- Graphics.Gloss.Geometry.Vector: dotV :: Vector -> Vector -> Float
- Graphics.Gloss.Geometry.Vector: instance Num (Float, Float)
- Graphics.Gloss.Geometry.Vector: magV :: Vector -> Float
- Graphics.Gloss.Geometry.Vector: mulSV :: Float -> Vector -> Vector
- Graphics.Gloss.Geometry.Vector: normaliseV :: Vector -> Vector
- Graphics.Gloss.Geometry.Vector: rotateV :: Float -> Vector -> Vector
- Graphics.Gloss.Geometry.Vector: unitVectorAtAngle :: Float -> Vector
- Graphics.Gloss.Picture: Blank :: Picture
- Graphics.Gloss.Picture: Circle :: Float -> Picture
- Graphics.Gloss.Picture: Color :: Color -> Picture -> Picture
- Graphics.Gloss.Picture: Line :: Path -> Picture
- Graphics.Gloss.Picture: Pictures :: [Picture] -> Picture
- Graphics.Gloss.Picture: Polygon :: Path -> Picture
- Graphics.Gloss.Picture: Rotate :: Float -> Picture -> Picture
- Graphics.Gloss.Picture: Scale :: Float -> Float -> Picture -> Picture
- Graphics.Gloss.Picture: Text :: String -> Picture
- Graphics.Gloss.Picture: ThickCircle :: Float -> Float -> Picture
- Graphics.Gloss.Picture: Translate :: Float -> Float -> Picture -> Picture
- Graphics.Gloss.Picture: data Picture
- Graphics.Gloss.Picture: instance Eq Picture
- Graphics.Gloss.Picture: instance Show Picture
- Graphics.Gloss.Picture: type Path = [Point]
- Graphics.Gloss.Picture: type Point = (Float, Float)
- Graphics.Gloss.Picture: type Vector = Point
- Graphics.Gloss.Shapes: lineLoop :: Path -> Picture
- Graphics.Gloss.Shapes: rectanglePath :: Float -> Float -> Path
- Graphics.Gloss.Shapes: rectangleSolid :: Float -> Float -> Picture
- Graphics.Gloss.Shapes: rectangleUpperPath :: Float -> Float -> Path
- Graphics.Gloss.Shapes: rectangleUpperSolid :: Float -> Float -> Picture
- Graphics.Gloss.Shapes: rectangleUpperWire :: Float -> Float -> Picture
- Graphics.Gloss.Shapes: rectangleWire :: Float -> Float -> Picture
- Graphics.Gloss.ViewPort: ViewPort :: (Float, Float) -> Float -> Float -> ViewPort
- Graphics.Gloss.ViewPort: data ViewPort
- Graphics.Gloss.ViewPort: viewPortInit :: ViewPort
- Graphics.Gloss.ViewPort: viewPortRotate :: ViewPort -> Float
- Graphics.Gloss.ViewPort: viewPortScale :: ViewPort -> Float
- Graphics.Gloss.ViewPort: viewPortTranslate :: ViewPort -> (Float, Float)
+ Graphics.Gloss.Data.Color: addColors :: Color -> Color -> Color
+ Graphics.Gloss.Data.Color: aquamarine :: Color
+ Graphics.Gloss.Data.Color: azure :: Color
+ Graphics.Gloss.Data.Color: black :: Color
+ Graphics.Gloss.Data.Color: blue :: Color
+ Graphics.Gloss.Data.Color: bright :: Color -> Color
+ Graphics.Gloss.Data.Color: chartreuse :: Color
+ Graphics.Gloss.Data.Color: cyan :: Color
+ Graphics.Gloss.Data.Color: dark :: Color -> Color
+ Graphics.Gloss.Data.Color: data Color
+ Graphics.Gloss.Data.Color: dim :: Color -> Color
+ Graphics.Gloss.Data.Color: green :: Color
+ Graphics.Gloss.Data.Color: greyN :: Float -> Color
+ Graphics.Gloss.Data.Color: instance Eq Color
+ Graphics.Gloss.Data.Color: instance Show Color
+ Graphics.Gloss.Data.Color: light :: Color -> Color
+ Graphics.Gloss.Data.Color: magenta :: Color
+ Graphics.Gloss.Data.Color: makeColor :: Float -> Float -> Float -> Float -> Color
+ Graphics.Gloss.Data.Color: makeColor8 :: Int -> Int -> Int -> Int -> Color
+ Graphics.Gloss.Data.Color: mixColors :: Float -> Float -> Color -> Color -> Color
+ Graphics.Gloss.Data.Color: orange :: Color
+ Graphics.Gloss.Data.Color: red :: Color
+ Graphics.Gloss.Data.Color: rgbaOfColor :: Color -> (Float, Float, Float, Float)
+ Graphics.Gloss.Data.Color: rose :: Color
+ Graphics.Gloss.Data.Color: violet :: Color
+ Graphics.Gloss.Data.Color: white :: Color
+ Graphics.Gloss.Data.Color: yellow :: Color
+ Graphics.Gloss.Data.Picture: Blank :: Picture
+ Graphics.Gloss.Data.Picture: Circle :: Float -> Picture
+ Graphics.Gloss.Data.Picture: Color :: Color -> Picture -> Picture
+ Graphics.Gloss.Data.Picture: Line :: Path -> Picture
+ Graphics.Gloss.Data.Picture: Pictures :: [Picture] -> Picture
+ Graphics.Gloss.Data.Picture: Polygon :: Path -> Picture
+ Graphics.Gloss.Data.Picture: Rotate :: Float -> Picture -> Picture
+ Graphics.Gloss.Data.Picture: Scale :: Float -> Float -> Picture -> Picture
+ Graphics.Gloss.Data.Picture: Text :: String -> Picture
+ Graphics.Gloss.Data.Picture: ThickCircle :: Float -> Float -> Picture
+ Graphics.Gloss.Data.Picture: Translate :: Float -> Float -> Picture -> Picture
+ Graphics.Gloss.Data.Picture: blank :: Picture
+ Graphics.Gloss.Data.Picture: circle :: Float -> Picture
+ Graphics.Gloss.Data.Picture: color :: Color -> Picture -> Picture
+ Graphics.Gloss.Data.Picture: data Picture
+ Graphics.Gloss.Data.Picture: instance Eq Picture
+ Graphics.Gloss.Data.Picture: instance Monoid Picture
+ Graphics.Gloss.Data.Picture: instance Show Picture
+ Graphics.Gloss.Data.Picture: line :: Path -> Picture
+ Graphics.Gloss.Data.Picture: lineLoop :: Path -> Picture
+ Graphics.Gloss.Data.Picture: pictures :: [Picture] -> Picture
+ Graphics.Gloss.Data.Picture: polygon :: Path -> Picture
+ Graphics.Gloss.Data.Picture: rectanglePath :: Float -> Float -> Path
+ Graphics.Gloss.Data.Picture: rectangleSolid :: Float -> Float -> Picture
+ Graphics.Gloss.Data.Picture: rectangleUpperPath :: Float -> Float -> Path
+ Graphics.Gloss.Data.Picture: rectangleUpperSolid :: Float -> Float -> Picture
+ Graphics.Gloss.Data.Picture: rectangleUpperWire :: Float -> Float -> Picture
+ Graphics.Gloss.Data.Picture: rectangleWire :: Float -> Float -> Picture
+ Graphics.Gloss.Data.Picture: rotate :: Float -> Picture -> Picture
+ Graphics.Gloss.Data.Picture: scale :: Float -> Float -> Picture -> Picture
+ Graphics.Gloss.Data.Picture: text :: String -> Picture
+ Graphics.Gloss.Data.Picture: thickCircle :: Float -> Float -> Picture
+ Graphics.Gloss.Data.Picture: translate :: Float -> Float -> Picture -> Picture
+ Graphics.Gloss.Data.Picture: type Path = [Point]
+ Graphics.Gloss.Data.Picture: type Point = (Float, Float)
+ Graphics.Gloss.Data.Picture: type Vector = Point
+ Graphics.Gloss.Data.Point: instance Num Point
+ Graphics.Gloss.Data.Point: pointInBox :: Point -> Point -> Point -> Bool
+ Graphics.Gloss.Data.Point: type Point = (Float, Float)
+ Graphics.Gloss.Data.QuadTree: instance Show a => Show (QuadTree a)
+ Graphics.Gloss.Data.Vector: angleVV :: Vector -> Vector -> Float
+ Graphics.Gloss.Data.Vector: argV :: Vector -> Float
+ Graphics.Gloss.Data.Vector: detV :: Vector -> Vector -> Float
+ Graphics.Gloss.Data.Vector: dotV :: Vector -> Vector -> Float
+ Graphics.Gloss.Data.Vector: magV :: Vector -> Float
+ Graphics.Gloss.Data.Vector: mulSV :: Float -> Vector -> Vector
+ Graphics.Gloss.Data.Vector: normaliseV :: Vector -> Vector
+ Graphics.Gloss.Data.Vector: rotateV :: Float -> Vector -> Vector
+ Graphics.Gloss.Data.Vector: type Vector = Point
+ Graphics.Gloss.Data.Vector: unitVectorAtAngle :: Float -> Vector
+ Graphics.Gloss.Geometry.Line: intersectLineLine :: Point -> Point -> Point -> Point -> Maybe Point
+ Graphics.Gloss.Geometry.Line: intersectSegHorzLine :: Point -> Point -> Float -> Maybe Point
+ Graphics.Gloss.Geometry.Line: intersectSegLine :: Point -> Point -> Point -> Point -> Maybe Point
+ Graphics.Gloss.Geometry.Line: intersectSegSeg :: Point -> Point -> Point -> Point -> Maybe Point
+ Graphics.Gloss.Geometry.Line: intersectSegVertLine :: Point -> Point -> Float -> Maybe Point
+ Graphics.Gloss.Geometry.Line: segClearsBox :: Point -> Point -> Point -> Point -> Bool
+ Graphics.Gloss.Interface.Game: AdditionalButton :: Int -> MouseButton
+ Graphics.Gloss.Interface.Game: Char :: Char -> Key
+ Graphics.Gloss.Interface.Game: Down :: KeyState
+ Graphics.Gloss.Interface.Game: EventKey :: Key -> KeyState -> Modifiers -> (Float, Float) -> Event
+ Graphics.Gloss.Interface.Game: EventMotion :: (Float, Float) -> Event
+ Graphics.Gloss.Interface.Game: KeyBegin :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyDelete :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyDown :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyEnd :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyF1 :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyF10 :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyF11 :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyF12 :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyF2 :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyF3 :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyF4 :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyF5 :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyF6 :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyF7 :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyF8 :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyF9 :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyHome :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyInsert :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyLeft :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyNumLock :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyPageDown :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyPageUp :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyRight :: SpecialKey
+ Graphics.Gloss.Interface.Game: KeyUp :: SpecialKey
+ Graphics.Gloss.Interface.Game: LeftButton :: MouseButton
+ Graphics.Gloss.Interface.Game: MiddleButton :: MouseButton
+ Graphics.Gloss.Interface.Game: Modifiers :: KeyState -> KeyState -> KeyState -> Modifiers
+ Graphics.Gloss.Interface.Game: MouseButton :: MouseButton -> Key
+ Graphics.Gloss.Interface.Game: RightButton :: MouseButton
+ Graphics.Gloss.Interface.Game: SpecialKey :: SpecialKey -> Key
+ Graphics.Gloss.Interface.Game: Up :: KeyState
+ Graphics.Gloss.Interface.Game: WheelDown :: MouseButton
+ Graphics.Gloss.Interface.Game: WheelUp :: MouseButton
+ Graphics.Gloss.Interface.Game: alt :: Modifiers -> KeyState
+ Graphics.Gloss.Interface.Game: ctrl :: Modifiers -> KeyState
+ Graphics.Gloss.Interface.Game: data Event
+ Graphics.Gloss.Interface.Game: data Key :: *
+ Graphics.Gloss.Interface.Game: data KeyState :: *
+ Graphics.Gloss.Interface.Game: data Modifiers :: *
+ Graphics.Gloss.Interface.Game: data MouseButton :: *
+ Graphics.Gloss.Interface.Game: data SpecialKey :: *
+ Graphics.Gloss.Interface.Game: gameInWindow :: String -> (Int, Int) -> (Int, Int) -> Color -> Int -> world -> (world -> Picture) -> (Event -> world -> world) -> (Float -> world -> world) -> IO ()
+ Graphics.Gloss.Interface.Game: shift :: Modifiers -> KeyState
+ Graphics.Gloss.Interface.Simulate: ViewPort :: (Float, Float) -> Float -> Float -> ViewPort
+ Graphics.Gloss.Interface.Simulate: data ViewPort
+ Graphics.Gloss.Interface.Simulate: simulateInWindow :: String -> (Int, Int) -> (Int, Int) -> Color -> Int -> model -> (model -> Picture) -> (ViewPort -> Float -> model -> model) -> IO ()
+ Graphics.Gloss.Interface.Simulate: viewPortRotate :: ViewPort -> Float
+ Graphics.Gloss.Interface.Simulate: viewPortScale :: ViewPort -> Float
+ Graphics.Gloss.Interface.Simulate: viewPortTranslate :: ViewPort -> (Float, Float)
Files
- Graphics/Gloss.hs +12/−14
- Graphics/Gloss/Algorithms/RayCast.hs +2/−2
- Graphics/Gloss/Color.hs +0/−184
- Graphics/Gloss/Data/Color.hs +182/−0
- Graphics/Gloss/Data/Extent.hs +6/−10
- Graphics/Gloss/Data/Picture.hs +165/−0
- Graphics/Gloss/Data/Point.hs +46/−0
- Graphics/Gloss/Data/QuadTree.hs +2/−2
- Graphics/Gloss/Data/Vector.hs +86/−0
- Graphics/Gloss/Game.hs +0/−18
- Graphics/Gloss/Geometry.hs +0/−2
- Graphics/Gloss/Geometry/Line.hs +211/−24
- Graphics/Gloss/Geometry/Vector.hs +0/−94
- Graphics/Gloss/Interface/Game.hs +16/−0
- Graphics/Gloss/Interface/Simulate.hs +17/−0
- Graphics/Gloss/Internals/Color.hs +1/−1
- Graphics/Gloss/Internals/Interface/Animate.hs +4/−4
- Graphics/Gloss/Internals/Interface/Animate/State.hs +1/−0
- Graphics/Gloss/Internals/Interface/Animate/Timing.hs +2/−2
- Graphics/Gloss/Internals/Interface/Common/Exit.hs +8/−6
- Graphics/Gloss/Internals/Interface/Debug.hs +1/−2
- Graphics/Gloss/Internals/Interface/Display.hs +3/−3
- Graphics/Gloss/Internals/Interface/Game.hs +36/−24
- Graphics/Gloss/Internals/Interface/Simulate.hs +10/−11
- Graphics/Gloss/Internals/Interface/Simulate/Idle.hs +6/−6
- Graphics/Gloss/Internals/Interface/Simulate/State.hs +1/−0
- Graphics/Gloss/Internals/Interface/ViewPort.hs +29/−0
- Graphics/Gloss/Internals/Interface/ViewPort/Command.hs +2/−2
- Graphics/Gloss/Internals/Interface/ViewPort/KeyMouse.hs +26/−17
- Graphics/Gloss/Internals/Interface/ViewPort/Motion.hs +28/−6
- Graphics/Gloss/Internals/Interface/ViewPort/Reshape.hs +3/−2
- Graphics/Gloss/Internals/Interface/Window.hs +28/−7
- Graphics/Gloss/Internals/Render/Circle.hs +12/−14
- Graphics/Gloss/Internals/Render/Options.hs +1/−0
- Graphics/Gloss/Internals/Render/Picture.hs +14/−9
- Graphics/Gloss/Internals/Render/ViewPort.hs +2/−2
- Graphics/Gloss/Picture.hs +0/−62
- Graphics/Gloss/Shapes.hs +0/−77
- Graphics/Gloss/ViewPort.hs +0/−29
- gloss.cabal +11/−10
Graphics/Gloss.hs view
@@ -19,33 +19,31 @@ -- -- * Zoom Viewport - mouse wheel, or page up\/down-keys. ----- Animations and simulations can be constructed similarly using the `animateInWindow` --- and `simulateInWindow` functions. +-- Animations can be constructed similarly using the `animateInWindow`. ----- If you want to manage your own key\/mouse events then use gameInWindow from the--- Graphics.Gloss.Game module.+-- If you want to run a simulation based around finite time steps then try+-- `simulateInWindow` from "Graphics.Gloss.Interface.Simulate". --+-- If you want to manage your own key\/mouse events then use `gameInWindow` from+-- "Graphics.Gloss.Interface.Game".+-- -- Gloss uses OpenGL under the hood, but you don't have to worry about any of that. -- -- @ -- Release Notes:--- Since 1.0.0.2:+-- For 1.1.0.0: -- Added game mode. -- Added QuadTree and Extent structures. -- Added simple ray casting. -- @ -- module Graphics.Gloss - ( module Graphics.Gloss.Picture- , module Graphics.Gloss.Color- , module Graphics.Gloss.ViewPort+ ( module Graphics.Gloss.Data.Picture+ , module Graphics.Gloss.Data.Color , displayInWindow - , animateInWindow- , simulateInWindow)+ , animateInWindow) where-import Graphics.Gloss.Picture-import Graphics.Gloss.Color-import Graphics.Gloss.ViewPort+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color import Graphics.Gloss.Internals.Interface.Display (displayInWindow) import Graphics.Gloss.Internals.Interface.Animate (animateInWindow)-import Graphics.Gloss.Internals.Interface.Simulate (simulateInWindow)
Graphics/Gloss/Algorithms/RayCast.hs view
@@ -5,7 +5,7 @@ ( castSegIntoCellularQuadTree , traceSegIntoCellularQuadTree) where-import Graphics.Gloss.Picture+import Graphics.Gloss.Data.Picture import Graphics.Gloss.Data.Quad import Graphics.Gloss.Data.Extent import Graphics.Gloss.Data.QuadTree@@ -32,7 +32,7 @@ castSegIntoCellularQuadTree p1 p2 extent tree | cells@(_:_) <- traceSegIntoCellularQuadTree p1 p2 extent tree- , c : _ <- sortBy ((compareDistanceTo p1) `on` (\(a, b, c) -> a) ) cells+ , c : _ <- sortBy ((compareDistanceTo p1) `on` (\(a, _, _) -> a) ) cells = Just c | otherwise
− Graphics/Gloss/Color.hs
@@ -1,184 +0,0 @@---- | Predefined and custom colors.-module Graphics.Gloss.Color- ( - -- ** Color data type- Color- , makeColor- , makeColor8- , rgbaOfColor-- -- ** Color functions- , mixColors- , addColors- , dim, bright- , light, dark-- -- ** Pre-defined colors- , greyN, black, white- -- *** Primary- , red, green, blue- -- *** Secondary- , yellow, cyan, magenta- - -- *** Tertiary- , rose, violet, azure, aquamarine, chartreuse, orange- )-where--import qualified Graphics.Rendering.OpenGL.GL as GL---- | An abstract color value.--- We keep the type abstract so we can be sure that the components--- are in the required range. To make a custom color use 'makeColor'.-data Color- -- | Holds the color components. All components lie in the range [0..1.- = RGBA Float Float Float Float- deriving (Show, Eq)----- | Make a custom color. All components are clamped to the range [0..1].-makeColor - :: Float -- ^ Red component.- -> Float -- ^ Green component.- -> Float -- ^ Blue component.- -> Float -- ^ Alpha component.- -> Color--makeColor r g b a- = clampColor - $ RGBA r g b a----- | Make a custom color. All components are clamped to the range [0..255].-makeColor8 - :: Int -- ^ Red component.- -> Int -- ^ Green component.- -> Int -- ^ Blue component.- -> Int -- ^ Alpha component.- -> Color--makeColor8 r g b a- = clampColor - $ RGBA (fromIntegral r / 255) - (fromIntegral g / 255)- (fromIntegral b / 255)- (fromIntegral a / 255)-- --- | Take the RGBA components of a color.-rgbaOfColor :: Color -> (Float, Float, Float, Float)-rgbaOfColor (RGBA r g b a) = (r, g, b, a)- ---- Internal ---- | Clamp components of a color into the required range.-clampColor :: Color -> Color-clampColor cc- = let (r, g, b, a) = rgbaOfColor cc- in RGBA (min 1 r) (min 1 g) (min 1 b) (min 1 a)---- | Normalise a color to the value of its largest RGB component.-normaliseColor :: Color -> Color-normaliseColor cc- = let (r, g, b, a) = rgbaOfColor cc- m = maximum [r, g, b]- in RGBA (r / m) (g / m) (b / m) a----- Color functions ---------------------------------------------------------------- | Mix two colors with the given ratios.-mixColors - :: Float -- ^ Ratio of first color.- -> Float -- ^ Ratio of second color.- -> Color -- ^ First color.- -> Color -- ^ Second color.- -> Color -- ^ Resulting color.--mixColors ratio1 ratio2 c1 c2- = let RGBA r1 g1 b1 a1 = c1- RGBA r2 g2 b2 a2 = c2-- total = ratio1 + ratio2- m1 = ratio1 / total- m2 = ratio2 / total-- in RGBA (m1 * r1 + m2 * r2)- (m1 * g1 + m2 * g2)- (m1 * b1 + m2 * b2)- (m1 * a1 + m2 * a2)----- | Add RGB components of a color component-wise, then normalise--- them to the highest resulting one. The alpha components are averaged.-addColors :: Color -> Color -> Color-addColors c1 c2- = let RGBA r1 g1 b1 a1 = c1- RGBA r2 g2 b2 a2 = c2-- in normaliseColor - $ RGBA (r1 + r2)- (g1 + g2)- (b1 + b2)- ((a1 + a2) / 2)----- | Make a dimmer version of a color, scaling towards black.-dim :: Color -> Color-dim (RGBA r g b a)- = RGBA (r / 1.2) (g / 1.2) (b / 1.2) a-- --- | Make a brighter version of a color, scaling towards white.-bright :: Color -> Color-bright (RGBA r g b a)- = clampColor- $ RGBA (r * 1.2) (g * 1.2) (b * 1.2) a----- | Lighten a color, adding white.-light :: Color -> Color-light (RGBA r g b a)- = clampColor- $ RGBA (r + 0.2) (g + 0.2) (b + 0.2) a- - --- | Darken a color, adding black.-dark :: Color -> Color-dark (RGBA r g b a)- = clampColor- $ RGBA (r - 0.2) (g - 0.2) (b - 0.2) a----- Pre-defined Colors ------------------------------------------------------------ | A greyness of a given magnitude.-greyN :: Float -- ^ Range is 0 = black, to 1 = white.- -> Color-greyN n = RGBA n n n 1.0--black, white :: Color-black = RGBA 0.0 0.0 0.0 1.0-white = RGBA 1.0 1.0 1.0 1.0---- Colors from the additive color wheel.-red, green, blue :: Color-red = RGBA 1.0 0.0 0.0 1.0-green = RGBA 0.0 1.0 0.0 1.0-blue = RGBA 0.0 0.0 1.0 1.0---- secondary-yellow, cyan, magenta :: Color-yellow = addColors red green-cyan = addColors green blue-magenta = addColors red blue---- tertiary-rose, violet, azure, aquamarine, chartreuse, orange :: Color-rose = addColors red magenta-violet = addColors magenta blue-azure = addColors blue cyan-aquamarine = addColors cyan green-chartreuse = addColors green yellow-orange = addColors yellow red
+ Graphics/Gloss/Data/Color.hs view
@@ -0,0 +1,182 @@++-- | Predefined and custom colors.+module Graphics.Gloss.Data.Color+ ( + -- ** Color data type+ Color+ , makeColor+ , makeColor8+ , rgbaOfColor++ -- ** Color functions+ , mixColors+ , addColors+ , dim, bright+ , light, dark++ -- ** Pre-defined colors+ , greyN, black, white+ -- *** Primary+ , red, green, blue+ -- *** Secondary+ , yellow, cyan, magenta+ + -- *** Tertiary+ , rose, violet, azure, aquamarine, chartreuse, orange+ )+where++-- | An abstract color value.+-- We keep the type abstract so we can be sure that the components+-- are in the required range. To make a custom color use 'makeColor'.+data Color+ -- | Holds the color components. All components lie in the range [0..1.+ = RGBA Float Float Float Float+ deriving (Show, Eq)+++-- | Make a custom color. All components are clamped to the range [0..1].+makeColor + :: Float -- ^ Red component.+ -> Float -- ^ Green component.+ -> Float -- ^ Blue component.+ -> Float -- ^ Alpha component.+ -> Color++makeColor r g b a+ = clampColor + $ RGBA r g b a+++-- | Make a custom color. All components are clamped to the range [0..255].+makeColor8 + :: Int -- ^ Red component.+ -> Int -- ^ Green component.+ -> Int -- ^ Blue component.+ -> Int -- ^ Alpha component.+ -> Color++makeColor8 r g b a+ = clampColor + $ RGBA (fromIntegral r / 255) + (fromIntegral g / 255)+ (fromIntegral b / 255)+ (fromIntegral a / 255)++ +-- | Take the RGBA components of a color.+rgbaOfColor :: Color -> (Float, Float, Float, Float)+rgbaOfColor (RGBA r g b a) = (r, g, b, a)+ ++-- Internal ++-- | Clamp components of a color into the required range.+clampColor :: Color -> Color+clampColor cc+ = let (r, g, b, a) = rgbaOfColor cc+ in RGBA (min 1 r) (min 1 g) (min 1 b) (min 1 a)++-- | Normalise a color to the value of its largest RGB component.+normaliseColor :: Color -> Color+normaliseColor cc+ = let (r, g, b, a) = rgbaOfColor cc+ m = maximum [r, g, b]+ in RGBA (r / m) (g / m) (b / m) a+++-- Color functions ------------------------------------------------------------++-- | Mix two colors with the given ratios.+mixColors + :: Float -- ^ Ratio of first color.+ -> Float -- ^ Ratio of second color.+ -> Color -- ^ First color.+ -> Color -- ^ Second color.+ -> Color -- ^ Resulting color.++mixColors ratio1 ratio2 c1 c2+ = let RGBA r1 g1 b1 a1 = c1+ RGBA r2 g2 b2 a2 = c2++ total = ratio1 + ratio2+ m1 = ratio1 / total+ m2 = ratio2 / total++ in RGBA (m1 * r1 + m2 * r2)+ (m1 * g1 + m2 * g2)+ (m1 * b1 + m2 * b2)+ (m1 * a1 + m2 * a2)+++-- | Add RGB components of a color component-wise, then normalise+-- them to the highest resulting one. The alpha components are averaged.+addColors :: Color -> Color -> Color+addColors c1 c2+ = let RGBA r1 g1 b1 a1 = c1+ RGBA r2 g2 b2 a2 = c2++ in normaliseColor + $ RGBA (r1 + r2)+ (g1 + g2)+ (b1 + b2)+ ((a1 + a2) / 2)+++-- | Make a dimmer version of a color, scaling towards black.+dim :: Color -> Color+dim (RGBA r g b a)+ = RGBA (r / 1.2) (g / 1.2) (b / 1.2) a++ +-- | Make a brighter version of a color, scaling towards white.+bright :: Color -> Color+bright (RGBA r g b a)+ = clampColor+ $ RGBA (r * 1.2) (g * 1.2) (b * 1.2) a+++-- | Lighten a color, adding white.+light :: Color -> Color+light (RGBA r g b a)+ = clampColor+ $ RGBA (r + 0.2) (g + 0.2) (b + 0.2) a+ + +-- | Darken a color, adding black.+dark :: Color -> Color+dark (RGBA r g b a)+ = clampColor+ $ RGBA (r - 0.2) (g - 0.2) (b - 0.2) a+++-- Pre-defined Colors ---------------------------------------------------------+-- | A greyness of a given magnitude.+greyN :: Float -- ^ Range is 0 = black, to 1 = white.+ -> Color+greyN n = RGBA n n n 1.0++black, white :: Color+black = RGBA 0.0 0.0 0.0 1.0+white = RGBA 1.0 1.0 1.0 1.0++-- Colors from the additive color wheel.+red, green, blue :: Color+red = RGBA 1.0 0.0 0.0 1.0+green = RGBA 0.0 1.0 0.0 1.0+blue = RGBA 0.0 0.0 1.0 1.0++-- secondary+yellow, cyan, magenta :: Color+yellow = addColors red green+cyan = addColors green blue+magenta = addColors red blue++-- tertiary+rose, violet, azure, aquamarine, chartreuse, orange :: Color+rose = addColors red magenta+violet = addColors magenta blue+azure = addColors blue cyan+aquamarine = addColors cyan green+chartreuse = addColors green yellow+orange = addColors yellow red
Graphics/Gloss/Data/Extent.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE PatternGuards #-} --- | Represents a rectangular area of the 2D plane.--- The bounds are represented as integers so that we can compare extents for equality.+-- | Represents an integral rectangular area of the 2D plane.+-- Using `Int`s (instead of `Float`s) for the bounds means we can safely compare extents for equality. module Graphics.Gloss.Data.Extent ( Extent , Coord@@ -19,7 +19,7 @@ , intersectSegExtent , touchesSegExtent) where-import Graphics.Gloss.Picture (Point)+import Graphics.Gloss.Data.Point import Graphics.Gloss.Data.Quad import Graphics.Gloss.Geometry.Line import Data.Maybe@@ -28,11 +28,7 @@ -- | A rectangular area of the 2D plane. -- We keep the type abstract to ensure that invalid extents cannot be constructed. data Extent- = Extent- { extentNorth :: Int- , extentSouth :: Int- , extentEast :: Int- , extentWest :: Int }+ = Extent Int Int Int Int deriving (Eq, Show) @@ -155,7 +151,7 @@ -- @ -- intersectSegExtent :: Point -> Point -> Extent -> Maybe Point-intersectSegExtent p1@(x1, y1) p2 extent@(Extent n' s' e' w')+intersectSegExtent p1@(x1, y1) p2 (Extent n' s' e' w') -- starts below extent | y1 < s , Just pos <- intersectSegHorzSeg p1 p2 s w e@@ -188,7 +184,7 @@ -- | Check whether a line segment's endpoints are inside an extent, or if it intersects with the boundary. touchesSegExtent :: Point -> Point -> Extent -> Bool-touchesSegExtent p1 p2 extent@(Extent n' s' e' w')+touchesSegExtent p1 p2 extent = pointInExtent extent p1 || pointInExtent extent p2 || isJust (intersectSegExtent p1 p2 extent)
+ Graphics/Gloss/Data/Picture.hs view
@@ -0,0 +1,165 @@++-- | Data types for representing pictures.+module Graphics.Gloss.Data.Picture+ ( Point+ , Vector+ , Path+ , Picture(..)++ -- * Aliases for Picture constructors+ , blank, polygon, line, circle, thickCircle, text+ , color, translate, rotate, scale+ , pictures++ -- * Line loops+ , lineLoop+ + -- * Rectangles+ , rectanglePath, rectangleWire, rectangleSolid+ , rectangleUpperPath, rectangleUpperWire, rectangleUpperSolid)+where+import Graphics.Gloss.Data.Color+import Graphics.Gloss.Data.Point+import Graphics.Gloss.Data.Vector+import Data.Monoid+++-- | A path through the x-y plane.+type Path = [Point] ++-- | A 2D picture+data Picture+ -- Primitives -------------------------------------++ -- | A blank picture, with nothing in it.+ = Blank++ -- | A polygon filled with a solid color.+ | Polygon Path+ + -- | A line along an arbitrary path.+ | Line Path++ -- | A circle with the given radius.+ | Circle Float++ -- | A circle with the given thickness and radius. If the thickness is 0 then this is equivalent to `Circle`.+ | ThickCircle Float Float++ -- | Some text to draw with a vector font.+ | Text String++ -- Color ------------------------------------------+ -- | A picture drawn with this color.+ | Color Color Picture++ -- Transforms -------------------------------------+ -- | A picture translated by the given x and y coordinates.+ | Translate Float Float Picture++ -- | A picture rotated by the given angle (in degrees).+ | Rotate Float Picture++ -- | A picture scaled by the given x and y factors.+ | Scale Float Float Picture++ -- More Pictures ----------------------------------++ -- | A picture consisting of several others.+ | Pictures [Picture]+ deriving (Show, Eq)+++-- Instances -------------------------------------------------------------------------------------+instance Monoid Picture where+ mempty = blank+ mappend a b = Pictures [a, b]+ mconcat = Pictures++++-- Constructors ----------------------------------------------------------------------------------+blank :: Picture+blank = Blank++polygon :: Path -> Picture+polygon = Polygon++line :: Path -> Picture+line = Line++circle :: Float -> Picture+circle = Circle++thickCircle :: Float -> Float -> Picture+thickCircle = ThickCircle++text :: String -> Picture+text = Text++color :: Color -> Picture -> Picture+color = Color++translate :: Float -> Float -> Picture -> Picture+translate = Translate++rotate :: Float -> Picture -> Picture+rotate = Rotate++scale :: Float -> Float -> Picture -> Picture+scale = Scale++pictures :: [Picture] -> Picture+pictures = Pictures+++-- Shapes ----------------------------------------------------------------------------------------+-- | A closed loop along this path.+lineLoop :: Path -> Picture+lineLoop [] = Line []+lineLoop (x:xs) = Line ((x:xs) ++ [x])+++-- | A path representing a rectangle centered about the origin,+-- with the given width and height.+rectanglePath :: Float -> Float -> Path+rectanglePath sizeX sizeY + = let sx = sizeX / 2+ sy = sizeY / 2+ in [(-sx, -sy), (-sx, sy), (sx, sy), (sx, -sy)]+++-- | A wireframe rectangle centered about the origin,+-- with the given width and height.+rectangleWire :: Float -> Float -> Picture+rectangleWire sizeX sizeY+ = lineLoop $ rectanglePath sizeX sizeY+++-- | A wireframe rectangle in the y > 0 half of the x-y plane,+-- with the given width and height.+rectangleUpperWire :: Float -> Float -> Picture+rectangleUpperWire sizeX sizeY+ = lineLoop $ rectangleUpperPath sizeX sizeY+++-- | A path representing a rectangle in the y > 0 half of the x-y plane,+-- with the given width and height+rectangleUpperPath :: Float -> Float -> Path+rectangleUpperPath sizeX sy+ = let sx = sizeX / 2+ in [(-sx, 0), (-sx, sy), (sx, sy), (sx, 0)]+++-- | A solid rectangle centered about the origin, +-- with the given width and height.+rectangleSolid :: Float -> Float -> Picture+rectangleSolid sizeX sizeY+ = Polygon $ rectanglePath sizeX sizeY+++-- | A sold rectangle in the y > 0 half of the x-y plane,+-- with the given width and height.+rectangleUpperSolid :: Float -> Float -> Picture+rectangleUpperSolid sizeX sizeY+ = Polygon $ rectangleUpperPath sizeX sizeY
+ Graphics/Gloss/Data/Point.hs view
@@ -0,0 +1,46 @@+{-# OPTIONS -fno-warn-missing-methods #-}+{-# LANGUAGE TypeSynonymInstances #-}+module Graphics.Gloss.Data.Point+ ( Point+ , pointInBox)+where++-- | A point on the x-y plane.+-- Points can also be treated as `Vector`s, so "Graphics.Gloss.Data.Vector" may also be useful.+type Point = (Float, Float) +++-- | Pretend a point is a number.+-- Vectors aren't real numbes according to Haskell, because they don't+-- support the multiply and divide field operators. We can pretend they+-- are though, and use the (+) and (-) operators as component-wise+-- addition and subtraction.+--+instance Num Point where+ (+) (x1, y1) (x2, y2) = (x1 + x2, y1 + y2)+ (-) (x1, y1) (x2, y2) = (x1 - x2, y1 - y2)+ negate (x, y) = (negate x, negate y) +++-- | Test whether a point lies within a rectangular box that is oriented+-- on the x-y plane. The points P1-P2 are opposing points of the box,+-- but need not be in a particular order.+--+-- @+-- P2 +-------++-- | |+-- | + P0 |+-- | |+-- +-------+ P1+-- @+--+pointInBox + :: Point + -> Point + -> Point -> Bool+ +pointInBox (x0, y0) (x1, y1) (x2, y2)+ = x0 >= min x1 x2+ && x0 <= max x1 x2+ && y0 >= min y1 y2+ && y0 <= max y1 y2
Graphics/Gloss/Data/QuadTree.hs view
@@ -86,7 +86,7 @@ -- If the path intersects an existing `TLeaf` then return the original tree. insertByPath :: [Quad] -> a -> QuadTree a -> QuadTree a -insertByPath [] x tree+insertByPath [] x _ = TLeaf x insertByPath (q:qs) x tree@@ -155,7 +155,7 @@ = case tree of TNil -> [] TLeaf x - -> let (n, s, e, w) = takeExtent extent+ -> let (_, s, _, w) = takeExtent extent in [((w, s), x)] TNode{} -> concat $ map (flattenQuad extent tree) allQuads
+ Graphics/Gloss/Data/Vector.hs view
@@ -0,0 +1,86 @@+{-# OPTIONS -fno-warn-missing-methods #-}+{-# LANGUAGE TypeSynonymInstances #-}++-- | Geometric functions concerning vectors.+module Graphics.Gloss.Data.Vector+ ( Vector+ , magV+ , argV+ , dotV+ , detV+ , mulSV+ , rotateV+ , angleVV+ , normaliseV+ , unitVectorAtAngle )+where+import Graphics.Gloss.Data.Point+import Graphics.Gloss.Geometry.Angle++-- | A vector can be treated as a point, and vis-versa.+type Vector = Point+++-- | The magnitude of a vector.+magV :: Vector -> Float+{-# INLINE magV #-}+magV (x, y) + = sqrt (x * x + y * y)++-- | The angle of this vector, relative to the +ve x-axis.+argV :: Vector -> Float+{-# INLINE argV #-}+argV (x, y)+ = normaliseAngle $ atan2 y x++-- | The dot product of two vectors.+dotV :: Vector -> Vector -> Float+{-# INLINE dotV #-}+dotV (x1, x2) (y1, y2)+ = x1 * y1 + x2 * y2++-- | The determinant of two vectors.+detV :: Vector -> Vector -> Float+{-# INLINE detV #-}+detV (x1, y1) (x2, y2)+ = x1 * y2 - y1 * x2++-- | Multiply a vector by a scalar.+mulSV :: Float -> Vector -> Vector+{-# INLINE mulSV #-}+mulSV s (x, y) + = (s * x, s * y)++-- | Rotate a vector by an angle (in radians). +ve angle is counter-clockwise.+rotateV :: Float -> Vector -> Vector+{-# INLINE rotateV #-}+rotateV r (x, y)+ = ( x * cos r - y * sin r+ , x * sin r + y * cos r)+++-- | Compute the inner angle (in radians) between two vectors.+angleVV :: Vector -> Vector -> Float+{-# INLINE angleVV #-}+angleVV p1 p2+ = let m1 = magV p1+ m2 = magV p2+ d = p1 `dotV` p2+ aDiff = acos $ d / (m1 * m2)++ in aDiff +++-- | Normalise a vector, so it has a magnitude of 1.+normaliseV :: Vector -> Vector+{-# INLINE normaliseV #-}+normaliseV v = mulSV (1 / magV v) v+++-- | Produce a unit vector at a given angle relative to the +ve x-axis.+-- The provided angle is in radians.+unitVectorAtAngle :: Float -> Vector+{-# INLINE unitVectorAtAngle #-}+unitVectorAtAngle r+ = (cos r, sin r)+
− Graphics/Gloss/Game.hs
@@ -1,18 +0,0 @@---- We export this stuff separately so we don't clutter up the --- API of the Graphics.Gloss module.---- | This game mode lets you manage your own input. Pressing ESC will still abort the program,--- but you don't get automatic pan and zoom controls like with `displayInWindow`.-module Graphics.Gloss.Game- ( module Graphics.Gloss.Picture- , module Graphics.Gloss.Color- , module Graphics.Gloss.ViewPort- , gameInWindow- , Event(..), Key(..), SpecialKey(..), MouseButton(..), KeyState(..), Modifiers(..))-where-import Graphics.Gloss.Picture-import Graphics.Gloss.Color-import Graphics.Gloss.ViewPort-import Graphics.Gloss.Internals.Interface.Game (gameInWindow, Event(..))-import Graphics.UI.GLUT.Callbacks.Window
Graphics/Gloss/Geometry.hs view
@@ -1,10 +1,8 @@ module Graphics.Gloss.Geometry ( module Graphics.Gloss.Geometry.Angle- , module Graphics.Gloss.Geometry.Vector , module Graphics.Gloss.Geometry.Line ) where import Graphics.Gloss.Geometry.Angle-import Graphics.Gloss.Geometry.Vector import Graphics.Gloss.Geometry.Line
Graphics/Gloss/Geometry/Line.hs view
@@ -1,15 +1,50 @@ {-# LANGUAGE PatternGuards #-} --- | Geometric functions concerning lines.+-- | Geometric functions concerning lines and segments.+--+-- A @Line@ is taken to be infinite in length, while a @Seg@ is finite length line segment represented by its two endpoints. module Graphics.Gloss.Geometry.Line- ( closestPointOnLine+ ( segClearsBox++ + -- * Closest points+ , closestPointOnLine , closestPointOnLineParam ++ -- * Line-Line intersection+ , intersectLineLine++ -- * Seg-Line intersection+ , intersectSegLine+ , intersectSegHorzLine+ , intersectSegVertLine++ -- * Seg-Seg intersection+ , intersectSegSeg , intersectSegHorzSeg , intersectSegVertSeg)+ where-import Graphics.Gloss.Picture (Point)-import Graphics.Gloss.Geometry.Vector+import Graphics.Gloss.Data.Point+import Graphics.Gloss.Data.Vector ++-- | Check if line segment (P1-P2) clears a box (P3-P4) by being well outside it.+segClearsBox + :: Point -- ^ P1 First point of segment. + -> Point -- ^ P2 Second point of segment.+ -> Point -- ^ P3 Lower left point of box.+ -> Point -- ^ P4 Upper right point of box.+ -> Bool++segClearsBox (x1, y1) (x2, y2) (xa, ya) (xb, yb)+ | x1 < xa, x2 < xa = True+ | x1 > xb, x2 > xb = True+ | y1 < ya, y2 < ya = True+ | y1 > yb, y2 > yb = True+ | otherwise = False++ -- | Given an infinite line which intersects `P1` and `P1`, -- return the point on that line that is closest to `P3` closestPointOnLine@@ -58,31 +93,181 @@ / (p2 - p1) `dotV` (p2 - p1) --- | Check if line segment (P1-P2) clears a box (P3-P4) by being well outside it.-segClearsBox - :: Point -- ^ P1 First point of segment. ++-- Line-Line intersection -------------------------------------------------------------------------++-- | Given four points specifying two lines, get the point where the two lines cross, if any.+-- Note that the lines extend off to infinity, so the intersection point might not lie+-- between either of the two pairs of points.+--+-- @+-- \\ /+-- P1 P4+-- \\ /+-- ++-- / \\+-- P3 P2+-- / \\+-- @+--+intersectLineLine + :: Point -- ^ `P1`+ -> Point -- ^ `P2`+ -> Point -- ^ `P3`+ -> Point -- ^ `P4`+ -> Maybe Point++intersectLineLine (x1, y1) (x2, y2) (x3, y3) (x4, y4)+ = let dx12 = x1 - x2+ dx34 = x3 - x4++ dy12 = y1 - y2+ dy34 = y3 - y4+ + den = dx12 * dy34 - dy12 * dx34++ in if den == 0+ then Nothing+ else let+ det12 = x1*y2 - y1*x2+ det34 = x3*y4 - y3*x4 ++ numx = det12 * dx34 - dx12 * det34+ numy = det12 * dy34 - dy12 * det34+ in Just (numx / den, numy / den)+++-- Segment-Line intersection ----------------------------------------------------------------------++-- | Get the point where a segment @P1-P2@ crosses an infinite line @P3-P4@, if any.+--+intersectSegLine+ :: Point -- ^ `P1`+ -> Point -- ^ `P2`+ -> Point -- ^ `P3`+ -> Point -- ^ `P4`+ -> Maybe Point++intersectSegLine p1 p2 p3 p4+ -- TODO: merge closest point check with intersection, reuse subterms.+ | Just p0 <- intersectLineLine p1 p2 p3 p4+ , t12 <- closestPointOnLineParam p1 p2 p0+ , t12 >= 0 && t12 <= 1+ = Just p0+ + | otherwise+ = Nothing+ ++-- | Get the point where a segment crosses a horizontal line, if any.+--+-- @ +-- + P1+-- /+-- -------+---------+-- / y0+-- P2 ++-- @+--+intersectSegHorzLine + :: Point -- ^ P1 First point of segment. -> Point -- ^ P2 Second point of segment.- -> Point -- ^ P3 Lower left point of box.- -> Point -- ^ P4 Upper right point of box.- -> Bool+ -> Float -- ^ y value of line.+ -> Maybe Point+intersectSegHorzLine (x1, y1) (x2, y2) y0+ + -- seg is on line+ | y1 == y0, y2 == y0 = Nothing+ + -- seg is above line+ | y1 > y0, y2 > y0 = Nothing+ + -- seg is below line+ | y1 < y0, y2 < y0 = Nothing+ + -- seg is a single point on the line.+ -- this should be caught by the first case, + -- but we'll test for it anyway.+ | y2 - y1 == 0 + = Just (x1, y1)+ + | otherwise + = Just ( (y0 - y1) * (x2 - x1) / (y2 - y1) + x1+ , y0) -segClearsBox (x1, y1) (x2, y2) (xa, ya) (xb, yb)- | x1 < xa, x2 < xa = True- | x1 > xb, x2 > xb = True- | y1 < ya, y2 < ya = True- | y1 > yb, y2 > yb = True- | otherwise = False +-- | Get the point where a segment crosses a vertical line, if any.+--+-- @+-- |+-- | + P1+-- | /+-- ++-- / |+-- P2 + |+-- | x0+-- @+--+intersectSegVertLine + :: Point -- ^ P1 First point of segment.+ -> Point -- ^ P2 Second point of segment.+ -> Float -- ^ x value of line.+ -> Maybe Point++intersectSegVertLine (x1, y1) (x2, y2) x0+ + -- seg is on line+ | x1 == x0, x2 == x0 = Nothing+ + -- seg is to right of line+ | x1 > x0, x2 > x0 = Nothing+ + -- seg is to left of line+ | x1 < x0, x2 < x0 = Nothing+ + -- seg is a single point on the line.+ -- this should be caught by the first case, + -- but we'll test for it anyway.+ | x2 - x1 == 0 + = Just (x1, y1)+ + | otherwise + = Just ( x0+ , (x0 - x1) * (y2 - y1) / (x2 - x1) + y1)+++-- Segment-Segment intersection -------------------------------------------------------------------++-- | Get the point where a segment @P1-P2@ crosses another segement @P3-P4@, if any.+intersectSegSeg+ :: Point -- ^ `P1`+ -> Point -- ^ `P2`+ -> Point -- ^ `P3`+ -> Point -- ^ `P4`+ -> Maybe Point++intersectSegSeg p1 p2 p3 p4+ -- TODO: merge closest point checks with intersection, reuse subterms.+ | Just p0 <- intersectLineLine p1 p2 p3 p4+ , t12 <- closestPointOnLineParam p1 p2 p0+ , t23 <- closestPointOnLineParam p3 p4 p0+ , t12 >= 0 && t12 <= 1+ , t23 >= 0 && t23 <= 1+ = Just p0+ + | otherwise+ = Nothing++ -- | Check if an arbitrary segment intersects a horizontal segment. -- -- @--- P2+-- + P2 -- /--- (xa, y3) ---+---- (xb, y3)+-- (xa, y3) +---+----+ (xb, y3) -- /--- /--- P1+-- P1 + -- @ intersectSegHorzSeg@@ -108,13 +293,13 @@ -- | Check if an arbitrary segment intersects a vertical segment. -- -- @--- (x3, yb)--- | P1+-- (x3, yb) ++-- | + P1 -- | / -- + -- / |--- P2 |--- (x3, ya)+-- P2 + |+-- + (x3, ya) -- @ intersectSegVertSeg@@ -135,3 +320,5 @@ where y0 | (x2 - x1) == 0 = y1 | otherwise = (x0 - x1) * (y2 - y1) / (x2 - x1) + y1++
− Graphics/Gloss/Geometry/Vector.hs
@@ -1,94 +0,0 @@-{-# OPTIONS -fno-warn-missing-methods #-}-{-# LANGUAGE FlexibleInstances #-}---- | Geometric functions concerning vectors.-module Graphics.Gloss.Geometry.Vector- ( magV- , argV- , dotV- , detV- , mulSV- , rotateV- , angleVV- , normaliseV- , unitVectorAtAngle )-where-import Graphics.Gloss.Picture (Vector)-import Graphics.Gloss.Geometry.Angle----- | Pretend a vector is a number.--- Vectors aren't real numbes according to Haskell, because they don't--- support the multiply and divide field operators. We can pretend they--- are though, and use the (+) and (-) operators as component-wise--- addition and subtraction.----instance Num (Float, Float) where- (+) (x1, y1) (x2, y2) = (x1 + x2, y1 + y2)- (-) (x1, y1) (x2, y2) = (x1 - x2, y1 - y2)- negate (x, y) = (negate x, negate y) ----- | The magnitude of a vector.-magV :: Vector -> Float-{-# INLINE magV #-}-magV (x, y) - = sqrt (x * x + y * y)---- | The angle of this vector, relative to the +ve x-axis.-argV :: Vector -> Float-{-# INLINE argV #-}-argV (x, y)- = normaliseAngle $ atan2 y x---- | The dot product of two vectors.-dotV :: Vector -> Vector -> Float-{-# INLINE dotV #-}-dotV (x1, x2) (y1, y2)- = x1 * y1 + x2 * y2---- | The determinant of two vectors.-detV :: Vector -> Vector -> Float-{-# INLINE detV #-}-detV (x1, y1) (x2, y2)- = x1 * y2 - y1 * x2---- | Multiply a vector by a scalar.-mulSV :: Float -> Vector -> Vector-{-# INLINE mulSV #-}-mulSV s (x, y) - = (s * x, s * y)---- | Rotate a vector by an angle (in radians). +ve angle is counter-clockwise.-rotateV :: Float -> Vector -> Vector-{-# INLINE rotateV #-}-rotateV r (x, y)- = ( x * cos r - y * sin r- , x * sin r + y * cos r)----- | Compute the inner angle (in radians) between two vectors.-angleVV :: Vector -> Vector -> Float-{-# INLINE angleVV #-}-angleVV p1@(x1, y1) p2@(x2, y2)- = let m1 = magV p1- m2 = magV p2- d = p1 `dotV` p2- aDiff = acos $ d / (m1 * m2)-- in aDiff ----- | Normalise a vector, so it has a magnitude of 1.-normaliseV :: Vector -> Vector-{-# INLINE normaliseV #-}-normaliseV v = mulSV (1 / magV v) v----- | Produce a unit vector at a given angle relative to the +ve x-axis.--- The provided angle is in radians.-unitVectorAtAngle :: Float -> Vector-{-# INLINE unitVectorAtAngle #-}-unitVectorAtAngle r- = (cos r, sin r)-
+ Graphics/Gloss/Interface/Game.hs view
@@ -0,0 +1,16 @@++-- We export this stuff separately so we don't clutter up the +-- API of the Graphics.Gloss module.++-- | This game mode lets you manage your own input. Pressing ESC will still abort the program,+-- but you don't get automatic pan and zoom controls like with `displayInWindow`.+module Graphics.Gloss.Interface.Game+ ( module Graphics.Gloss.Data.Picture+ , module Graphics.Gloss.Data.Color+ , gameInWindow+ , Event(..), Key(..), SpecialKey(..), MouseButton(..), KeyState(..), Modifiers(..))+where+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import Graphics.Gloss.Internals.Interface.Game (gameInWindow, Event(..))+import Graphics.UI.GLUT.Callbacks.Window
+ Graphics/Gloss/Interface/Simulate.hs view
@@ -0,0 +1,17 @@++-- We export this stuff separately so we don't clutter up the +-- API of the Graphics.Gloss module.++-- | Simulate mode is for producing an animation of some model who's picture+-- changes over finite time steps. The behavior of the model can also depent+-- on the current `ViewPort`.+module Graphics.Gloss.Interface.Simulate+ ( module Graphics.Gloss.Data.Picture+ , module Graphics.Gloss.Data.Color+ , ViewPort(..)+ , simulateInWindow)+where+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import Graphics.Gloss.Internals.Interface.ViewPort+import Graphics.Gloss.Internals.Interface.Simulate (simulateInWindow)
Graphics/Gloss/Internals/Color.hs view
@@ -2,7 +2,7 @@ module Graphics.Gloss.Internals.Color where -import Graphics.Gloss.Color+import Graphics.Gloss.Data.Color import qualified Graphics.Rendering.OpenGL.GL as GL import Unsafe.Coerce
Graphics/Gloss/Internals/Interface/Animate.hs view
@@ -3,13 +3,13 @@ module Graphics.Gloss.Internals.Interface.Animate (animateInWindow) where -import Graphics.Gloss.Color-import Graphics.Gloss.Picture-import Graphics.Gloss.ViewPort+import Graphics.Gloss.Data.Color+import Graphics.Gloss.Data.Picture import Graphics.Gloss.Internals.Render.Picture import Graphics.Gloss.Internals.Render.ViewPort import Graphics.Gloss.Internals.Interface.Window import Graphics.Gloss.Internals.Interface.Common.Exit+import Graphics.Gloss.Internals.Interface.ViewPort import Graphics.Gloss.Internals.Interface.ViewPort.KeyMouse import Graphics.Gloss.Internals.Interface.ViewPort.Motion import Graphics.Gloss.Internals.Interface.ViewPort.Reshape@@ -75,6 +75,6 @@ createWindow name size pos backColor callbacks -+getsIORef :: IORef a -> (a -> r) -> IO r getsIORef ref fun = liftM fun $ readIORef ref
Graphics/Gloss/Internals/Interface/Animate/State.hs view
@@ -38,6 +38,7 @@ , stateGateTimeElapsed :: Int } +stateInit :: State stateInit = State { stateAnimate = True
Graphics/Gloss/Internals/Interface/Animate/Timing.hs view
@@ -17,8 +17,7 @@ import Control.Concurrent import Data.IORef import qualified Graphics.UI.GLUT as GLUT-import qualified Graphics.Rendering.OpenGL.GL as GL-import Graphics.UI.GLUT (($=), get)+import Graphics.UI.GLUT (get) -- | Handles animation timing details.@@ -77,5 +76,6 @@ , stateGateTimeElapsed = gateTimeElapsed } +getsIORef :: IORef a -> (a -> r) -> IO r getsIORef ref fun = liftM fun $ readIORef ref
Graphics/Gloss/Internals/Interface/Common/Exit.hs view
@@ -5,17 +5,19 @@ module Graphics.Gloss.Internals.Interface.Common.Exit (callback_exit) where-import Graphics.Gloss.Internals.Interface.Callback-import qualified Graphics.UI.GLUT as GLUT-import qualified System.Exit as System+import Graphics.Gloss.Internals.Interface.Callback+import qualified Graphics.UI.GLUT as GLUT+import qualified System.Exit as System +callback_exit :: a -> Callback callback_exit stateRef = KeyMouse (keyMouse_exit stateRef) +keyMouse_exit :: a -> GLUT.KeyboardMouseCallback keyMouse_exit- stateRef- key keyState keyMods- pos+ _+ key keyState _+ _ -- exit | key == GLUT.Char '\27'
Graphics/Gloss/Internals/Interface/Debug.hs view
@@ -7,10 +7,9 @@ , dumpFramebufferState , dumpFragmentState ) where- import qualified Graphics.Rendering.OpenGL.GL as GL import qualified Graphics.UI.GLUT as GLUT-import Graphics.UI.GLUT (($=), get)+import Graphics.UI.GLUT (get) -- | Dump the internal state of GLUT
Graphics/Gloss/Internals/Interface/Display.hs view
@@ -3,13 +3,13 @@ module Graphics.Gloss.Internals.Interface.Display (displayInWindow) where -import Graphics.Gloss.Color-import Graphics.Gloss.Picture-import Graphics.Gloss.ViewPort+import Graphics.Gloss.Data.Color+import Graphics.Gloss.Data.Picture import Graphics.Gloss.Internals.Render.Picture import Graphics.Gloss.Internals.Render.ViewPort import Graphics.Gloss.Internals.Interface.Window import Graphics.Gloss.Internals.Interface.Common.Exit+import Graphics.Gloss.Internals.Interface.ViewPort import Graphics.Gloss.Internals.Interface.ViewPort.KeyMouse import Graphics.Gloss.Internals.Interface.ViewPort.Motion import Graphics.Gloss.Internals.Interface.ViewPort.Reshape
Graphics/Gloss/Internals/Interface/Game.hs view
@@ -1,25 +1,22 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE RankNTypes #-} {-# OPTIONS_HADDOCK hide #-} module Graphics.Gloss.Internals.Interface.Game ( gameInWindow , Event(..)) where-import Graphics.Gloss.Color-import Graphics.Gloss.Picture-import Graphics.Gloss.ViewPort+import Graphics.Gloss.Data.Color+import Graphics.Gloss.Data.Picture import Graphics.Gloss.Internals.Render.Picture import Graphics.Gloss.Internals.Render.ViewPort import Graphics.Gloss.Internals.Interface.Window import Graphics.Gloss.Internals.Interface.Callback import Graphics.Gloss.Internals.Interface.Common.Exit-import Graphics.Gloss.Internals.Interface.ViewPort.KeyMouse-import Graphics.Gloss.Internals.Interface.ViewPort.Motion+import Graphics.Gloss.Internals.Interface.ViewPort import Graphics.Gloss.Internals.Interface.ViewPort.Reshape import Graphics.Gloss.Internals.Interface.Animate.Timing import Graphics.Gloss.Internals.Interface.Simulate.Idle import qualified Graphics.Gloss.Internals.Interface.Callback as Callback-import qualified Graphics.Gloss.Internals.Interface.ViewPort.ControlState as VPC import qualified Graphics.Gloss.Internals.Interface.Simulate.State as SM import qualified Graphics.Gloss.Internals.Interface.Animate.State as AN import qualified Graphics.Gloss.Internals.Render.Options as RO@@ -70,7 +67,6 @@ -- make the initial GL view and render states viewSR <- newIORef viewPortInit- viewControlSR <- newIORef VPC.stateInit renderSR <- newIORef RO.optionsInit animateSR <- newIORef AN.stateInit @@ -118,18 +114,19 @@ callback_keyMouse worldRef viewRef eventFn = KeyMouse (handle_keyMouse worldRef viewRef eventFn) -handle_keyMouse worldRef viewRef eventFn key keyState keyMods pos- = do size@(GLUT.Size sizeX_ sizeY_) <- GL.get GLUT.windowSize- let (sizeX, sizeY) = (fromIntegral sizeX_, fromIntegral sizeY_) - let GLUT.Position px_ py_ = pos- let px = fromIntegral px_- let py = sizeY - fromIntegral py_- - let px' = px - sizeX / 2- let py' = py - sizeY / 2- let pos' = (px', py')- +handle_keyMouse + :: IORef a+ -> t+ -> (Event -> a -> a)+ -> GLUT.Key+ -> GLUT.KeyState+ -> GLUT.Modifiers+ -> GL.Position+ -> IO ()++handle_keyMouse worldRef _ eventFn key keyState keyMods pos+ = do pos' <- convertPoint pos worldRef `modifyIORef` \world -> eventFn (EventKey key keyState keyMods pos') world @@ -142,14 +139,29 @@ callback_motion worldRef eventFn = Motion (handle_motion worldRef eventFn) -handle_motion worldRef eventFn pos- = let GLUT.Position x y = pos- pos' = (fromIntegral x, fromIntegral y)- in worldRef `modifyIORef` \world -> eventFn (EventMotion pos') world -+handle_motion + :: IORef a+ -> (Event -> a -> a)+ -> GL.Position+ -> IO () +handle_motion worldRef eventFn pos+ = do pos' <- convertPoint pos+ worldRef `modifyIORef` \world -> eventFn (EventMotion pos') world +convertPoint :: GL.Position -> IO (Float,Float)+convertPoint pos+ = do (GLUT.Size sizeX_ sizeY_) <- GL.get GLUT.windowSize+ let (sizeX, sizeY) = (fromIntegral sizeX_, fromIntegral sizeY_) + let GLUT.Position px_ py_ = pos+ let px = fromIntegral px_+ let py = sizeY - fromIntegral py_+ + let px' = px - sizeX / 2+ let py' = py - sizeY / 2+ let pos' = (px', py')+ return pos'
Graphics/Gloss/Internals/Interface/Simulate.hs view
@@ -1,16 +1,16 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE RankNTypes #-} {-# OPTIONS_HADDOCK hide #-} module Graphics.Gloss.Internals.Interface.Simulate (simulateInWindow) where-import Graphics.Gloss.Color-import Graphics.Gloss.Picture-import Graphics.Gloss.ViewPort+import Graphics.Gloss.Data.Color+import Graphics.Gloss.Data.Picture import Graphics.Gloss.Internals.Render.Picture import Graphics.Gloss.Internals.Render.ViewPort import Graphics.Gloss.Internals.Interface.Window import Graphics.Gloss.Internals.Interface.Common.Exit+import Graphics.Gloss.Internals.Interface.ViewPort import Graphics.Gloss.Internals.Interface.ViewPort.KeyMouse import Graphics.Gloss.Internals.Interface.ViewPort.Motion import Graphics.Gloss.Internals.Interface.ViewPort.Reshape@@ -21,26 +21,25 @@ import qualified Graphics.Gloss.Internals.Interface.Simulate.State as SM import qualified Graphics.Gloss.Internals.Interface.Animate.State as AN import qualified Graphics.Gloss.Internals.Render.Options as RO-import qualified Graphics.UI.GLUT as GLUT import Data.IORef import System.Mem --- | Run a finite-time-step simulation in a window. You decide how the world is represented,--- how to convert the world to a picture, and how to advance the world for each unit of time. +-- | Run a finite-time-step simulation in a window. You decide how the model is represented,+-- how to convert the model to a picture, and how to advance the model for each unit of time. -- This function does the rest. -- -- Once the window is open you can use the same commands as with @displayInWindow@. -- simulateInWindow - :: forall world+ :: forall model . String -- ^ Name of the window. -> (Int, Int) -- ^ Initial size of the window, in pixels. -> (Int, Int) -- ^ Initial position of the window, in pixels. -> Color -- ^ Background color. -> Int -- ^ Number of simulation steps to take for each second of real time.- -> world -- ^ The initial world.- -> (world -> Picture) -- ^ A function to convert the world a picture.- -> (ViewPort -> Float -> world -> world) -- ^ A function to step the world one iteration. It is passed the + -> model -- ^ The initial model.+ -> (model -> Picture) -- ^ A function to convert the model to a picture.+ -> (ViewPort -> Float -> model -> model) -- ^ A function to step the model one iteration. It is passed the -- current viewport and the amount of time for this simulation -- step (in seconds). -> IO ()
Graphics/Gloss/Internals/Interface/Simulate/Idle.hs view
@@ -3,11 +3,11 @@ module Graphics.Gloss.Internals.Interface.Simulate.Idle ( callback_simulate_idle ) where-import Graphics.Gloss.ViewPort+import Graphics.Gloss.Internals.Interface.ViewPort import qualified Graphics.Gloss.Internals.Interface.Animate.State as AN import qualified Graphics.Gloss.Internals.Interface.Simulate.State as SM import qualified Graphics.UI.GLUT as GLUT-import Graphics.UI.GLUT (($=), get)+import Graphics.UI.GLUT (get) import Data.IORef import Control.Monad @@ -45,6 +45,7 @@ -- reset the world to +simulate_reset :: IORef SM.State -> IORef a -> a -> IO () simulate_reset simSR worldSR worldStart = do writeIORef worldSR worldStart @@ -65,7 +66,7 @@ -> (ViewPort -> Float -> world -> world) -> IO () -simulate_run simSR animateSR viewSR worldSR worldAdvance+simulate_run simSR _ viewSR worldSR worldAdvance = do simS <- readIORef simSR viewS <- readIORef viewSR@@ -103,7 +104,7 @@ -- keep advancing the world until we get to the final iteration number let (_, world') = - until (\(n, w) -> n >= nFinal)+ until (\(n, _) -> n >= nFinal) (\(n, w) -> (n+1, worldAdvance viewS timePerStep w)) (nStart, worldS) @@ -132,9 +133,7 @@ simulate_step simSR viewSR worldSR worldAdvance singleStepTime = do- simS <- readIORef simSR viewS <- readIORef viewSR- world <- readIORef worldSR let world' = worldAdvance viewS singleStepTime world @@ -146,5 +145,6 @@ GLUT.postRedisplay Nothing +getsIORef :: IORef a -> (a -> r) -> IO r getsIORef ref fun = liftM fun $ readIORef ref
Graphics/Gloss/Internals/Interface/Simulate/State.hs view
@@ -31,6 +31,7 @@ -- | Initial control state+stateInit :: Int -> State stateInit resolution = State { stateIteration = 0
+ Graphics/Gloss/Internals/Interface/ViewPort.hs view
@@ -0,0 +1,29 @@++-- | The 'ViewPort' represents the global transformation applied to the displayed picture.+-- When the user pans, zooms, or rotates the display then this changes the 'ViewPort'.+module Graphics.Gloss.Internals.Interface.ViewPort+ ( ViewPort(..)+ , viewPortInit )+where+ +data ViewPort+ = ViewPort { + -- | Global translation.+ viewPortTranslate :: (Float, Float)++ -- | Global rotation (in degrees).+ , viewPortRotate :: Float ++ -- | Global scaling (of both x and y coordinates).+ , viewPortScale :: Float + }+ + +-- | The initial state of the viewport.+viewPortInit :: ViewPort+viewPortInit+ = ViewPort+ { viewPortTranslate = (0, 0) + , viewPortRotate = 0+ , viewPortScale = 1 + }
Graphics/Gloss/Internals/Interface/ViewPort/Command.hs view
@@ -1,4 +1,5 @@ {-# OPTIONS_HADDOCK hide #-}+{-# OPTIONS -fno-warn-missing-signatures #-} {-# LANGUAGE PatternGuards #-} module Graphics.Gloss.Internals.Interface.ViewPort.Command@@ -6,7 +7,6 @@ , defaultCommandConfig , isCommand ) where-import Data.Map (Map) import qualified Graphics.UI.GLUT as GLUT import qualified Data.Map as Map @@ -89,7 +89,7 @@ | otherwise = False -isCommand2 c key keyMods cMatch+isCommand2 _ key keyMods cMatch | (keyC, mModsC) <- cMatch , keyC == key , case mModsC of
Graphics/Gloss/Internals/Interface/ViewPort/KeyMouse.hs view
@@ -4,9 +4,9 @@ module Graphics.Gloss.Internals.Interface.ViewPort.KeyMouse (callback_viewPort_keyMouse) where-import Graphics.Gloss.ViewPort+import Graphics.Gloss.Data.Vector import Graphics.Gloss.Geometry.Angle-import Graphics.Gloss.Geometry.Vector+import Graphics.Gloss.Internals.Interface.ViewPort import Graphics.Gloss.Internals.Interface.ViewPort.Command import Graphics.Gloss.Internals.Interface.Callback import qualified Graphics.Gloss.Internals.Interface.ViewPort.ControlState as VPC@@ -27,6 +27,15 @@ = KeyMouse (viewPort_keyMouse portRef controlRef) +viewPort_keyMouse+ :: IORef ViewPort+ -> IORef VPC.State+ -> GLUT.Key+ -> GLUT.KeyState+ -> GLUT.Modifiers+ -> GL.Position+ -> IO ()+ viewPort_keyMouse portRef controlRef key keyState keyMods pos = do commands <- controlRef `getsIORef` VPC.stateCommands @@ -34,13 +43,9 @@ ++ "keyMouse keyState = " ++ show keyState ++ "\n" ++ "keyMouse keyMods = " ++ show keyMods ++ "\n" -}- viewPort_keyMouse2 commands portRef controlRef key keyState keyMods pos- -viewPort_keyMouse2- commands portRef controlRef- key keyState keyMods- pos-+ viewPort_keyMouse2 commands+ where+ viewPort_keyMouse2 commands -- restore viewport | isCommand commands CRestore key keyMods , keyState == GLUT.Down@@ -65,22 +70,22 @@ -- bump left | isCommand commands CBumpLeft key keyMods , keyState == GLUT.Down- = motionBump portRef controlRef (20, 0)+ = motionBump portRef (20, 0) -- bump right | isCommand commands CBumpRight key keyMods , keyState == GLUT.Down- = motionBump portRef controlRef (-20, 0)+ = motionBump portRef (-20, 0) -- bump up | isCommand commands CBumpUp key keyMods , keyState == GLUT.Down- = motionBump portRef controlRef (0, 20)+ = motionBump portRef (0, 20) -- bump down | isCommand commands CBumpDown key keyMods , keyState == GLUT.Down- = motionBump portRef controlRef (0, -20)+ = motionBump portRef (0, -20) -- bump clockwise | isCommand commands CBumpClockwise key keyMods@@ -141,6 +146,7 @@ = return () +controlZoomIn :: IORef ViewPort -> IORef VPC.State -> IO () controlZoomIn portRef controlRef = do scaleStep <- controlRef `getsIORef` VPC.stateScaleStep portRef `modifyIORef` \s -> s { @@ -148,6 +154,7 @@ GLUT.postRedisplay Nothing +controlZoomOut :: IORef ViewPort -> IORef VPC.State -> IO () controlZoomOut portRef controlRef = do scaleStep <- controlRef `getsIORef` VPC.stateScaleStep portRef `modifyIORef` \s -> s {@@ -155,17 +162,18 @@ GLUT.postRedisplay Nothing +motionBump :: IORef ViewPort -> (Float, Float) -> IO () motionBump- portRef controlRef+ portRef (bumpX, bumpY) = do (transX, transY) <- portRef `getsIORef` viewPortTranslate - s <- portRef `getsIORef` viewPortScale+ scale <- portRef `getsIORef` viewPortScale r <- portRef `getsIORef` viewPortRotate - let offset = (bumpX / s, bumpY / s)+ let offset = (bumpX / scale, bumpY / scale) let (oX, oY) = rotateV (degToRad r) offset @@ -175,7 +183,8 @@ , transY + oY) } GLUT.postRedisplay Nothing- + +getsIORef :: IORef a -> (a -> r) -> IO r getsIORef ref fun = liftM fun $ readIORef ref
Graphics/Gloss/Internals/Interface/ViewPort/Motion.hs view
@@ -1,11 +1,12 @@ {-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE ScopedTypeVariables #-} module Graphics.Gloss.Internals.Interface.ViewPort.Motion (callback_viewPort_motion) where-import Graphics.Gloss.ViewPort+import Graphics.Gloss.Data.Vector import Graphics.Gloss.Geometry.Angle-import Graphics.Gloss.Geometry.Vector+import Graphics.Gloss.Internals.Interface.ViewPort import Graphics.Gloss.Internals.Interface.Callback import qualified Graphics.Gloss.Internals.Interface.ViewPort.ControlState as VPC import qualified Graphics.UI.GLUT as GLUT@@ -25,6 +26,12 @@ = Motion (viewPort_motion portRef controlRef) viewPort_motion+ :: IORef ViewPort+ -> IORef VPC.State+ -> GL.Position+ -> IO ()+ +viewPort_motion portRef controlRef pos = do@@ -51,21 +58,28 @@ pos ) +motionTranslate+ :: IORef ViewPort+ -> IORef VPC.State+ -> (GL.GLint, GL.GLint)+ -> GL.Position+ -> IO ()+ motionTranslate portRef controlRef- (markX, markY)+ (markX :: GL.GLint, markY :: GL.GLint) (GL.Position posX posY) = do (transX, transY) <- portRef `getsIORef` viewPortTranslate - s <- portRef `getsIORef` viewPortScale+ scale <- portRef `getsIORef` viewPortScale r <- portRef `getsIORef` viewPortRotate let dX = fromIntegral $ markX - posX let dY = fromIntegral $ markY - posY - let offset = (dX / s, dY / s)+ let offset = (dX / scale, dY / scale) let (oX, oY) = rotateV (degToRad r) offset @@ -81,9 +95,16 @@ GLUT.postRedisplay Nothing +motionRotate+ :: IORef ViewPort+ -> IORef VPC.State+ -> (GL.GLint, GL.GLint)+ -> GL.Position+ -> IO ()+ motionRotate portRef controlRef- (markX, markY)+ (markX :: GL.GLint, _markY :: GL.GLint) (GL.Position posX posY) = do rotate <- portRef `getsIORef` viewPortRotate@@ -100,5 +121,6 @@ GLUT.postRedisplay Nothing +getsIORef :: IORef a -> (a -> r) -> IO r getsIORef ref fun = liftM fun $ readIORef ref
Graphics/Gloss/Internals/Interface/ViewPort/Reshape.hs view
@@ -4,7 +4,7 @@ (callback_viewPort_reshape) where import Graphics.Gloss.Internals.Interface.Callback-import Graphics.UI.GLUT (($=), get)+import Graphics.UI.GLUT (($=)) import qualified Graphics.UI.GLUT as GLUT import qualified Graphics.Rendering.OpenGL.GL as GL @@ -12,10 +12,11 @@ -- | Callback to handle keyboard and mouse button events -- for controlling the viewport. callback_viewPort_reshape :: Callback- callback_viewPort_reshape = Reshape (viewPort_reshape) ++viewPort_reshape :: GL.Size -> IO () viewPort_reshape size = do -- Setup the viewport
Graphics/Gloss/Internals/Interface/Window.hs view
@@ -4,8 +4,7 @@ module Graphics.Gloss.Internals.Interface.Window ( createWindow ) where--import Graphics.Gloss.Color+import Graphics.Gloss.Data.Color import Graphics.Gloss.Internals.Color import Graphics.Gloss.Internals.Interface.Debug import Graphics.Gloss.Internals.Interface.Callback (Callback)@@ -29,8 +28,8 @@ createWindow windowName- size@(sizeX, sizeY) - pos @(posX, posY)+ (sizeX, sizeY) + (posX, posY) clearColor callbacks = do@@ -38,7 +37,7 @@ let debug = False -- Initialize GLUT- (progName, args) <- GLUT.getArgsAndInitialize+ (_progName, _args) <- GLUT.getArgsAndInitialize glutVersion <- get GLUT.glutVersion when debug@@ -76,7 +75,7 @@ when debug $ do putStr $ "* creating window\n\n" - GLUT.createWindow windowName+ _ <- GLUT.createWindow windowName GLUT.windowSize $= GL.Size (fromIntegral sizeX)@@ -123,7 +122,8 @@ return () -callbackDisplay clearColor callbacks+callbackDisplay :: t -> [Callback] -> IO ()+callbackDisplay _ callbacks = do -- clear the display GL.clear [GL.ColorBuffer, GL.DepthBuffer]@@ -139,20 +139,41 @@ return () +callbackReshape :: [Callback] -> GLUT.Size -> IO () callbackReshape callbacks size = sequence_ $ map (\f -> f size) [f | Callback.Reshape f <- callbacks] ++callbackKeyMouse+ :: [Callback]+ -> GLUT.Key+ -> GLUT.KeyState+ -> GLUT.Modifiers+ -> GLUT.Position+ -> IO ()+ callbackKeyMouse callbacks key keystate modifiers pos = sequence_ $ map (\f -> f key keystate modifiers pos) [f | Callback.KeyMouse f <- callbacks] ++callbackMotion+ :: [Callback]+ -> GLUT.Position+ -> IO ()+ callbackMotion callbacks pos = sequence_ $ map (\f -> f pos) [f | Callback.Motion f <- callbacks]+++callbackIdle+ :: [Callback]+ -> IO () callbackIdle callbacks = sequence_
Graphics/Gloss/Internals/Render/Circle.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS -fglasgow-exts #-}+{-# LANGUAGE BangPatterns, MagicHash, PatternGuards #-} {-# OPTIONS_HADDOCK hide #-} -- | Fast(ish) rendering of circles.@@ -7,9 +7,7 @@ import Graphics.Gloss.Internals.Render.Common import qualified Graphics.Rendering.OpenGL.GL as GL import GHC.Exts-import GHC.Prim - -- | Render a circle with the given thickness renderCircle :: Float -> Float -> Float -> Float -> Float -> IO () renderCircle posX posY scaleFactor radius thickness@@ -31,16 +29,6 @@ | otherwise = 40 --- | Render a circle as a line.-renderCircleLine :: Float -> Float -> Int -> Float -> IO ()-renderCircleLine (F# posX) (F# posY) steps (F# rad)- = let n = fromIntegral steps- !(F# tStep) = (2 * pi) / n- !(F# tStop) = (2 * pi)-- in GL.renderPrimitive GL.LineLoop- $ renderCircleLine_step posX posY tStep tStop rad 0.0#- renderCircleLine_step :: Float# -> Float# -> Float# -> Float# -> Float# -> Float# -> IO () renderCircleLine_step posX posY tStep tStop rad tt | tt `geFloat#` tStop@@ -53,7 +41,17 @@ (gf $ F# (posY `plusFloat#` (rad `timesFloat#` (sinFloat# tt)))) renderCircleLine_step posX posY tStep tStop rad (tt `plusFloat#` tStep)- ++-- | Render a circle as a line.+renderCircleLine :: Float -> Float -> Int -> Float -> IO ()+renderCircleLine (F# posX) (F# posY) steps (F# rad)+ = let n = fromIntegral steps+ !(F# tStep) = (2 * pi) / n+ !(F# tStop) = (2 * pi)++ in GL.renderPrimitive GL.LineLoop+ $ renderCircleLine_step posX posY tStep tStop rad 0.0#+ -- | Render a circle with a given thickness as a triangle strip renderCircleStrip :: Float -> Float -> Int -> Float -> Float -> IO ()
Graphics/Gloss/Internals/Render/Options.hs view
@@ -24,6 +24,7 @@ -- | Default render options+optionsInit :: Options optionsInit = Options { optionsColor = True
Graphics/Gloss/Internals/Render/Picture.hs view
@@ -5,19 +5,16 @@ module Graphics.Gloss.Internals.Render.Picture ( renderPicture ) where-import Graphics.Gloss.Picture-import Graphics.Gloss.Color-import Graphics.Gloss.ViewPort+import Graphics.Gloss.Data.Picture+import Graphics.Gloss.Data.Color+import Graphics.Gloss.Internals.Interface.ViewPort import Graphics.Gloss.Internals.Render.Options import Graphics.Gloss.Internals.Render.Common import Graphics.Gloss.Internals.Render.Circle import Graphics.UI.GLUT (($=), get)-import qualified Graphics.Rendering.OpenGL.GLU.Matrix as GLU import qualified Graphics.Rendering.OpenGL.GL as GL import qualified Graphics.UI.GLUT as GLUT -import Data.IORef-import Control.Monad -- ^ Render a picture using the given render options and viewport. renderPicture@@ -51,7 +48,13 @@ setBlendAlpha (optionsBlendAlpha renderS) drawPicture picture- ++drawPicture + :: ( ?modeWireframe::Bool+ , ?scale::Float+ , ?modeColor::Bool) + => Picture -> IO () + drawPicture picture = {-# SCC "drawComponent" #-} case picture of@@ -93,13 +96,13 @@ GL.blend $= GL.Enabled -- colors with float components.- Color color p+ Color col p | ?modeColor -> {-# SCC "draw.color" #-} do oldColor <- get GL.currentColor - let (r, g, b, a) = rgbaOfColor color+ let (r, g, b, a) = rgbaOfColor col GL.currentColor $= GL.Color4 (gf r) (gf g) (gf b) (gf a)@@ -149,6 +152,7 @@ -- Utils ------------------------------------------------------------------------------------------ -- | Turn alpha blending on or off+setBlendAlpha :: Bool -> IO () setBlendAlpha state | state = do GL.blend $= GL.Enabled@@ -159,6 +163,7 @@ GL.blendFunc $= (GL.One, GL.Zero) -- | Turn line smoothing on or off+setLineSmooth :: Bool -> IO () setLineSmooth state | state = GL.lineSmooth $= GL.Enabled | otherwise = GL.lineSmooth $= GL.Disabled
Graphics/Gloss/Internals/Render/ViewPort.hs view
@@ -5,7 +5,7 @@ module Graphics.Gloss.Internals.Render.ViewPort ( withViewPort ) where-import Graphics.Gloss.ViewPort+import Graphics.Gloss.Internals.Interface.ViewPort import Graphics.Rendering.OpenGL (GLfloat) import Graphics.UI.GLUT (($=), get) import qualified Graphics.UI.GLUT as GLUT@@ -25,7 +25,7 @@ $ do -- setup the co-ordinate system GL.loadIdentity- size@(GL.Size sizeX sizeY) + (GL.Size sizeX sizeY) <- get GLUT.windowSize let (sx, sy) = (fromIntegral sizeX / 2, fromIntegral sizeY / 2)
− Graphics/Gloss/Picture.hs
@@ -1,62 +0,0 @@---- | Data types for representing pictures.-module Graphics.Gloss.Picture- ( Point- , Vector- , Path- , Picture(..))-where--import Graphics.Gloss.Color---- | A point on the x-y plane.-type Point = (Float, Float) ---- | A vector can be treated as a point, and vis-versa.-type Vector = Point---- | A path through the x-y plane.-type Path = [Point] ---- | A 2D picture.-data Picture- -- Primitives --------------------------------------- -- | A blank picture, with nothing in it.- = Blank-- -- | A polygon filled with a solid color.- | Polygon Path- - -- | A line along an arbitrary path.- | Line Path-- -- | A circle with the given radius.- | Circle Float-- -- | A circle with the given thickness and radius. If the thickness is 0 then this is equivalent to `Circle`.- | ThickCircle Float Float-- -- | Some text to draw with a vector font.- | Text String-- -- Color ------------------------------------------- -- | A picture drawn with this color.- | Color Color Picture-- -- Transforms -------------------------------------- -- | A picture translated by the given x and y coordinates.- | Translate Float Float Picture-- -- | A picture rotated by the given angle (in degrees).- | Rotate Float Picture-- -- | A picture scaled by the given x and y factors.- | Scale Float Float Picture-- -- More Pictures ------------------------------------ -- | A picture consisting of several others.- | Pictures [Picture]- deriving (Show, Eq)-
− Graphics/Gloss/Shapes.hs
@@ -1,77 +0,0 @@---- | Functions for drawing shapes that aren't constructors of the `Picture` data type.-module Graphics.Gloss.Shapes- ( lineLoop- , rectangleWire, rectangleSolid, rectanglePath- , rectangleUpperWire, rectangleUpperSolid, rectangleUpperPath )-where-import Graphics.Gloss.Picture---- | A closed loop along this path.-lineLoop :: Path -> Picture-lineLoop [] = Line []-lineLoop (x:xs) = Line ((x:xs) ++ [x])----- Rectangles ---------------------------------------------------------------------------------------- | A wireframe rectangle centered about the origin.-rectangleWire - :: Float -- ^ width- -> Float -- ^ height- -> Picture-rectangleWire sizeX sizeY- = lineLoop $ rectanglePath sizeX sizeY----- | A solid rectangle centered about the origin.-rectangleSolid - :: Float -- ^ width- -> Float -- ^ height- -> Picture--rectangleSolid sizeX sizeY- = Polygon $ rectanglePath sizeX sizeY----- | A path representing a rectangle centered about the origin.-rectanglePath - :: Float -- ^ width- -> Float -- ^ height- -> Path--rectanglePath sizeX sizeY - = let sx = sizeX / 2- sy = sizeY / 2- in [(-sx, -sy), (-sx, sy), (sx, sy), (sx, -sy)]----- | A wireframe rectangle in the y > 0 half of the x-y plane.-rectangleUpperWire - :: Float -- ^ width- -> Float -- ^ height- -> Picture--rectangleUpperWire sizeX sizeY- = lineLoop $ rectangleUpperPath sizeX sizeY----- | A sold rectangle in the y > 0 half of the x-y plane.-rectangleUpperSolid - :: Float -- ^ width- -> Float -- ^ height- -> Picture--rectangleUpperSolid sizeX sizeY- = Polygon $ rectangleUpperPath sizeX sizeY----- | A path representing a rectangle in the y > 0 half of the x-y plane.-rectangleUpperPath - :: Float -- ^ width- -> Float -- ^ height- -> Path--rectangleUpperPath sizeX sy- = let sx = sizeX / 2- in [(-sx, 0), (-sx, sy), (sx, sy), (sx, 0)]-
− Graphics/Gloss/ViewPort.hs
@@ -1,29 +0,0 @@---- | The 'ViewPort' represents the global transformation applied to the displayed picture.--- When the user pans, zooms, or rotates the display then this changes the 'ViewPort'.-module Graphics.Gloss.ViewPort- ( ViewPort(..)- , viewPortInit )-where- -data ViewPort- = ViewPort { - -- | Global translation.- viewPortTranslate :: (Float, Float)-- -- | Global rotation (in degrees).- , viewPortRotate :: Float -- -- | Global scaling (of both x and y coordinates).- , viewPortScale :: Float - }- - --- | The initial state of the viewport.-viewPortInit :: ViewPort-viewPortInit- = ViewPort- { viewPortTranslate = (0, 0) - , viewPortRotate = 0- , viewPortScale = 1 - }
gloss.cabal view
@@ -1,9 +1,9 @@ Name: gloss-Version: 1.1.1.0+Version: 1.2.0.0 License: MIT License-file: LICENSE Author: Ben Lippmeier-Maintainer: gloss@ouroborus.net+Maintainer: benl@ouroborus.net Build-Type: Simple Cabal-Version: >=1.6 Stability: provisional@@ -24,27 +24,27 @@ Build-Depends: base == 4.*, ghc-prim == 0.2.*,- containers == 0.3.*,+ containers >= 0.3.0 && < 0.5.0, OpenGL == 2.4.*, GLUT == 2.2.* - ghc-options: -O2+ ghc-options: -O2 -Wall Exposed-modules: Graphics.Gloss- Graphics.Gloss.Game- Graphics.Gloss.Color- Graphics.Gloss.Picture- Graphics.Gloss.Shapes- Graphics.Gloss.ViewPort Graphics.Gloss.Geometry Graphics.Gloss.Geometry.Angle Graphics.Gloss.Geometry.Line- Graphics.Gloss.Geometry.Vector+ Graphics.Gloss.Data.Point+ Graphics.Gloss.Data.Vector Graphics.Gloss.Data.Quad Graphics.Gloss.Data.Extent Graphics.Gloss.Data.QuadTree+ Graphics.Gloss.Data.Color+ Graphics.Gloss.Data.Picture Graphics.Gloss.Algorithms.RayCast+ Graphics.Gloss.Interface.Simulate+ Graphics.Gloss.Interface.Game Other-modules: Graphics.Gloss.Internals.Color@@ -59,6 +59,7 @@ Graphics.Gloss.Internals.Interface.Simulate.Idle Graphics.Gloss.Internals.Interface.Simulate.State Graphics.Gloss.Internals.Interface.Game+ Graphics.Gloss.Internals.Interface.ViewPort Graphics.Gloss.Internals.Interface.ViewPort.Command Graphics.Gloss.Internals.Interface.ViewPort.ControlState Graphics.Gloss.Internals.Interface.ViewPort.KeyMouse