diff --git a/src/Canvas.hs b/src/Canvas.hs index ed774c6..3a02990 100644 --- a/src/Canvas.hs +++ b/src/Canvas.hs @@ -1,11 +1,11 @@ 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) ) type Dimension = (Int, Int) type Position = (Float, Float) -type TipSize = Float +type TipSize = Float data Canvas = Canvas { items :: [Picture] @@ -17,28 +17,36 @@ data Canvas = Canvas { 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 = (500, 500) -leftCornerize :: Picture -> Picture -leftCornerize = translate (fromIntegral $ (-(fst windowSize)) `div` 2 + (fst windowSize `div` 10)) +leftCornerize :: Picture -> Picture +leftCornerize = translate (fromIntegral $ (-(fst windowSize)) `div` 2 + (fst windowSize `div` 10)) (fromIntegral $ (snd windowSize) `div` 2 - (snd windowSize `div` 10)) -rightCornerize :: Picture -> Picture -rightCornerize = translate (fromIntegral $ (fst windowSize) `div` 2 - (fst windowSize `div` 5)) +rightCornerize :: Picture -> Picture +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) ++ " - " ++ show (pos canv)) render :: Canvas -> Picture -render canv = pictures ( showInfo canv : items canv ) +render canv = pictures ( showInfo canv : items canv ) handle :: Event -> Canvas -> Canvas handle (EventKey (Char 'b') Down _ _ ) canv = canv { mode = Brush } @@ -49,5 +57,5 @@ handle (EventMotion (x, y)) canv = canv { pos = (x, y)} handle _ canv = canv update :: Float -> Canvas -> Canvas -update _ canv = canv +update _ canv = canv { items = nextPicture canv : items canv } diff --git a/src/Costants.hs b/src/Costants.hs index 681931b..bb6cc7a 100644 --- a/src/Costants.hs +++ b/src/Costants.hs @@ -16,5 +16,5 @@ initial = Canvas { , mode = Brush , drawing = False , pos = (0, 0) -, tip = Rectangular 3 +, tip = Tip Rectangular 3 } \ No newline at end of file