/[geocaml]/geocaml/src/geom.ml
ViewVC logotype

Diff of /geocaml/src/geom.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.4 by adoniec, Tue Sep 9 14:46:42 2003 UTC revision 1.5 by adoniec, Wed Sep 10 15:35:59 2003 UTC
# Line 26  and Line 26  and
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    
# Line 36  exception Error Line 36  exception Error
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
# Line 46  let get_line name fig = Line 46  let get_line name fig =
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
# Line 55  let get_line name fig = Line 55  let get_line name fig =
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
# Line 94  and circle_depend_of abr name = Line 94  and circle_depend_of abr name =
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
# Line 215  let rec expand_line l = Line 215  let rec expand_line l =
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    
# Line 311  and write_circle c level= Line 311  and write_circle c level=
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 =
# Line 372  and write_circle2 c col level= Line 372  and write_circle2 c 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    

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26