1
+ -- ANCHOR: module_picture
1
2
module Data.Picture where
2
3
3
4
import Prelude
4
-
5
5
import Data.Foldable (foldl )
6
+ -- ANCHOR_END: module_picture
7
+ -- ANCHOR: picture_import_as
6
8
import Global as Global
7
9
import Math as Math
10
+ -- ANCHOR_END: picture_import_as
8
11
9
- data Point = Point
12
+ -- ANCHOR: Point
13
+ type Point =
10
14
{ x :: Number
11
15
, y :: Number
12
16
}
17
+ -- ANCHOR_END: Point
13
18
14
- getX :: Point -> Number
15
- getX (Point p) = p.x
16
-
17
- getY :: Point -> Number
18
- getY (Point p) = p.y
19
-
19
+ -- ANCHOR: showPoint
20
20
showPoint :: Point -> String
21
- showPoint ( Point { x, y }) =
21
+ showPoint { x, y } =
22
22
" (" <> show x <> " , " <> show y <> " )"
23
+ -- ANCHOR_END: showPoint
23
24
25
+ -- ANCHOR: Shape
24
26
data Shape
25
27
= Circle Point Number
26
28
| Rectangle Point Number Number
27
29
| Line Point Point
28
30
| Text Point String
31
+ -- ANCHOR_END: Shape
29
32
33
+ -- ANCHOR: showShape
30
34
showShape :: Shape -> String
31
35
showShape (Circle c r) =
32
36
" Circle [center: " <> showPoint c <> " , radius: " <> show r <> " ]"
@@ -36,115 +40,132 @@ showShape (Line start end) =
36
40
" Line [start: " <> showPoint start <> " , end: " <> showPoint end <> " ]"
37
41
showShape (Text loc text) =
38
42
" Text [location: " <> showPoint loc <> " , text: " <> show text <> " ]"
43
+ -- ANCHOR_END: showShape
44
+
45
+ -- ANCHOR: exampleLine
46
+ exampleLine :: Shape
47
+ exampleLine = Line p1 p2
48
+ where
49
+ p1 :: Point
50
+ p1 = { x: 0.0 , y: 0.0 }
51
+
52
+ p2 :: Point
53
+ p2 = { x: 100.0 , y: 50.0 }
54
+ -- ANCHOR_END: exampleLine
39
55
56
+ -- ANCHOR: origin
40
57
origin :: Point
41
- origin = Point { x: 0.0 , y: 0.0 }
58
+ origin = { x, y }
59
+ where
60
+ x = 0.0
61
+ y = 0.0
62
+ -- ANCHOR_END: origin
63
+ -- Would generally write it like this instead:
64
+ -- origin = { x: 0.0, y: 0.0 }
42
65
43
66
getCenter :: Shape -> Point
44
67
getCenter (Circle c r) = c
45
68
getCenter (Rectangle c w h) = c
46
- getCenter (Line ( Point s) ( Point e)) = Point { x: (s.x + e.x) / 2.0 , y: (s.y + e.y) / 2.0 }
69
+ getCenter (Line s e) = (s + e) * {x: 0.5 , y: 0.5 }
47
70
getCenter (Text loc text) = loc
48
71
72
+ -- ANCHOR: Picture
49
73
type Picture = Array Shape
74
+ -- ANCHOR_END: Picture
50
75
76
+ -- ANCHOR: showPicture
51
77
showPicture :: Picture -> Array String
52
78
showPicture = map showShape
79
+ -- ANCHOR_END: showPicture
53
80
54
- data Bounds = Bounds
81
+ -- ANCHOR: Bounds
82
+ type Bounds =
55
83
{ top :: Number
56
84
, left :: Number
57
85
, bottom :: Number
58
86
, right :: Number
59
87
}
88
+ -- ANCHOR_END: Bounds
60
89
61
90
showBounds :: Bounds -> String
62
- showBounds ( Bounds b) =
91
+ showBounds b =
63
92
" Bounds [top: " <> show b.top <>
64
93
" , left: " <> show b.left <>
65
94
" , bottom: " <> show b.bottom <>
66
95
" , right: " <> show b.right <>
67
96
" ]"
68
97
69
98
shapeBounds :: Shape -> Bounds
70
- shapeBounds (Circle ( Point { x, y }) r) = Bounds
99
+ shapeBounds (Circle { x, y } r) =
71
100
{ top: y - r
72
101
, left: x - r
73
102
, bottom: y + r
74
103
, right: x + r
75
104
}
76
- shapeBounds (Rectangle ( Point { x, y }) w h) = Bounds
105
+ shapeBounds (Rectangle { x, y } w h) =
77
106
{ top: y - h / 2.0
78
107
, left: x - w / 2.0
79
108
, bottom: y + h / 2.0
80
109
, right: x + w / 2.0
81
110
}
82
- shapeBounds (Line ( Point p1) ( Point p2)) = Bounds
111
+ shapeBounds (Line p1 p2) =
83
112
{ top: Math .min p1.y p2.y
84
113
, left: Math .min p1.x p2.x
85
114
, bottom: Math .max p1.y p2.y
86
115
, right: Math .max p1.x p2.x
87
116
}
88
- shapeBounds (Text ( Point { x, y }) _) = Bounds
117
+ shapeBounds (Text { x, y } _) =
89
118
{ top: y
90
119
, left: x
91
120
, bottom: y
92
121
, right: x
93
122
}
94
123
95
124
union :: Bounds -> Bounds -> Bounds
96
- union ( Bounds b1) ( Bounds b2) = Bounds
125
+ union b1 b2 =
97
126
{ top: Math .min b1.top b2.top
98
127
, left: Math .min b1.left b2.left
99
128
, bottom: Math .max b1.bottom b2.bottom
100
129
, right: Math .max b1.right b2.right
101
130
}
102
131
103
132
intersect :: Bounds -> Bounds -> Bounds
104
- intersect ( Bounds b1) ( Bounds b2) = Bounds
133
+ intersect b1 b2 =
105
134
{ top: Math .max b1.top b2.top
106
135
, left: Math .max b1.left b2.left
107
136
, bottom: Math .min b1.bottom b2.bottom
108
137
, right: Math .min b1.right b2.right
109
138
}
110
139
111
140
emptyBounds :: Bounds
112
- emptyBounds = Bounds
141
+ emptyBounds =
113
142
{ top: Global .infinity
114
143
, left: Global .infinity
115
144
, bottom: -Global .infinity
116
145
, right: -Global .infinity
117
146
}
118
147
119
148
infiniteBounds :: Bounds
120
- infiniteBounds = Bounds
149
+ infiniteBounds =
121
150
{ top: -Global .infinity
122
151
, left: -Global .infinity
123
152
, bottom: Global .infinity
124
153
, right: Global .infinity
125
154
}
126
155
156
+ -- ANCHOR: bounds
127
157
bounds :: Picture -> Bounds
128
158
bounds = foldl combine emptyBounds
129
159
where
130
160
combine :: Bounds -> Shape -> Bounds
131
161
combine b shape = union (shapeBounds shape) b
162
+ -- ANCHOR_END: bounds
132
163
133
164
{-
134
165
These `instance`s are to enable testing.
135
166
Feel free to ignore these.
136
167
They'll make more sense in the next chapter.
137
168
-}
138
- derive instance boundsEq :: Eq Bounds
139
-
140
- instance boundsShow :: Show Bounds where
141
- show b = showBounds b
142
-
143
- derive instance pointEq :: Eq Point
144
-
145
- instance pointShow :: Show Point where
146
- show p = showPoint p
147
-
148
169
derive instance shapeEq :: Eq Shape
149
170
150
171
instance shapeShow :: Show Shape where
0 commit comments