git.iko.soy/Idris-dev
on fd5dfd9 help sign in
Idris-dev/samples/ST/Graphics/Draw.idr
88 lines 2.2 kB history raw
1module Draw
3import public Graphics.SDL
4import Control.ST
5import Control.ST.ImplicitCall
7%access public export
9data Col = MkCol Int Int Int Int
11black : Col
12black = MkCol 0 0 0 255
14red : Col
15red = MkCol 255 0 0 255
17green : Col
18green = MkCol 0 255 0 255
20blue : Col
21blue = MkCol 0 0 255 255
23cyan : Col
24cyan = MkCol 0 255 255 255
26magenta : Col
27magenta = MkCol 255 0 255 255
29yellow : Col
30yellow = MkCol 255 255 0 255
32white : Col
33white = MkCol 255 255 255 255
35interface Draw (m : Type -> Type) where
36 Surface : Type
38 initWindow : Int -> Int -> ST m (Maybe Var) [addIfJust Surface]
39 closeWindow : (win : Var) -> ST m () [remove win Surface]
41 flip : (win : Var) -> ST m () [win ::: Surface]
42 poll : ST m (Maybe Event) []
44 filledRectangle : (win : Var) -> (Int, Int) -> (Int, Int) -> Col ->
45 ST m () [win ::: Surface]
46 drawLine : (win : Var) -> (Int, Int) -> (Int, Int) -> Col ->
47 ST m () [win ::: Surface]
50Draw IO where
51 Surface = State SDLSurface
53 initWindow x y = do Just srf <- lift (startSDL x y)
54 | pure Nothing
55 var <- new srf
56 pure (Just var)
58 closeWindow win = do lift endSDL
59 delete win
61 flip win = do srf <- read win
62 lift (flipBuffers srf)
63 poll = lift pollEvent
65 filledRectangle win (x, y) (ex, ey) (MkCol r g b a)
66 = do srf <- read win
67 lift $ filledRect srf x y ex ey r g b a
68 drawLine win (x, y) (ex, ey) (MkCol r g b a)
69 = do srf <- read win
70 lift $ drawLine srf x y ex ey r g b a
72render : Draw m => (win : Var) -> ST m () [win ::: Surface {m}]
73render win = do filledRectangle win (0,0) (640,480) black
74 drawLine win (100,100) (200,200) red
75 flip win
77loop : Draw m => (win : Var) -> ST m () [win ::: Surface {m}]
78loop win = do render win
79 Just AppQuit <- poll
80 | _ => loop win
81 pure ()
83drawMain : (ConsoleIO m, Draw m) => ST m () []
84drawMain = do Just win <- initWindow 640 480
85 | Nothing => putStrLn "Can't open window"
86 loop win
87 closeWindow win