67 |
let rec point_depend_of abr name = |
let rec point_depend_of abr name = |
68 |
match abr with |
match abr with |
69 |
Point s -> s = name |
Point s -> s = name |
70 |
| Inter_line_line (s,(l1,l2)) -> (s = name) || (line_depend_of l1 name) || (line_depend_of l2 name) |
| Inter_line_line (s,(l1,l2)) -> (s = name) |
71 |
| Point_on_line (s,l) -> (s = name) || (line_depend_of l name) |
|| (line_depend_of l1 name) |
72 |
| Point_on_circle (s,c) -> (s = name) || (circle_depend_of c name) |
|| (line_depend_of l2 name) |
73 |
| Middle (s,(p1,p2)) -> (s = name) || (point_depend_of p1 name) || (point_depend_of p2 name) |
| Point_on_line (s,l) -> (s = name) |
74 |
| Inter_circle_line (s1,s2,(c,l)) -> (s1 = name) || (s2 = name) || (circle_depend_of c name) || (line_depend_of l name) |
|| (line_depend_of l name) |
75 |
| Inter_circle_circle (s1,s2,(c1,c2)) -> (s1 = name) || (s2 = name) || (circle_depend_of c1 name) || (circle_depend_of c2 name) |
| Point_on_circle (s,c) -> (s = name) |
76 |
|
|| (circle_depend_of c name) |
77 |
|
| Middle (s,(p1,p2)) -> (s = name) |
78 |
|
|| (point_depend_of p1 name) |
79 |
|
|| (point_depend_of p2 name) |
80 |
|
| Inter_circle_line (s1,s2,(c,l)) -> (s1 = name) |
81 |
|
|| (s2 = name) |
82 |
|
|| (circle_depend_of c name) |
83 |
|
|| (line_depend_of l name) |
84 |
|
| Inter_circle_circle (s1,s2,(c1,c2)) -> (s1 = name) |
85 |
|
|| (s2 = name) |
86 |
|
|| (circle_depend_of c1 name) |
87 |
|
|| (circle_depend_of c2 name) |
88 |
| Construct_point p -> point_depend_of p name |
| Construct_point p -> point_depend_of p name |
89 |
|
|
90 |
and line_depend_of abr name = |
and line_depend_of abr name = |
91 |
match abr with |
match abr with |
92 |
Line (s,(p1,p2)) -> (s = name) || (point_depend_of p1 name) || (point_depend_of p2 name) |
Line (s,(p1,p2)) -> (s = name) |
93 |
| Ruler l -> (line_depend_of l name) |
|| (point_depend_of p1 name) |
94 |
| Segment (s,(p1,p2)) -> (s = name) || (point_depend_of p1 name) || (point_depend_of p2 name) |
|| (point_depend_of p2 name) |
95 |
| Perpendicular (s,(l,p)) -> (s = name) || (line_depend_of l name) || (point_depend_of p name) |
| Ruler l -> (line_depend_of l name) |
96 |
| Perpendicular_segment (s,(l,p1,(p2,p3))) -> (s = name) || (line_depend_of l name) || (point_depend_of p1 name) || (point_depend_of p2 name) || (point_depend_of p3 name) |
| Segment (s,(p1,p2)) -> (s = name) |
97 |
| Perpendicular_bissector (s,l) -> (s = name) || (line_depend_of l name) |
|| (point_depend_of p1 name) |
98 |
| Parallel (s,(l,p)) -> (s = name) || (line_depend_of l name) || (point_depend_of p name) |
|| (point_depend_of p2 name) |
99 |
| Parallel_segment (s,(l,p1,(p2,p3))) -> (s = name) || (line_depend_of l name) || (point_depend_of p1 name) || (point_depend_of p2 name) || (point_depend_of p3 name) |
| Perpendicular (s,(l,p)) -> (s = name) |
100 |
| Bissecting (s,(p1,p2,p3)) -> (s = name) || (point_depend_of p1 name) || (point_depend_of p2 name) || (point_depend_of p3 name) |
|| (line_depend_of l name) |
101 |
|
|| (point_depend_of p name) |
102 |
|
| Perpendicular_segment (s,(l,p1,(p2,p3))) -> (s = name) |
103 |
|
|| (line_depend_of l name) |
104 |
|
|| (point_depend_of p1 name) |
105 |
|
|| (point_depend_of p2 name) |
106 |
|
|| (point_depend_of p3 name) |
107 |
|
| Perpendicular_bissector (s,l) -> (s = name) |
108 |
|
|| (line_depend_of l name) |
109 |
|
| Parallel (s,(l,p)) -> (s = name) |
110 |
|
|| (line_depend_of l name) |
111 |
|
|| (point_depend_of p name) |
112 |
|
| Parallel_segment (s,(l,p1,(p2,p3))) -> (s = name) |
113 |
|
|| (line_depend_of l name) |
114 |
|
|| (point_depend_of p1 name) |
115 |
|
|| (point_depend_of p2 name) |
116 |
|
|| (point_depend_of p3 name) |
117 |
|
| Bissecting (s,(p1,p2,p3)) -> (s = name) |
118 |
|
|| (point_depend_of p1 name) |
119 |
|
|| (point_depend_of p2 name) |
120 |
|
|| (point_depend_of p3 name) |
121 |
|
|
122 |
and circle_depend_of abr name = |
and circle_depend_of abr name = |
123 |
match abr with |
match abr with |
124 |
| Circle (s,(p1,p2)) -> (s = name) || (point_depend_of p1 name) || (point_depend_of p2 name) |
| Circle (s,(p1,p2)) -> |
125 |
|
(s = name) |
126 |
|
|| (point_depend_of p1 name) |
127 |
|
|| (point_depend_of p2 name) |
128 |
| Compass c -> circle_depend_of c name |
| Compass c -> circle_depend_of c name |
129 |
|
|
130 |
let suppr_obj name fig f = |
let suppr_obj name fig f = |
131 |
begin |
begin |
132 |
fig.point_list := List.filter (fun (s,_,a) -> if point_depend_of a name then (f#remove_point s;false) else true) !(fig.point_list); |
fig.point_list := List.filter |
133 |
fig.line_list := List.filter (fun (s,_,a) -> if line_depend_of a name then (f#remove_line s;false) else true) !(fig.line_list); |
(fun (s,_,a) -> |
134 |
fig.circle_list := List.filter (fun (s,_,a) -> if circle_depend_of a name then (f#remove_circle s;false) else true) !(fig.circle_list) |
if point_depend_of a name |
135 |
|
then (f#remove_point s;false) |
136 |
|
else true) !(fig.point_list); |
137 |
|
fig.line_list := List.filter |
138 |
|
(fun (s,_,a) -> |
139 |
|
if line_depend_of a name |
140 |
|
then (f#remove_line s;false) |
141 |
|
else true) !(fig.line_list); |
142 |
|
fig.circle_list := List.filter |
143 |
|
(fun (s,_,a) -> |
144 |
|
if circle_depend_of a name |
145 |
|
then (f#remove_circle s;false) |
146 |
|
else true) !(fig.circle_list) |
147 |
end |
end |
148 |
|
|
149 |
let add_line l name col fig = fig.line_list := (name,col,l)::!(fig.line_list) |
let add_line l name col fig = fig.line_list := (name,col,l)::!(fig.line_list) |
150 |
|
|
151 |
let add_circle c name col fig = fig.circle_list := (name,col,c)::!(fig.circle_list) |
let add_circle c name col fig = fig.circle_list := (name,col,c)::!(fig.circle_list) |
152 |
|
|
153 |
(*--------------------------------------------------------------------*) |
|
154 |
let point name = Point name |
let point name = Point name |
155 |
|
|
156 |
let inter_line_line l1 l2 name = Inter_line_line (name,(l1,l2)) |
let inter_line_line l1 l2 name = Inter_line_line (name,(l1,l2)) |
221 |
| Line (s,(p1,p2)) -> (p1,p2) |
| Line (s,(p1,p2)) -> (p1,p2) |
222 |
| Ruler l1 -> expand_line l1 |
| Ruler l1 -> expand_line l1 |
223 |
| Segment (s,(p1,p2)) -> (p1,p2) |
| Segment (s,(p1,p2)) -> (p1,p2) |
224 |
| Perpendicular (s,(l1,p)) -> let (p1,p2) = expand_line l1 in |
| Perpendicular (s,(l1,p)) -> |
225 |
let c = Compass (if ((name_of_point p1)=(name_of_point p)) then circle p p2 (Generate.circle_name ()) |
let (p1,p2) = expand_line l1 in |
226 |
else circle p p1 (Generate.circle_name ())) in |
let c = Compass (if ((name_of_point p1)=(name_of_point p)) |
227 |
let (name1,name2) = (Generate.point_name (),Generate.point_name ()) in |
then circle p p2 (Generate.circle_name ()) |
228 |
let a = Construct_point (inter_circle_line c l1 name1 name2) in |
else circle p p1 (Generate.circle_name ())) in |
229 |
let b = Construct_point (inter_circle_line c l1 name2 name1) in |
let (name1,name2) = (Generate.point_name (),Generate.point_name ()) in |
230 |
let c1 = Compass (circle a b (Generate.circle_name ())) in |
let a = Construct_point (inter_circle_line c l1 name1 name2) in |
231 |
let c2 = Compass (circle b a (Generate.circle_name ())) in |
let b = Construct_point (inter_circle_line c l1 name2 name1) in |
232 |
let (name3,name4) = (Generate.point_name (),Generate.point_name ()) in |
let c1 = Compass (circle a b (Generate.circle_name ())) in |
233 |
let e = inter_circle_circle c1 c2 name3 name4 in |
let c2 = Compass (circle b a (Generate.circle_name ())) in |
234 |
let f = inter_circle_circle c2 c1 name4 name3 in |
let (name3,name4) = (Generate.point_name (),Generate.point_name ()) in |
235 |
(e,f) |
let e = inter_circle_circle c1 c2 name3 name4 in |
236 |
| Perpendicular_segment (s,(l1,p,(_,_))) -> let (p1,p2) = expand_line l1 in |
let f = inter_circle_circle c2 c1 name4 name3 in |
237 |
let c = Compass (if ((name_of_point p1)=(name_of_point p)) then circle p p2 (Generate.circle_name ()) |
(e,f) |
238 |
else circle p p1 (Generate.circle_name ())) in |
| Perpendicular_segment (s,(l1,p,(_,_))) -> |
239 |
let (name1,name2) = (Generate.point_name (),Generate.point_name ()) in |
let (p1,p2) = expand_line l1 in |
240 |
let a = Construct_point (inter_circle_line c l1 name1 name2) in |
let c = Compass (if ((name_of_point p1)=(name_of_point p)) |
241 |
let b = Construct_point (inter_circle_line c l1 name2 name1) in |
then circle p p2 (Generate.circle_name ()) |
242 |
let c1 = Compass (circle a b (Generate.circle_name ())) in |
else circle p p1 (Generate.circle_name ())) in |
243 |
let c2 = Compass (circle b a (Generate.circle_name ())) in |
let (name1,name2) = (Generate.point_name (),Generate.point_name ()) in |
244 |
let (name3,name4) = (Generate.point_name (),Generate.point_name ()) in |
let a = Construct_point (inter_circle_line c l1 name1 name2) in |
245 |
let e = inter_circle_circle c1 c2 name3 name4 in |
let b = Construct_point (inter_circle_line c l1 name2 name1) in |
246 |
let f = inter_circle_circle c2 c1 name4 name3 in |
let c1 = Compass (circle a b (Generate.circle_name ())) in |
247 |
(e,f) |
let c2 = Compass (circle b a (Generate.circle_name ())) in |
248 |
| Perpendicular_bissector (s,l1) -> let (p1,p2) = expand_line l1 in |
let (name3,name4) = (Generate.point_name (),Generate.point_name ()) in |
249 |
let c1 = Compass (circle p1 p2 (Generate.circle_name ())) in |
let e = inter_circle_circle c1 c2 name3 name4 in |
250 |
let c2 = Compass (circle p2 p1 (Generate.circle_name ())) in |
let f = inter_circle_circle c2 c1 name4 name3 in |
251 |
let (name1,name2) = (Generate.point_name (),Generate.point_name ()) in |
(e,f) |
252 |
let a = inter_circle_circle c1 c2 name1 name2 in |
| Perpendicular_bissector (s,l1) -> |
253 |
let b = inter_circle_circle c1 c2 name2 name1 in |
let (p1,p2) = expand_line l1 in |
254 |
(a,b) |
let c1 = Compass (circle p1 p2 (Generate.circle_name ())) in |
255 |
| Parallel (s,(l1,p)) -> let d = perpendicular l p (Generate.line_name ()) in |
let c2 = Compass (circle p2 p1 (Generate.circle_name ())) in |
256 |
let d2 = perpendicular d p s in |
let (name1,name2) = (Generate.point_name (),Generate.point_name ()) in |
257 |
expand_line d2 |
let a = inter_circle_circle c1 c2 name1 name2 in |
258 |
| Parallel_segment (s,(l1,p,(_,_))) -> let d = perpendicular l p (Generate.line_name ()) in |
let b = inter_circle_circle c1 c2 name2 name1 in |
259 |
let d2 = perpendicular d p s in |
(a,b) |
260 |
expand_line d2 |
| Parallel (s,(l1,p)) -> |
261 |
|
let d = perpendicular l p (Generate.line_name ()) in |
262 |
|
let d2 = perpendicular d p s in |
263 |
|
expand_line d2 |
264 |
|
| Parallel_segment (s,(l1,p,(_,_))) -> |
265 |
|
let d = perpendicular l p (Generate.line_name ()) in |
266 |
|
let d2 = perpendicular d p s in |
267 |
|
expand_line d2 |
268 |
| Bissecting (s,(p1,p2,p3)) -> raise Error |
| Bissecting (s,(p1,p2,p3)) -> raise Error |
269 |
|
|
270 |
(* parcours de l arbre *) |
(* parcours de l arbre *) |
271 |
|
|
272 |
let rec draw_point p f col flag = |
let rec draw_point p f col flag = |
273 |
match p with |
match p with |
274 |
| Point s -> (try f#get_point s with |
| Point s -> |
275 |
| Not_found -> Drawing.point (Generate.xy (100,100) (540,380)) s col flag f) |
(try f#get_point s with |
276 |
| Inter_line_line (s,(l1,l2)) -> (try f#get_point s with |
| Not_found -> Drawing.point (Generate.xy (100,100) (540,380)) s col flag f) |
277 |
| Not_found -> Drawing.inter_ll (draw_line l1 f Graphics.transp Drawing.DRAW) (draw_line l2 f Graphics.transp Drawing.DRAW) s col flag f) |
| Inter_line_line (s,(l1,l2)) -> |
278 |
| Inter_circle_line (s1,s2,(c,l)) -> (try f#get_point s1 with |
(try f#get_point s with |
279 |
| Not_found -> let (x,_) = Drawing.inter_lc (draw_line l f Graphics.transp Drawing.DRAW) (draw_circle c f Graphics.transp Drawing.DRAW) s1 s2 col flag f in x) |
| Not_found -> Drawing.inter_ll (draw_line l1 f Graphics.transp Drawing.DRAW) (draw_line l2 f Graphics.transp Drawing.DRAW) s col flag f) |
280 |
| Inter_circle_circle (s1,s2,(c1,c2)) -> (try f#get_point s1 with |
| Inter_circle_line (s1,s2,(c,l)) -> |
281 |
| Not_found -> let (x,_) = Drawing.inter_cc (draw_circle c1 f Graphics.transp Drawing.DRAW) (draw_circle c2 f Graphics.transp Drawing.DRAW) s1 s2 col flag f in x) |
(try f#get_point s1 with |
282 |
| Point_on_line (s,l) -> (try f#get_point s with |
| Not_found -> |
283 |
| Not_found -> Drawing.point_on_line (draw_line l f Graphics.transp Drawing.DRAW) s col flag f) |
let (x,_) = Drawing.inter_lc (draw_line l f Graphics.transp Drawing.DRAW) (draw_circle c f Graphics.transp Drawing.DRAW) s1 s2 col flag f in x) |
284 |
| Point_on_circle (s,c) -> (try f#get_point s with |
| Inter_circle_circle (s1,s2,(c1,c2)) -> |
285 |
| Not_found -> Drawing.point_on_circle (draw_circle c f Graphics.transp Drawing.DRAW) s col flag f) |
(try f#get_point s1 with |
286 |
| Middle (s,(p1,p2)) -> (try f#get_point s with |
| Not_found -> |
287 |
| Not_found -> Drawing.middle (draw_point p1 f Graphics.transp Drawing.DRAW) (draw_point p2 f Graphics.transp Drawing.DRAW) s col flag f) |
let (x,_) = Drawing.inter_cc (draw_circle c1 f Graphics.transp Drawing.DRAW) (draw_circle c2 f Graphics.transp Drawing.DRAW) s1 s2 col flag f in x) |
288 |
|
| Point_on_line (s,l) -> |
289 |
|
(try f#get_point s with |
290 |
|
| Not_found -> Drawing.point_on_line (draw_line l f Graphics.transp Drawing.DRAW) s col flag f) |
291 |
|
| Point_on_circle (s,c) -> |
292 |
|
(try f#get_point s with |
293 |
|
| Not_found -> Drawing.point_on_circle (draw_circle c f Graphics.transp Drawing.DRAW) s col flag f) |
294 |
|
| Middle (s,(p1,p2)) -> |
295 |
|
(try f#get_point s with |
296 |
|
| Not_found -> Drawing.middle (draw_point p1 f Graphics.transp Drawing.DRAW) (draw_point p2 f Graphics.transp Drawing.DRAW) s col flag f) |
297 |
| Construct_point pp -> draw_point pp f Graphics.transp Drawing.NO_DRAW |
| Construct_point pp -> draw_point pp f Graphics.transp Drawing.NO_DRAW |
298 |
| _ -> raise Error |
| _ -> raise Error |
299 |
|
|
300 |
and draw_line l f col flag = |
and draw_line l f col flag = |
301 |
match l with |
match l with |
302 |
| Line (s,(p1,p2)) -> (try f#get_line s with |
| Line (s,(p1,p2)) -> |
303 |
| Not_found -> Drawing.line (draw_point p1 f Graphics.transp Drawing.DRAW) (draw_point p2 f Graphics.transp Drawing.DRAW) s col flag f) |
(try f#get_line s with |
304 |
| Ruler ll -> draw_line ll f Graphics.transp Drawing.NO_DRAW |
| Not_found -> Drawing.line (draw_point p1 f Graphics.transp Drawing.DRAW) (draw_point p2 f Graphics.transp Drawing.DRAW) s col flag f) |
305 |
| Segment (s,(p1,p2)) -> (try f#get_line s with |
| Ruler ll -> draw_line ll f Graphics.transp Drawing.NO_DRAW |
306 |
|
| Segment (s,(p1,p2)) -> |
307 |
|
(try f#get_line s with |
308 |
| Not_found -> Drawing.segment (draw_point p1 f Graphics.transp Drawing.DRAW) (draw_point p2 f Graphics.transp Drawing.DRAW) s col flag f) |
| Not_found -> Drawing.segment (draw_point p1 f Graphics.transp Drawing.DRAW) (draw_point p2 f Graphics.transp Drawing.DRAW) s col flag f) |
309 |
| Perpendicular (s,(l,p)) -> (try f#get_line s with |
| Perpendicular (s,(l,p)) -> |
310 |
| Not_found -> Drawing.perpendicular (draw_line l f Graphics.transp Drawing.DRAW) (draw_point p f Graphics.transp Drawing.DRAW) s col flag f) |
(try f#get_line s with |
311 |
| Perpendicular_segment (s,(l,p,(p1,p2))) -> (try f#get_line s with |
| Not_found -> Drawing.perpendicular (draw_line l f Graphics.transp Drawing.DRAW) (draw_point p f Graphics.transp Drawing.DRAW) s col flag f) |
312 |
| Not_found -> Drawing.perpendicular_seg (draw_line l f Graphics.transp Drawing.DRAW) (draw_point p f Graphics.transp Drawing.DRAW) (draw_point p1 f Graphics.transp Drawing.DRAW) (draw_point p2 f Graphics.transp Drawing.DRAW) s col flag f) |
| Perpendicular_segment (s,(l,p,(p1,p2))) -> |
313 |
| Parallel (s,(l,p)) -> (try f#get_line s with |
(try f#get_line s with |
314 |
| Not_found -> Drawing.parallel (draw_line l f Graphics.transp Drawing.DRAW) (draw_point p f Graphics.transp Drawing.DRAW) s col flag f) |
| Not_found -> Drawing.perpendicular_seg (draw_line l f Graphics.transp Drawing.DRAW) (draw_point p f Graphics.transp Drawing.DRAW) (draw_point p1 f Graphics.transp Drawing.DRAW) (draw_point p2 f Graphics.transp Drawing.DRAW) s col flag f) |
315 |
| Parallel_segment (s,(l,p,(p1,p2))) -> (try f#get_line s with |
| Parallel (s,(l,p)) -> |
316 |
| Not_found -> Drawing.parallel_seg (draw_line l f Graphics.transp Drawing.DRAW) (draw_point p f Graphics.transp Drawing.DRAW) (draw_point p1 f Graphics.transp Drawing.DRAW) (draw_point p2 f Graphics.transp Drawing.DRAW) s col flag f) |
(try f#get_line s with |
317 |
| Bissecting (s,(p1,p2,p3)) -> (try f#get_line s with |
| Not_found -> Drawing.parallel (draw_line l f Graphics.transp Drawing.DRAW) (draw_point p f Graphics.transp Drawing.DRAW) s col flag f) |
318 |
| Not_found -> Drawing.angle_bissector (draw_point p1 f Graphics.transp Drawing.DRAW) (draw_point p2 f Graphics.transp Drawing.DRAW) (draw_point p3 f Graphics.transp Drawing.DRAW) s col flag f) |
| Parallel_segment (s,(l,p,(p1,p2))) -> |
319 |
| Perpendicular_bissector (s,l) -> (try f#get_line s with |
(try f#get_line s with |
320 |
| Not_found -> Drawing.perpendicular_bissector (draw_line l f Graphics.transp Drawing.DRAW) s col flag f) |
| Not_found -> Drawing.parallel_seg (draw_line l f Graphics.transp Drawing.DRAW) (draw_point p f Graphics.transp Drawing.DRAW) (draw_point p1 f Graphics.transp Drawing.DRAW) (draw_point p2 f Graphics.transp Drawing.DRAW) s col flag f) |
321 |
|
| Bissecting (s,(p1,p2,p3)) -> |
322 |
|
(try f#get_line s with |
323 |
|
| Not_found -> Drawing.angle_bissector (draw_point p1 f Graphics.transp Drawing.DRAW) (draw_point p2 f Graphics.transp Drawing.DRAW) (draw_point p3 f Graphics.transp Drawing.DRAW) s col flag f) |
324 |
|
| Perpendicular_bissector (s,l) -> |
325 |
|
(try f#get_line s with |
326 |
|
| Not_found -> Drawing.perpendicular_bissector (draw_line l f Graphics.transp Drawing.DRAW) s col flag f) |
327 |
|
|
328 |
| _ -> raise Error |
| _ -> raise Error |
329 |
|
|
330 |
and draw_circle c f col flag = |
and draw_circle c f col flag = |
331 |
match c with |
match c with |
332 |
| Circle (s,(o,p)) -> (try f#get_circle s with |
| Circle (s,(o,p)) -> |
333 |
| Not_found -> Drawing.circle (draw_point o f Graphics.transp Drawing.DRAW) (draw_point p f Graphics.transp Drawing.DRAW) s col flag f) |
(try f#get_circle s with |
334 |
| Compass cc -> draw_circle cc f Graphics.transp Drawing.NO_DRAW |
| Not_found -> Drawing.circle (draw_point o f Graphics.transp Drawing.DRAW) (draw_point p f Graphics.transp Drawing.DRAW) s col flag f) |
335 |
| _ -> raise Error |
| Compass cc -> draw_circle cc f Graphics.transp Drawing.NO_DRAW |
336 |
|
| _ -> raise Error |
337 |
|
|
338 |
let draw_figure abstract_figure drawn_figure flag = |
let draw_figure abstract_figure drawn_figure flag = |
339 |
List.iter (fun (_,col,p) -> draw_point p drawn_figure col flag;()) (List.rev !(abstract_figure.point_list)); |
List.iter (fun (_,col,p) -> draw_point p drawn_figure col flag;()) (List.rev !(abstract_figure.point_list)); |
340 |
List.iter (fun (_,col,l) -> draw_line l drawn_figure col flag;()) (List.rev !(abstract_figure.line_list)); |
List.iter (fun (_,col,l) -> draw_line l drawn_figure col flag;()) (List.rev !(abstract_figure.line_list)); |
344 |
|
|
345 |
let rec write_point p level = |
let rec write_point p level = |
346 |
match p with |
match p with |
347 |
| Point s -> (if Xml.is_a_declared_point s then (if level = 0 then Xml.do_nothing else Xml.point s level) |
| Point s -> |
348 |
else Xml.point_declaration s (Generate.xy (100,100) (540,380)) level) |
(if Xml.is_a_declared_point s |
349 |
| Inter_line_line (s,(l1,l2)) -> (if Xml.is_a_declared_point s then (if level = 0 then Xml.do_nothing else Xml.point s level) |
then (if level = 0 then Xml.do_nothing else Xml.point s level) |
350 |
else Xml.inter_line_line s (write_line l1 (level+1)) (write_line l2 (level+1)) level) |
else Xml.point_declaration s (Generate.xy (100,100) (540,380)) level) |
351 |
| Inter_circle_line (s1,s2,(c,l)) -> (if Xml.is_a_declared_point s1 then (if level = 0 then Xml.do_nothing else Xml.point s1 level) |
| Inter_line_line (s,(l1,l2)) -> |
352 |
else Xml.inter_circle_line s1 (write_circle c (level+1)) (write_line l (level+1)) level) |
(if Xml.is_a_declared_point s |
353 |
| Inter_circle_circle (s1,s2,(c1,c2)) -> (if Xml.is_a_declared_point s1 then (if level = 0 then Xml.do_nothing else Xml.point s1 level) |
then (if level = 0 then Xml.do_nothing else Xml.point s level) |
354 |
else Xml.inter_circle_circle s1 (write_circle c1 (level+1)) (write_circle c2 (level+1)) level) |
else Xml.inter_line_line s |
355 |
| Point_on_line (s,l) -> (if Xml.is_a_declared_point s then (if level = 0 then Xml.do_nothing else Xml.point s level) |
(write_line l1 (level+1)) |
356 |
else Xml.point_on_line s (write_line l (level+1)) level) |
(write_line l2 (level+1)) level) |
357 |
| Point_on_circle (s,c) -> (if Xml.is_a_declared_point s then (if level = 0 then Xml.do_nothing else Xml.point s level) |
| Inter_circle_line (s1,s2,(c,l)) -> |
358 |
else Xml.point_on_circle s (write_circle c (level+1)) level) |
(if Xml.is_a_declared_point s1 |
359 |
| Middle (s,(p1,p2)) -> (if Xml.is_a_declared_point s then (if level = 0 then Xml.do_nothing else Xml.point s level) |
then (if level = 0 |
360 |
else Xml.middle s (write_point p1 (level+1)) (write_point p2 (level+1)) level) |
then Xml.do_nothing |
361 |
| Construct_point p1 -> write_point p1 level |
else Xml.point s1 level) |
362 |
|
else Xml.inter_circle_line s1 |
363 |
|
(write_circle c (level+1)) |
364 |
|
(write_line l (level+1)) level) |
365 |
|
| Inter_circle_circle (s1,s2,(c1,c2)) -> |
366 |
|
(if Xml.is_a_declared_point s1 |
367 |
|
then (if level = 0 then Xml.do_nothing else Xml.point s1 level) |
368 |
|
else Xml.inter_circle_circle s1 |
369 |
|
(write_circle c1 (level+1)) |
370 |
|
(write_circle c2 (level+1)) level) |
371 |
|
| Point_on_line (s,l) -> |
372 |
|
(if Xml.is_a_declared_point s |
373 |
|
then (if level = 0 then Xml.do_nothing else Xml.point s level) |
374 |
|
else Xml.point_on_line s (write_line l (level+1)) level) |
375 |
|
| Point_on_circle (s,c) -> |
376 |
|
(if Xml.is_a_declared_point s |
377 |
|
then (if level = 0 then Xml.do_nothing else Xml.point s level) |
378 |
|
else Xml.point_on_circle s (write_circle c (level+1)) level) |
379 |
|
| Middle (s,(p1,p2)) -> |
380 |
|
(if Xml.is_a_declared_point s |
381 |
|
then (if level = 0 then Xml.do_nothing else Xml.point s level) |
382 |
|
else Xml.middle s (write_point p1 (level+1)) (write_point p2 (level+1)) level) |
383 |
|
| Construct_point p1 -> write_point p1 level |
384 |
|
|
385 |
and write_line l level= |
and write_line l level= |
386 |
match l with |
match l with |
387 |
| Line (s,(p1,p2)) -> (if Xml.is_a_declared_line s then (if level = 0 then Xml.do_nothing else Xml.line s level) |
| Line (s,(p1,p2)) -> |
388 |
else Xml.line_declaration s (write_point p1 (level+1)) (write_point p2 (level+1)) level) |
(if Xml.is_a_declared_line s |
389 |
| Segment (s,(p1,p2)) -> (if Xml.is_a_declared_line s then (if level = 0 then Xml.do_nothing else Xml.line s level) |
then (if level = 0 |
390 |
else Xml.segment s (write_point p1 (level+1)) (write_point p2 (level+1)) level) |
then Xml.do_nothing |
391 |
| Perpendicular (s,(l,p)) -> (if Xml.is_a_declared_line s then (if level = 0 then Xml.do_nothing else Xml.line s level) |
else Xml.line s level) |
392 |
else Xml.perpendicular s (write_line l (level+1)) (write_point p (level+1)) level) |
else Xml.line_declaration s (write_point p1 (level+1)) (write_point p2 (level+1)) level) |
393 |
| Perpendicular_bissector (s,l) -> (if Xml.is_a_declared_line s then (if level = 0 then Xml.do_nothing else Xml.line s level) |
| Segment (s,(p1,p2)) -> |
394 |
else Xml.perpendicular_bissector s (write_line l (level+1)) level) |
(if Xml.is_a_declared_line s |
395 |
| Parallel (s,(l,p)) -> (if Xml.is_a_declared_line s then (if level = 0 then Xml.do_nothing else Xml.line s level) |
then (if level = 0 |
396 |
else Xml.parallel s (write_line l (level+1)) (write_point p (level+1)) level) |
then Xml.do_nothing |
397 |
| Bissecting (s,(p1,p2,p3)) -> (if Xml.is_a_declared_line s then (if level = 0 then Xml.do_nothing else Xml.line s level) |
else Xml.line s level) |
398 |
else Xml.bissecting s (write_point p1 (level+1)) (write_point p2 (level+1)) (write_point p3 (level+1)) level) |
|
399 |
|
else Xml.segment s (write_point p1 (level+1)) (write_point p2 (level+1)) level) |
400 |
|
| Perpendicular (s,(l,p)) -> |
401 |
|
(if Xml.is_a_declared_line s |
402 |
|
then (if level = 0 |
403 |
|
then Xml.do_nothing |
404 |
|
else Xml.line s level) |
405 |
|
else Xml.perpendicular s (write_line l (level+1)) (write_point p (level+1)) level) |
406 |
|
| Perpendicular_bissector (s,l) -> |
407 |
|
(if Xml.is_a_declared_line s then |
408 |
|
(if level = 0 then Xml.do_nothing else Xml.line s level) |
409 |
|
else Xml.perpendicular_bissector s (write_line l (level+1)) level) |
410 |
|
| Parallel (s,(l,p)) -> |
411 |
|
(if Xml.is_a_declared_line s |
412 |
|
then (if level = 0 |
413 |
|
then Xml.do_nothing |
414 |
|
else Xml.line s level) |
415 |
|
else Xml.parallel s (write_line l (level+1)) (write_point p (level+1)) level) |
416 |
|
| Bissecting (s,(p1,p2,p3)) -> |
417 |
|
(if Xml.is_a_declared_line s |
418 |
|
then (if level = 0 |
419 |
|
then Xml.do_nothing |
420 |
|
else Xml.line s level) |
421 |
|
else Xml.bissecting s |
422 |
|
(write_point p1 (level+1)) |
423 |
|
(write_point p2 (level+1)) |
424 |
|
(write_point p3 (level+1)) level) |
425 |
| Ruler l1 -> write_line l1 level |
| Ruler l1 -> write_line l1 level |
426 |
|
|
427 |
and write_circle c level= |
and write_circle c level= |
428 |
match c with |
match c with |
429 |
| Circle (s,(o,p)) -> (if Xml.is_a_declared_circle s then (if level = 0 then Xml.do_nothing else Xml.circle s level) |
| Circle (s,(o,p)) -> |
430 |
else Xml.circle_declaration s (write_point o (level+1)) (write_point p (level+1)) level) |
(if Xml.is_a_declared_circle s |
431 |
| Compass c1 -> write_circle c1 level |
then (if level = 0 then Xml.do_nothing else Xml.circle s level) |
432 |
|
else Xml.circle_declaration s |
433 |
|
(write_point o (level+1)) |
434 |
|
(write_point p (level+1)) level) |
435 |
|
| Compass c1 -> write_circle c1 level |
436 |
|
|
437 |
let write_figure abstract_figure channel = |
let write_figure abstract_figure channel = |
438 |
List.iter (fun (_,_,p) -> (write_point p 0) channel;()) (List.rev !(abstract_figure.point_list)); |
List.iter |
439 |
List.iter (fun (_,_,l) -> (write_line l 0) channel;()) (List.rev !(abstract_figure.line_list)); |
(fun (_,_,p) -> |
440 |
List.iter (fun (_,_,c) -> (write_circle c 0) channel;()) (List.rev !(abstract_figure.circle_list)) |
(write_point p 0) channel;()) (List.rev !(abstract_figure.point_list)); |
441 |
|
List.iter |
442 |
|
(fun (_,_,l) -> |
443 |
|
(write_line l 0) channel;()) (List.rev !(abstract_figure.line_list)); |
444 |
|
List.iter |
445 |
|
(fun (_,_,c) -> |
446 |
|
(write_circle c 0) channel;()) (List.rev !(abstract_figure.circle_list)) |
447 |
|
|
448 |
(* XML expansed writer*) |
(* XML expansed writer*) |
449 |
let rec write_point2 p col level = |
let rec write_point2 p col level = |
450 |
match p with |
match p with |
451 |
| Point s -> ( let (is_here,colour) = Xmlexpansed.is_a_declared_point s in |
| Point s -> |
452 |
if is_here then (if level = 0 then Xmlexpansed.do_nothing else Xmlexpansed.point s colour level) |
(let (is_here,colour) = Xmlexpansed.is_a_declared_point s in |
453 |
else Xmlexpansed.point_declaration s (Generate.xy (0,0) (10,10)) col level) |
if is_here |
454 |
| Inter_line_line (s,(l1,l2)) -> ( let (is_here,colour) = Xmlexpansed.is_a_declared_point s in |
then (if level = 0 |
455 |
if is_here then (if level = 0 then Xmlexpansed.do_nothing else Xmlexpansed.point s colour level) |
then Xmlexpansed.do_nothing |
456 |
else Xmlexpansed.inter_line_line s (write_line2 l1 "black" (level+1)) (write_line2 l2 "black" (level+1)) col level) |
else Xmlexpansed.point s colour level) |
457 |
| Inter_circle_line (s1,s2,(c,l)) -> (let (is_here,colour) = Xmlexpansed.is_a_declared_point s1 in |
else Xmlexpansed.point_declaration s (Generate.xy (0,0) (10,10)) col level) |
458 |
if is_here then (if level = 0 then Xmlexpansed.do_nothing else Xmlexpansed.point s1 colour level) |
| Inter_line_line (s,(l1,l2)) -> |
459 |
else Xmlexpansed.inter_circle_line s1 s2 (write_circle2 c "black" (level+1)) (write_line2 l "black" (level+1)) col level) |
(let (is_here,colour) = Xmlexpansed.is_a_declared_point s in |
460 |
| Inter_circle_circle (s1,s2,(c1,c2)) -> (let (is_here,colour) = Xmlexpansed.is_a_declared_point s1 in |
if is_here then (if level = 0 |
461 |
if is_here then (if level = 0 then Xmlexpansed.do_nothing else Xmlexpansed.point s1 colour level) |
then Xmlexpansed.do_nothing |
462 |
else Xmlexpansed.inter_circle_circle s1 s2 (write_circle2 c1 "black" (level+1)) (write_circle2 c2 "black" (level+1)) col level) |
else Xmlexpansed.point s colour level) |
463 |
| Point_on_line (s,l) -> (let (is_here,colour) = Xmlexpansed.is_a_declared_point s in |
else Xmlexpansed.inter_line_line s |
464 |
if is_here then (if level = 0 then Xmlexpansed.do_nothing else Xmlexpansed.point s colour level) |
(write_line2 l1 "black" (level+1)) |
465 |
else Xmlexpansed.point_on_line s (write_line2 l "black" (level+1)) col level) |
(write_line2 l2 "black" (level+1)) col level) |
466 |
| Point_on_circle (s,c) -> (let (is_here,colour) = Xmlexpansed.is_a_declared_point s in |
| Inter_circle_line (s1,s2,(c,l)) -> |
467 |
if is_here then (if level = 0 then Xmlexpansed.do_nothing else Xmlexpansed.point s colour level) |
(let (is_here,colour) = Xmlexpansed.is_a_declared_point s1 in |
468 |
else Xmlexpansed.point_on_circle s (write_circle2 c "black" (level+1)) col level) |
if is_here then (if level = 0 |
469 |
| Middle (s,(p1,p2)) -> (let (is_here,colour) = Xmlexpansed.is_a_declared_point s in |
then Xmlexpansed.do_nothing |
470 |
if is_here then (if level = 0 then Xmlexpansed.do_nothing else Xmlexpansed.point s colour level) |
else Xmlexpansed.point s1 colour level) |
471 |
else Xmlexpansed.middle s (write_point2 p1 "red" (level+1)) (write_point2 p2 "red" (level+1)) col level) |
else Xmlexpansed.inter_circle_line s1 s2 |
472 |
|
(write_circle2 c "black" (level+1)) |
473 |
| Construct_point p1 -> write_point2 p1 "white" level |
(write_line2 l "black" (level+1)) col level) |
474 |
|
| Inter_circle_circle (s1,s2,(c1,c2)) -> |
475 |
|
(let (is_here,colour) = Xmlexpansed.is_a_declared_point s1 in |
476 |
|
if is_here then (if level = 0 |
477 |
|
then Xmlexpansed.do_nothing |
478 |
|
else Xmlexpansed.point s1 colour level) |
479 |
|
else Xmlexpansed.inter_circle_circle s1 s2 |
480 |
|
(write_circle2 c1 "black" (level+1)) |
481 |
|
(write_circle2 c2 "black" (level+1)) col level) |
482 |
|
| Point_on_line (s,l) -> |
483 |
|
(let (is_here,colour) = Xmlexpansed.is_a_declared_point s in |
484 |
|
if is_here then (if level = 0 |
485 |
|
then Xmlexpansed.do_nothing |
486 |
|
else Xmlexpansed.point s colour level) |
487 |
|
else Xmlexpansed.point_on_line s (write_line2 l "black" (level+1)) col level) |
488 |
|
| Point_on_circle (s,c) -> |
489 |
|
(let (is_here,colour) = Xmlexpansed.is_a_declared_point s in |
490 |
|
if is_here then (if level = 0 |
491 |
|
then Xmlexpansed.do_nothing |
492 |
|
else Xmlexpansed.point s colour level) |
493 |
|
else Xmlexpansed.point_on_circle s (write_circle2 c "black" (level+1)) col level) |
494 |
|
| Middle (s,(p1,p2)) -> |
495 |
|
(let (is_here,colour) = Xmlexpansed.is_a_declared_point s in |
496 |
|
if is_here then (if level = 0 |
497 |
|
then Xmlexpansed.do_nothing |
498 |
|
else Xmlexpansed.point s colour level) |
499 |
|
else Xmlexpansed.middle s (write_point2 p1 "red" (level+1)) (write_point2 p2 "red" (level+1)) col level) |
500 |
|
|
501 |
|
| Construct_point p1 -> write_point2 p1 "white" level |
502 |
|
|
503 |
and write_line2 l col level= |
and write_line2 l col level= |
504 |
match l with |
match l with |
505 |
| Line (s,(p1,p2)) -> (let (is_here,colour) = Xmlexpansed.is_a_declared_line s in |
| Line (s,(p1,p2)) -> |
506 |
if is_here then |
(let (is_here,colour) = Xmlexpansed.is_a_declared_line s in |
507 |
Xmlexpansed.line_declaration s (Xmlexpansed.do_nothing) (Xmlexpansed.do_nothing) (name_of_point p1) (name_of_point p2) colour level |
if is_here |
508 |
else |
then |
509 |
Xmlexpansed.line_declaration s (write_point2 p1 col (level+1)) (write_point2 p2 col (level+1)) (name_of_point p1) (name_of_point p2) col level) |
Xmlexpansed.line_declaration s |
510 |
| Segment (s,(p1,p2)) -> (let (is_here,colour) = Xmlexpansed.is_a_declared_line s in |
(Xmlexpansed.do_nothing) |
511 |
if is_here then |
(Xmlexpansed.do_nothing) |
512 |
Xmlexpansed.segment s (Xmlexpansed.do_nothing) (Xmlexpansed.do_nothing) (name_of_point p1) (name_of_point p2) colour level |
(name_of_point p1) |
513 |
else |
(name_of_point p2) colour level |
514 |
Xmlexpansed.segment s (write_point2 p1 col (level+1)) (write_point2 p2 col (level+1)) (name_of_point p1) (name_of_point p2) col level) |
else |
515 |
| Perpendicular (s,_) -> write_line2 (Line (s,expand_line l)) col level |
Xmlexpansed.line_declaration s |
516 |
| Perpendicular_segment (s,_) -> write_line2 (Segment (s,expand_line l)) col level |
(write_point2 p1 col (level+1)) |
517 |
| Perpendicular_bissector (s,_) -> write_line2 (Line (s,expand_line l)) col level |
(write_point2 p2 col (level+1)) |
518 |
| Parallel (s,_) -> write_line2 (Line (s,expand_line l)) col level |
(name_of_point p1) |
519 |
| Parallel_segment (s,_) -> write_line2 (Segment (s,expand_line l)) col level |
(name_of_point p2) col level) |
520 |
| Bissecting (s,(p1,p2,p3)) -> raise Error |
| Segment (s,(p1,p2)) -> |
521 |
| Ruler l1 -> write_line2 l1 "white" level |
(let (is_here,colour) = Xmlexpansed.is_a_declared_line s in |
522 |
|
if is_here |
523 |
|
then |
524 |
|
Xmlexpansed.segment s |
525 |
|
(Xmlexpansed.do_nothing) |
526 |
|
(Xmlexpansed.do_nothing) |
527 |
|
(name_of_point p1) |
528 |
|
(name_of_point p2) colour level |
529 |
|
else |
530 |
|
Xmlexpansed.segment s |
531 |
|
(write_point2 p1 col (level+1)) |
532 |
|
(write_point2 p2 col (level+1)) |
533 |
|
(name_of_point p1) |
534 |
|
(name_of_point p2) col level) |
535 |
|
| Perpendicular (s,_) -> |
536 |
|
write_line2 (Line (s,expand_line l)) col level |
537 |
|
| Perpendicular_segment (s,_) -> |
538 |
|
write_line2 (Segment (s,expand_line l)) col level |
539 |
|
| Perpendicular_bissector (s,_) -> |
540 |
|
write_line2 (Line (s,expand_line l)) col level |
541 |
|
| Parallel (s,_) -> |
542 |
|
write_line2 (Line (s,expand_line l)) col level |
543 |
|
| Parallel_segment (s,_) -> |
544 |
|
write_line2 (Segment (s,expand_line l)) col level |
545 |
|
| Bissecting (s,(p1,p2,p3)) -> |
546 |
|
raise Error |
547 |
|
| Ruler l1 -> |
548 |
|
write_line2 l1 "white" level |
549 |
|
|
550 |
and write_circle2 c col level= |
and write_circle2 c col level= |
551 |
match c with |
match c with |
552 |
| Circle (s,(o,p)) -> (let (is_here,colour) = Xmlexpansed.is_a_declared_circle s in |
| Circle (s,(o,p)) -> |
553 |
if is_here then |
(let (is_here,colour) = Xmlexpansed.is_a_declared_circle s in |
554 |
Xmlexpansed.circle_declaration s (Xmlexpansed.do_nothing) (Xmlexpansed.do_nothing) (name_of_point o) (name_of_point p) colour level |
if is_here |
555 |
else |
then |
556 |
Xmlexpansed.circle_declaration s (write_point2 o col (level+1)) (write_point2 p col (level+1)) (name_of_point o) (name_of_point p) col level) |
Xmlexpansed.circle_declaration s |
557 |
| Compass c1 -> write_circle2 c1 "white" level |
(Xmlexpansed.do_nothing) |
558 |
|
(Xmlexpansed.do_nothing) |
559 |
|
(name_of_point o) |
560 |
|
(name_of_point p) colour level |
561 |
|
else |
562 |
|
Xmlexpansed.circle_declaration s |
563 |
|
(write_point2 o col (level+1)) |
564 |
|
(write_point2 p col (level+1)) |
565 |
|
(name_of_point o) |
566 |
|
(name_of_point p) col level) |
567 |
|
| Compass c1 -> write_circle2 c1 "white" level |
568 |
|
|
569 |
let write_figure2 abstract_figure channel = |
let write_figure2 abstract_figure channel = |
570 |
List.iter (fun (_,_,p) -> (write_point2 p "red" 0) channel;()) (List.rev !(abstract_figure.point_list)); |
List.iter |
571 |
List.iter (fun (_,_,l) -> (write_line2 l "black" 0) channel;()) (List.rev !(abstract_figure.line_list)); |
(fun (_,_,p) -> |
572 |
List.iter (fun (_,_,c) -> (write_circle2 c "black" 0) channel;()) (List.rev !(abstract_figure.circle_list)) |
(write_point2 p "red" 0) channel;()) (List.rev !(abstract_figure.point_list)); |
573 |
|
List.iter |
574 |
|
(fun (_,_,l) -> |
575 |
|
(write_line2 l "black" 0) channel;()) (List.rev !(abstract_figure.line_list)); |
576 |
|
List.iter |
577 |
|
(fun (_,_,c) -> |
578 |
|
(write_circle2 c "black" 0) channel;()) (List.rev !(abstract_figure.circle_list)) |
579 |
;; |
;; |
580 |
|
|
581 |
|
|