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

(+) ChangeLog, (^) Tip and Brush in Canvas

This commit is contained in:
Francesco 2022-07-31 16:33:36 +02:00
parent 49d6c34b38
commit bc9c76e466
3 changed files with 29 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

0
ChangeLog.md Normal file
View File

34
src/Canvas.hs
View File

@ -1,24 +1,44 @@
module Canvas where
import Graphics.Gloss.Data.Picture ( Picture (Text), pictures, scale )
import Graphics.Gloss.Interface.IO.Interact ( Event (EventKey), KeyState (Down), Key (Char) )
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) )
type Dimension = (Int, Int)
type TipSize = Float
data Canvas = Canvas {
items :: [Picture],
mode :: Mode
items :: [Picture]
, mode :: Mode
, drawing :: Bool
}
data Mode = Brush | Eraser deriving (Eq, Show)
newtype Tip = Shape TipSize
data Shape = Rectangular | Circular
windowSize :: Dimension
windowSize = (500, 500)
leftCornerize :: Picture -> Picture
leftCornerize = translate (fromIntegral $ (-(fst windowSize)) `div` 2 + (fst windowSize `div` 10))
(fromIntegral $ (snd windowSize) `div` 2 - (snd windowSize `div` 10))
showMode :: Canvas -> Picture
showMode canv = scale 0.1 0.1 $ Text ( show (mode canv))
showMode canv = leftCornerize
$ scale 0.15 0.15
$ Text ( show (mode canv))
render :: Canvas -> Picture
render canv = pictures ( showMode canv : items canv )
handle :: Event -> Canvas -> Canvas
handle (EventKey (Char 'b') Down _ _ ) canv = canv { mode = Brush }
handle (EventKey (Char 'e') Down _ _ ) canv = canv { mode = Eraser }
handle (EventKey (Char 'b') Down _ _ ) canv = canv { mode = Brush }
handle (EventKey (Char 'e') Down _ _ ) canv = canv { mode = Eraser }
handle (EventKey (MouseButton LeftButton) Down _ _ ) canv = canv { drawing = True }
handle (EventKey (MouseButton LeftButton) Up _ _ ) canv = canv { drawing = False }
handle _ canv = canv
update :: Float -> Canvas -> Canvas

3
src/Costants.hs
View File

@ -4,7 +4,7 @@ import Canvas
import Graphics.Gloss
display :: Display
display = InWindow "Amaranth" (500, 500) (0,0)
display = InWindow "Amaranth" windowSize (0,0)
background :: Color
background = white
@ -13,4 +13,5 @@ initial :: Canvas
initial = Canvas {
items = []
, mode = Brush
, drawing = False
}