git.iko.soy/Idris-dev
on fd5dfd9 help sign in
Idris-dev/samples/ST/Graphics/Turtle.idr
116 lines 4.1 kB history raw
1module Main
3import Control.ST
4import Control.ST.ImplicitCall
5import Draw
7interface TurtleGraphics (m : Type -> Type) where
8 Turtle : Type
10 start : Int -> Int -> ST m (Maybe Var) [addIfJust Turtle]
11 end : (t : Var) -> ST m () [Remove t Turtle]
13 fd : (t : Var) -> Int -> ST m () [t ::: Turtle]
14 rt : (t : Var) -> Int -> ST m () [t ::: Turtle]
16 penup : (t : Var) -> ST m () [t ::: Turtle]
17 pendown : (t : Var) -> ST m () [t ::: Turtle]
18 col : (t : Var) -> Col -> ST m () [t ::: Turtle]
20 -- Render the picture drawn so far in a window, and wait for a key press
21 render : (t : Var) -> ST m () [t ::: Turtle]
23Line : Type
24Line = ((Int, Int), (Int, Int), Col)
26-- Implement turtle graphics in terms of existing stateful systems;
27-- 'Draw' provides a Surface to draw on, and three states.
28Draw m => TurtleGraphics m where
29 Turtle = Composite [Surface {m}, -- surface to draw on
30 State Col, -- pen colour
31 State (Int, Int, Int, Bool), -- pen location/direction/down
32 State (List Line)] -- lines to draw on render
34 start x y = with ST do
35 Just srf <- initWindow x y
36 | Nothing => pure Nothing
37 col <- new white
38 pos <- new (320, 200, 0, True)
39 lines <- new []
40 turtle <- new ()
41 combine turtle [srf, col, pos, lines]
42 pure (Just turtle)
44 end t = do [srf, col, pos, lines] <- split t
45 closeWindow srf; delete col; delete pos; delete lines; delete t
47 fd t dist = with ST do
48 [srf, col, pos, lines] <- split t
49 (x, y, d, p) <- read pos
50 let x' = cast x + cast dist * sin (rad d)
51 let y' = cast y + cast dist * cos (rad d)
52 c <- read col
53 ls <- read lines
54 write lines (if p then ((x, y), (cast x', cast y'), c) :: ls
55 else ls)
56 write pos (cast x', cast y', d, p)
57 combine t [srf, col, pos, lines]
58 where rad : Int -> Double
59 rad x = (cast x * pi) / 180.0
61 rt t angle = with ST do
62 [srf, col, pos, lines] <- split t
63 (x, y, d, p) <- read pos
64 write pos (x, y, d + angle `mod` 360, p)
65 combine t [srf, col, pos, lines]
67 penup t = with ST do
68 [srf, col, pos, lines] <- split t
69 (x, y, d, _) <- read pos
70 write pos (x, y, d, False)
71 combine t [srf, col, pos, lines]
72 pendown t = with ST do
73 [srf, col, pos, lines] <- split t
74 (x, y, d, _) <- read pos
75 write pos (x, y, d, True)
76 combine t [srf, col, pos, lines]
77 col t c = with ST do
78 [srf, col, pos, lines] <- split t
79 write col c
80 combine t [srf, col, pos, lines]
82 render t = with ST do
83 [srf, col, pos, lines] <- split t
84 filledRectangle srf (0, 0) (640, 480) black
85 drawAll srf !(read lines)
86 flip srf
87 combine t [srf, col, pos, lines]
88 Just ev <- poll
89 | Nothing => render t
90 case ev of
91 KeyUp _ => pure ()
92 _ => render t
93 where drawAll : (srf : Var) -> List Line -> ST m () [srf ::: Surface {m}]
94 drawAll srf [] = pure ()
95 drawAll srf ((start, end, col) :: xs)
96 = do drawLine srf start end col
97 drawAll srf xs
99turtle : (ConsoleIO m, TurtleGraphics m) => ST m () []
100turtle = with ST do
101 Just t <- start 640 480
102 | Nothing => putStr "Can't make turtle\n"
103 col t yellow
104 fd t 100; rt t 90
105 col t green
106 fd t 100; rt t 90
107 col t red
108 fd t 100; rt t 90
109 col t blue
110 fd t 100; rt t 90
111 render t
112 end t
114main : IO ()
115main = run turtle