diff --git a/Bitmap/Main.hs b/Bitmap/Main.hs --- a/Bitmap/Main.hs +++ b/Bitmap/Main.hs @@ -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) diff --git a/Draw/Main.hs b/Draw/Main.hs new file mode 100644 --- /dev/null +++ b/Draw/Main.hs @@ -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 diff --git a/GameEvent/Main.hs b/GameEvent/Main.hs new file mode 100644 --- /dev/null +++ b/GameEvent/Main.hs @@ -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) + + diff --git a/gloss-examples.cabal b/gloss-examples.cabal --- a/gloss-examples.cabal +++ b/gloss-examples.cabal @@ -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