hotbrightsunshine
/
amaranth
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

(+) get mouse coordinates

This commit is contained in:
Francesco 2022-07-31 17:44:14 +02:00
parent bc9c76e466
commit f63e4697f1
2 changed files with 22 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
src/Canvas.hs
View File

@ -1,16 +1,18 @@
module Canvas where module Canvas where
import Graphics.Gloss.Data.Picture ( Picture (Text), pictures, scale, translate ) import Graphics.Gloss.Data.Picture ( Picture (Text), pictures, scale, translate )
import Graphics.Gloss.Interface.IO.Interact ( Event (EventKey), KeyState (Down, Up), Key (Char, MouseButton), MouseButton (LeftButton) ) import Graphics.Gloss.Interface.IO.Interact ( Event (EventKey, EventMotion), KeyState (Down, Up), Key (Char, MouseButton), MouseButton (LeftButton) )
type Dimension = (Int, Int) type Dimension = (Int, Int)
type Position = (Float, Float)
type TipSize = Float type TipSize = Float
data Canvas = Canvas { data Canvas = Canvas {
items :: [Picture] items :: [Picture]
, mode :: Mode , mode :: Mode
, drawing :: Bool , drawing :: Bool
, pos :: Position
, tip :: Tip
} }
data Mode = Brush | Eraser deriving (Eq, Show) data Mode = Brush | Eraser deriving (Eq, Show)
@ -26,20 +28,26 @@ leftCornerize :: Picture -> Picture
leftCornerize = translate (fromIntegral $ (-(fst windowSize)) `div` 2 + (fst windowSize `div` 10)) leftCornerize = translate (fromIntegral $ (-(fst windowSize)) `div` 2 + (fst windowSize `div` 10))
(fromIntegral $ (snd windowSize) `div` 2 - (snd windowSize `div` 10)) (fromIntegral $ (snd windowSize) `div` 2 - (snd windowSize `div` 10))
showMode :: Canvas -> Picture rightCornerize :: Picture -> Picture
showMode canv = leftCornerize rightCornerize = translate (fromIntegral $ (fst windowSize) `div` 2 - (fst windowSize `div` 5))
(fromIntegral $ (snd windowSize) `div` 2 - (snd windowSize `div` 10))
showInfo :: Canvas -> Picture
showInfo canv = leftCornerize
$ scale 0.15 0.15 $ scale 0.15 0.15
$ Text ( show (mode canv)) $ Text ( show (mode canv) ++ " - " ++ show (pos canv))
render :: Canvas -> Picture render :: Canvas -> Picture
render canv = pictures ( showMode canv : items canv ) render canv = pictures ( showInfo canv : items canv )
handle :: Event -> Canvas -> Canvas handle :: Event -> Canvas -> Canvas
handle (EventKey (Char 'b') Down _ _ ) canv = canv { mode = Brush } handle (EventKey (Char 'b') Down _ _ ) canv = canv { mode = Brush }
handle (EventKey (Char 'e') Down _ _ ) canv = canv { mode = Eraser } handle (EventKey (Char 'e') Down _ _ ) canv = canv { mode = Eraser }
handle (EventKey (MouseButton LeftButton) Down _ _ ) canv = canv { drawing = True } handle (EventKey (MouseButton LeftButton) Down _ mouse ) canv = canv { drawing = True }
handle (EventKey (MouseButton LeftButton) Up _ _ ) canv = canv { drawing = False } handle (EventKey (MouseButton LeftButton) Up _ mouse ) canv = canv { drawing = False }
handle (EventMotion (x, y)) canv = canv { pos = (x, y)}
handle _ canv = canv handle _ canv = canv
update :: Float -> Canvas -> Canvas update :: Float -> Canvas -> Canvas
update _ canv = canv update _ canv = canv

3
src/Costants.hs
View File

@ -3,6 +3,7 @@ module Costants where
import Canvas import Canvas
import Graphics.Gloss import Graphics.Gloss
display :: Display display :: Display
display = InWindow "Amaranth" windowSize (0,0) display = InWindow "Amaranth" windowSize (0,0)
@ -14,4 +15,6 @@ initial = Canvas {
items = [] items = []
, mode = Brush , mode = Brush
, drawing = False , drawing = False
, pos = (0, 0)
, tip = Rectangular 3
} }