26 |
circle = Circle of (string * (point * point)) |
circle = Circle of (string * (point * point)) |
27 |
| Compass of circle |
| Compass of circle |
28 |
|
|
29 |
type figure = {point_list: (string * point) list ref; |
type figure = {point_list: (string * Graphics.color * point) list ref; |
30 |
line_list: (string * line) list ref; |
line_list: (string * Graphics.color * line) list ref; |
31 |
circle_list: (string * circle) list ref;} |
circle_list: (string * Graphics.color * circle) list ref;} |
32 |
|
|
33 |
let my_figure = {point_list=ref [];line_list=ref [];circle_list=ref []} |
let my_figure = {point_list=ref [];line_list=ref [];circle_list=ref []} |
34 |
|
|
36 |
|
|
37 |
(*-------------------------------------------------------------------*) |
(*-------------------------------------------------------------------*) |
38 |
let get_point name fig = |
let get_point name fig = |
39 |
let (_,p) = List.find (fun (s,_) -> s=name) !(fig.point_list) in p |
let (_,_,p) = List.find (fun (s,_,_) -> s=name) !(fig.point_list) in p |
40 |
|
|
41 |
let get_line name fig = |
let get_line name fig = |
42 |
let len = (String.length name)-1 in |
let len = (String.length name)-1 in |
46 |
let a = String.sub name 1 (i-1) in |
let a = String.sub name 1 (i-1) in |
47 |
let b = String.sub name (i+1) (len-i-1) in |
let b = String.sub name (i+1) (len-i-1) in |
48 |
let rev_name = "("^b^","^a^")" in |
let rev_name = "("^b^","^a^")" in |
49 |
let (_,l) = List.find (fun (s,_) -> s = name || s = rev_name) !(fig.line_list) in l |
let (_,_,l) = List.find (fun (s,_,_) -> s = name || s = rev_name) !(fig.line_list) in l |
50 |
end |
end |
51 |
else |
else |
52 |
if name.[0]='[' && name.[len]=']' then |
if name.[0]='[' && name.[len]=']' then |
55 |
let a = String.sub name 1 (i-1) in |
let a = String.sub name 1 (i-1) in |
56 |
let b = String.sub name (i+1) (len-i-1) in |
let b = String.sub name (i+1) (len-i-1) in |
57 |
let rev_name = "["^b^","^a^"]" in |
let rev_name = "["^b^","^a^"]" in |
58 |
let (_,l) = List.find (fun (s,_) -> s = name || s = rev_name) !(fig.line_list) in l |
let (_,_,l) = List.find (fun (s,_,_) -> s = name || s = rev_name) !(fig.line_list) in l |
59 |
end |
end |
60 |
else let (_,l) = List.find (fun (s,_) -> s=name) !(fig.line_list) in l |
else let (_,_,l) = List.find (fun (s,_,_) -> s=name) !(fig.line_list) in l |
61 |
|
|
62 |
let get_circle name fig = |
let get_circle name fig = |
63 |
let (_,c) = List.find (fun (s,_) -> s=name) !(fig.circle_list) in c |
let (_,_,c) = List.find (fun (s,_,_) -> s=name) !(fig.circle_list) in c |
64 |
|
|
65 |
let add_point p name fig = fig.point_list := (name,p)::!(fig.point_list) |
let add_point p name col fig = fig.point_list := (name,col,p)::!(fig.point_list) |
66 |
|
|
67 |
let rec point_depend_of abr name = |
let rec point_depend_of abr name = |
68 |
match abr with |
match abr with |
94 |
|
|
95 |
let suppr_obj name fig f = |
let suppr_obj name fig f = |
96 |
begin |
begin |
97 |
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 (fun (s,_,a) -> if point_depend_of a name then (f#remove_point s;false) else true) !(fig.point_list); |
98 |
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); |
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); |
99 |
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) |
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) |
100 |
end |
end |
101 |
|
|
102 |
let add_line l name fig = fig.line_list := (name,l)::!(fig.line_list) |
let add_line l name col fig = fig.line_list := (name,col,l)::!(fig.line_list) |
103 |
|
|
104 |
let add_circle c name fig = fig.circle_list := (name,c)::!(fig.circle_list) |
let add_circle c name col fig = fig.circle_list := (name,col,c)::!(fig.circle_list) |
105 |
|
|
106 |
(*--------------------------------------------------------------------*) |
(*--------------------------------------------------------------------*) |
107 |
let point name = Point name |
let point name = Point name |
215 |
|
|
216 |
(* parcours de l arbre *) |
(* parcours de l arbre *) |
217 |
|
|
218 |
let rec draw_point p f flag = |
let rec draw_point p f col flag = |
219 |
match p with |
match p with |
220 |
| Point s -> (try f#get_point s with |
| Point s -> (try f#get_point s with |
221 |
| Not_found -> Drawing.point (Generate.xy (100,100) (540,380)) s flag f) |
| Not_found -> Drawing.point (Generate.xy (100,100) (540,380)) s col flag f) |
222 |
| Inter_line_line (s,(l1,l2)) -> (try f#get_point s with |
| Inter_line_line (s,(l1,l2)) -> (try f#get_point s with |
223 |
| Not_found -> Drawing.inter_ll (draw_line l1 f Drawing.DRAW) (draw_line l2 f Drawing.DRAW) s flag f) |
| 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) |
224 |
| Inter_circle_line (s1,s2,(c,l)) -> (try f#get_point s1 with |
| Inter_circle_line (s1,s2,(c,l)) -> (try f#get_point s1 with |
225 |
| Not_found -> let (x,_) = Drawing.inter_lc (draw_line l f Drawing.DRAW) (draw_circle c f Drawing.DRAW) s1 s2 flag f in x) |
| 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) |
226 |
| Inter_circle_circle (s1,s2,(c1,c2)) -> (try f#get_point s1 with |
| Inter_circle_circle (s1,s2,(c1,c2)) -> (try f#get_point s1 with |
227 |
| Not_found -> let (x,_) = Drawing.inter_cc (draw_circle c1 f Drawing.DRAW) (draw_circle c2 f Drawing.DRAW) s1 s2 flag f in x) |
| 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) |
228 |
| Point_on_line (s,l) -> (try f#get_point s with |
| Point_on_line (s,l) -> (try f#get_point s with |
229 |
| Not_found -> Drawing.point_on_line (draw_line l f Drawing.DRAW) s flag f) |
| Not_found -> Drawing.point_on_line (draw_line l f Graphics.transp Drawing.DRAW) s col flag f) |
230 |
| Point_on_circle (s,c) -> (try f#get_point s with |
| Point_on_circle (s,c) -> (try f#get_point s with |
231 |
| Not_found -> Drawing.point_on_circle (draw_circle c f Drawing.DRAW) s flag f) |
| Not_found -> Drawing.point_on_circle (draw_circle c f Graphics.transp Drawing.DRAW) s col flag f) |
232 |
| Middle (s,(p1,p2)) -> (try f#get_point s with |
| Middle (s,(p1,p2)) -> (try f#get_point s with |
233 |
| Not_found -> Drawing.middle (draw_point p1 f Drawing.DRAW) (draw_point p2 f Drawing.DRAW) s flag f) |
| Not_found -> Drawing.middle (draw_point p1 f Graphics.transp Drawing.DRAW) (draw_point p2 f Graphics.transp Drawing.DRAW) s col flag f) |
234 |
| Construct_point pp -> draw_point pp f Drawing.NO_DRAW |
| Construct_point pp -> draw_point pp f Graphics.transp Drawing.NO_DRAW |
235 |
| _ -> raise Error |
| _ -> raise Error |
236 |
|
|
237 |
and draw_line l f flag = |
and draw_line l f col flag = |
238 |
match l with |
match l with |
239 |
| Line (s,(p1,p2)) -> (try f#get_line s with |
| Line (s,(p1,p2)) -> (try f#get_line s with |
240 |
| Not_found -> Drawing.line (draw_point p1 f Drawing.DRAW) (draw_point p2 f Drawing.DRAW) s flag f) |
| Not_found -> Drawing.line (draw_point p1 f Graphics.transp Drawing.DRAW) (draw_point p2 f Graphics.transp Drawing.DRAW) s col flag f) |
241 |
| Ruler ll -> draw_line ll f Drawing.NO_DRAW |
| Ruler ll -> draw_line ll f Graphics.transp Drawing.NO_DRAW |
242 |
| Segment (s,(p1,p2)) -> (try f#get_line s with |
| Segment (s,(p1,p2)) -> (try f#get_line s with |
243 |
| Not_found -> Drawing.segment (draw_point p1 f Drawing.DRAW) (draw_point p2 f Drawing.DRAW) s 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) |
244 |
| Perpendicular (s,(l,p)) -> (try f#get_line s with |
| Perpendicular (s,(l,p)) -> (try f#get_line s with |
245 |
| Not_found -> Drawing.perpendicular (draw_line l f Drawing.DRAW) (draw_point p f Drawing.DRAW) s flag f) |
| Not_found -> Drawing.perpendicular (draw_line l f Graphics.transp Drawing.DRAW) (draw_point p f Graphics.transp Drawing.DRAW) s col flag f) |
246 |
| Perpendicular_segment (s,(l,p,(p1,p2))) -> (try f#get_line s with |
| Perpendicular_segment (s,(l,p,(p1,p2))) -> (try f#get_line s with |
247 |
| Not_found -> Drawing.perpendicular_seg (draw_line l f Drawing.DRAW) (draw_point p f Drawing.DRAW) (draw_point p1 f Drawing.DRAW) (draw_point p2 f Drawing.DRAW) s 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) |
248 |
| Parallel (s,(l,p)) -> (try f#get_line s with |
| Parallel (s,(l,p)) -> (try f#get_line s with |
249 |
| Not_found -> Drawing.parallel (draw_line l f Drawing.DRAW) (draw_point p f Drawing.DRAW) s flag f) |
| Not_found -> Drawing.parallel (draw_line l f Graphics.transp Drawing.DRAW) (draw_point p f Graphics.transp Drawing.DRAW) s col flag f) |
250 |
| Parallel_segment (s,(l,p,(p1,p2))) -> (try f#get_line s with |
| Parallel_segment (s,(l,p,(p1,p2))) -> (try f#get_line s with |
251 |
| Not_found -> Drawing.parallel_seg (draw_line l f Drawing.DRAW) (draw_point p f Drawing.DRAW) (draw_point p1 f Drawing.DRAW) (draw_point p2 f Drawing.DRAW) s 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) |
252 |
| Bissecting (s,(p1,p2,p3)) -> (try f#get_line s with |
| Bissecting (s,(p1,p2,p3)) -> (try f#get_line s with |
253 |
| Not_found -> Drawing.angle_bissector (draw_point p1 f Drawing.DRAW) (draw_point p2 f Drawing.DRAW) (draw_point p3 f Drawing.DRAW) s flag f) |
| 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) |
254 |
| Perpendicular_bissector (s,l) -> (try f#get_line s with |
| Perpendicular_bissector (s,l) -> (try f#get_line s with |
255 |
| Not_found -> Drawing.perpendicular_bissector (draw_line l f Drawing.DRAW) s flag f) |
| Not_found -> Drawing.perpendicular_bissector (draw_line l f Graphics.transp Drawing.DRAW) s col flag f) |
256 |
|
|
257 |
| _ -> raise Error |
| _ -> raise Error |
258 |
|
|
259 |
and draw_circle c f flag = |
and draw_circle c f col flag = |
260 |
match c with |
match c with |
261 |
| Circle (s,(o,p)) -> (try f#get_circle s with |
| Circle (s,(o,p)) -> (try f#get_circle s with |
262 |
| Not_found -> Drawing.circle (draw_point o f Drawing.DRAW) (draw_point p f Drawing.DRAW) s flag f) |
| Not_found -> Drawing.circle (draw_point o f Graphics.transp Drawing.DRAW) (draw_point p f Graphics.transp Drawing.DRAW) s col flag f) |
263 |
| Compass cc -> draw_circle cc f Drawing.NO_DRAW |
| Compass cc -> draw_circle cc f Graphics.transp Drawing.NO_DRAW |
264 |
| _ -> raise Error |
| _ -> raise Error |
265 |
|
|
266 |
let draw_figure abstract_figure drawn_figure flag = |
let draw_figure abstract_figure drawn_figure flag = |
267 |
List.iter (fun (_,p) -> draw_point p drawn_figure 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)); |
268 |
List.iter (fun (_,l) -> draw_line l drawn_figure 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)); |
269 |
List.iter (fun (_,c) -> draw_circle c drawn_figure flag;()) (List.rev !(abstract_figure.circle_list)) |
List.iter (fun (_,col,c) -> draw_circle c drawn_figure col flag;()) (List.rev !(abstract_figure.circle_list)) |
270 |
|
|
271 |
(* XML writer *) |
(* XML writer *) |
272 |
|
|
311 |
| Compass c1 -> write_circle c1 level |
| Compass c1 -> write_circle c1 level |
312 |
|
|
313 |
let write_figure abstract_figure channel = |
let write_figure abstract_figure channel = |
314 |
List.iter (fun (_,p) -> (write_point p 0) channel;()) (List.rev !(abstract_figure.point_list)); |
List.iter (fun (_,_,p) -> (write_point p 0) channel;()) (List.rev !(abstract_figure.point_list)); |
315 |
List.iter (fun (_,l) -> (write_line l 0) channel;()) (List.rev !(abstract_figure.line_list)); |
List.iter (fun (_,_,l) -> (write_line l 0) channel;()) (List.rev !(abstract_figure.line_list)); |
316 |
List.iter (fun (_,c) -> (write_circle c 0) channel;()) (List.rev !(abstract_figure.circle_list)) |
List.iter (fun (_,_,c) -> (write_circle c 0) channel;()) (List.rev !(abstract_figure.circle_list)) |
317 |
|
|
318 |
(* XML expansed writer*) |
(* XML expansed writer*) |
319 |
let rec write_point2 p col level = |
let rec write_point2 p col level = |
372 |
| Compass c1 -> write_circle2 c1 "white" level |
| Compass c1 -> write_circle2 c1 "white" level |
373 |
|
|
374 |
let write_figure2 abstract_figure channel = |
let write_figure2 abstract_figure channel = |
375 |
List.iter (fun (_,p) -> (write_point2 p "red" 0) channel;()) (List.rev !(abstract_figure.point_list)); |
List.iter (fun (_,_,p) -> (write_point2 p "red" 0) channel;()) (List.rev !(abstract_figure.point_list)); |
376 |
List.iter (fun (_,l) -> (write_line2 l "black" 0) channel;()) (List.rev !(abstract_figure.line_list)); |
List.iter (fun (_,_,l) -> (write_line2 l "black" 0) channel;()) (List.rev !(abstract_figure.line_list)); |
377 |
List.iter (fun (_,c) -> (write_circle2 c "black" 0) channel;()) (List.rev !(abstract_figure.circle_list)) |
List.iter (fun (_,_,c) -> (write_circle2 c "black" 0) channel;()) (List.rev !(abstract_figure.circle_list)) |
378 |
;; |
;; |
379 |
|
|
380 |
|
|