module Canvas where 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 data Canvas = Canvas { items :: [Picture] , mode :: Mode , drawing :: Bool , pos :: Position , tip :: Tip } data Mode = Brush | Eraser deriving (Eq, Show) data Tip = Tip { shape :: Shape , size :: TipSize } 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)) (fromIntegral $ (snd windowSize) `div` 2 - (snd windowSize `div` 10)) 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 $ Text ( show (mode canv) ++ " - " ++ show (pos canv)) render :: Canvas -> Picture render canv = pictures ( showInfo 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 (MouseButton LeftButton) Down _ mouse ) canv = canv { drawing = True } handle (EventKey (MouseButton LeftButton) Up _ mouse ) canv = canv { drawing = False } handle (EventMotion (x, y)) canv = canv { pos = (x, y)} handle _ canv = canv update :: Float -> Canvas -> Canvas update _ canv = canv { items = nextPicture canv : items canv }