45 lines
1.4 KiB
Haskell
45 lines
1.4 KiB
Haskell
module Canvas where
|
|
|
|
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
|
|
, 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 = 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 (MouseButton LeftButton) Down _ _ ) canv = canv { drawing = True }
|
|
handle (EventKey (MouseButton LeftButton) Up _ _ ) canv = canv { drawing = False }
|
|
handle _ canv = canv
|
|
|
|
update :: Float -> Canvas -> Canvas
|
|
update _ canv = canv |