(+) at least it's drawing

This commit is contained in:
Francesco 2022-07-31 18:58:13 +02:00
parent f63e4697f1
commit e21fab1c49
2 changed files with 20 additions and 12 deletions

View File

@ -1,6 +1,6 @@
module Canvas where module Canvas where
import Graphics.Gloss.Data.Picture ( Picture (Text), pictures, scale, translate ) import Graphics.Gloss.Data.Picture ( Picture (Text, Blank), pictures, scale, translate, rectangleSolid, circle )
import Graphics.Gloss.Interface.IO.Interact ( Event (EventKey, EventMotion), 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)
@ -17,10 +17,18 @@ data Canvas = Canvas {
data Mode = Brush | Eraser deriving (Eq, Show) data Mode = Brush | Eraser deriving (Eq, Show)
newtype Tip = Shape TipSize data Tip = Tip {
shape :: Shape
, size :: TipSize
}
data Shape = Rectangular | Circular data Shape = Rectangular | Circular
nextPicture :: Canvas -> Picture
nextPicture (Canvas _ Brush True position (Tip Rectangular size)) = uncurry translate position $ rectangleSolid size size
nextPicture (Canvas _ Brush True position (Tip Circular size)) = uncurry translate position $ circle size
nextPicture _ = Blank
windowSize :: Dimension windowSize :: Dimension
windowSize = (500, 500) windowSize = (500, 500)
@ -49,5 +57,5 @@ 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 { items = nextPicture canv : items canv }

View File

@ -16,5 +16,5 @@ initial = Canvas {
, mode = Brush , mode = Brush
, drawing = False , drawing = False
, pos = (0, 0) , pos = (0, 0)
, tip = Rectangular 3 , tip = Tip Rectangular 3
} }