gloss-examples 1.3.2.2 → 1.4.0.1
raw patch · 4 files changed
+115/−21 lines, 4 filesdep ~glossdep ~vectornew-component:exe:gloss-drawnew-component:exe:gloss-gameevent
Dependency ranges changed: gloss, vector
Files
- Bitmap/Main.hs +3/−3
- Draw/Main.hs +62/−0
- GameEvent/Main.hs +17/−0
- gloss-examples.cabal +33/−18
Bitmap/Main.hs view
@@ -16,10 +16,10 @@ = do (bitmap, width, height) <- loadBitmap fileName displayInWindow fileName- (width * 3, height * 3)+ (width, height) (10, 10) white- (Scale 2 2 bitmap)+ (bitmap) loadBitmap :: FilePath -> IO (Picture, Int, Int)@@ -30,6 +30,6 @@ Right img -> let (width, height) = bmpDimensions img bytestring = unpackBMPToRGBA32 img- in return ( Bitmap width height bytestring+ in return ( Bitmap width height bytestring True , width, height)
+ Draw/Main.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE PatternGuards #-}+-- | Simple picture drawing application. +-- Like MSPaint, but you can only draw lines.+import Graphics.Gloss.Interface.Game+import Graphics.Gloss+import Data.Maybe (maybe)+import Debug.Trace++main + = do let state = State Nothing []+ gameInWindow+ "Draw"+ (600, 600)+ (0,0)+ white+ 100+ state+ makePicture+ handleEvent + stepWorld++-- | The game state.+data State + = State (Maybe Path) -- The current line being drawn.+ [Picture] -- All the lines drawn previously.++-- | A Line Segment+type Segment = ((Float, Float), (Float, Float))+++-- | Convert our state to a picture.+makePicture :: State -> Picture+makePicture (State m xs)+ = Pictures (maybe xs (\x -> Line x : xs) m)+++-- | Handle mouse click and motion events.+handleEvent :: Event -> State -> State+handleEvent event state+ -- If the mouse has moved, then extend the current line.+ | EventMotion (x, y) <- event+ , State (Just ps) ss <- state+ = State (Just ((x, y):ps)) ss ++ -- Start drawing a new line.+ | EventKey (MouseButton LeftButton) Down _ pt@(x,y) <- event+ , State Nothing ss <- state+ = State (Just [pt])+ ((Translate x y $ Scale 0.1 0.1 $ Text "Down") : ss)++ -- Finish drawing a line, and add it to the picture.+ | EventKey (MouseButton LeftButton) Up _ pt@(x,y) <- event+ , State (Just ps) ss <- state+ = State Nothing+ ((Translate x y $ Scale 0.1 0.1 $ Text "up") : Line (pt:ps) : ss)++ | otherwise+ = state+++stepWorld :: Float -> State -> State+stepWorld _ = id
+ GameEvent/Main.hs view
@@ -0,0 +1,17 @@++import Graphics.Gloss++-- | Display the last event received as text.+main+ = gameInWindow+ "GameEvent"+ (700, 100)+ (10, 10)+ white+ 100+ ""+ (\str -> Translate (-340) 0 $ Scale 0.1 0.1 $ Text str)+ (\event _ -> show event)+ (\_ world -> world)+ +
gloss-examples.cabal view
@@ -1,5 +1,5 @@ Name: gloss-examples-Version: 1.3.2.2+Version: 1.4.0.1 License: MIT License-file: LICENSE Author: Ben Lippmeier@@ -20,21 +20,21 @@ Executable gloss-easy Build-depends: base == 4.*,- gloss == 1.3.*+ gloss == 1.4.* Main-is: Easy/Main.hs ghc-options: -O2 Executable gloss-clock Build-depends: base == 4.*,- gloss == 1.3.*+ gloss == 1.4.* Main-is: Clock/Main.hs ghc-options: -O2 Executable gloss-eden Build-depends: base == 4.*,- gloss == 1.3.*,+ gloss == 1.4.*, random == 1.0.* Main-is: Main.hs other-modules: Cell Community World@@ -44,21 +44,21 @@ Executable gloss-flake Build-depends: base == 4.*,- gloss == 1.3.*+ gloss == 1.4.* Main-is: Flake/Main.hs ghc-options: -O2 Executable gloss-hello Build-depends: base == 4.*, - gloss == 1.3.*+ gloss == 1.4.* Main-is: Hello/Main.hs ghc-options: -O2 Executable gloss-lifespan Build-depends: base == 4.*, - gloss == 1.3.*, + gloss == 1.4.*, random == 1.0.* Main-is: Main.hs other-modules: Cell Community World@@ -68,7 +68,7 @@ Executable gloss-styrene Build-depends: base == 4.*,- gloss == 1.3.*,+ gloss == 1.4.*, containers >= 0.3 && <= 0.5, ghc-prim == 0.2.* Main-is: Main.hs@@ -79,38 +79,46 @@ Executable gloss-tree Build-depends: base == 4.*, - gloss == 1.3.*+ gloss == 1.4.* Main-is: Tree/Main.hs ghc-options: -O2 Executable gloss-zen Build-depends: base == 4.*, - gloss == 1.3.*+ gloss == 1.4.* Main-is: Zen/Main.hs ghc-options: -O2 Executable gloss-machina Build-depends: base == 4.*, - gloss == 1.3.*+ gloss == 1.4.* Main-is: Machina/Main.hs ghc-options: -O2 Executable gloss-conway Build-depends: base == 4.*,- gloss == 1.3.*,- vector == 0.7.*+ gloss == 1.4.*,+ vector >= 0.7 && < 1.0 Main-is: Main.hs other-modules: Cell World hs-source-dirs: Conway ghc-options: -O2 +Executable gloss-gameevent+ Build-depends: + base == 4.*,+ gloss == 1.4.*+ Main-is: Main.hs+ hs-source-dirs: GameEvent+ ghc-options: -O2+ Executable gloss-occlusion Build-depends: base == 4.*, - gloss == 1.3.*+ gloss == 1.4.* Main-is: Main.hs other-modules: Cell World State Data hs-source-dirs: Occlusion@@ -119,8 +127,8 @@ Executable gloss-visibility Build-depends: base == 4.*, - gloss == 1.3.*,- vector == 0.7.*+ gloss == 1.4.*,+ vector >= 0.7 && < 1.0 Main-is: Main.hs other-modules: Draw Interface State World Geometry.Randomish Geometry.Segment hs-source-dirs: Visibility @@ -129,7 +137,7 @@ Executable gloss-bitmap Build-depends: base == 4.*,- gloss == 1.3.*,+ gloss == 1.4.*, bytestring == 0.9.*, bmp == 1.1.* Main-is: Main.hs@@ -139,9 +147,16 @@ Executable gloss-boids Build-depends: base == 4.*,- gloss == 1.3.*+ gloss == 1.4.* Main-is: Main.hs other-modules: KDTree2d Vec2 hs-source-dirs: Boids ghc-options: -O2 +Executable gloss-draw+ Build-depends:+ base == 4.*,+ gloss == 1.4.*+ Main-is: Main.hs+ hs-source-dirs: Draw+ ghc-options: -O2