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

Diff of /geocaml/src/drawing.ml

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

revision 1.5 by adoniec, Tue Sep 9 14:45:34 2003 UTC revision 1.6 by adoniec, Wed Sep 10 15:35:17 2003 UTC
# Line 48  class window (h_init,w_init) = Line 48  class window (h_init,w_init) =
48    
49  type flag_object = DRAW | NO_DRAW | ANIMATION  type flag_object = DRAW | NO_DRAW | ANIMATION
50    
51  class point (x_init,y_init) (name: string) (flag: flag_object) =  class point (x_init,y_init) (name: string) c (flag: flag_object) =
52    object(self)    object(self)
53      initializer self#draw()      initializer self#draw()
54      val mutable x = x_init      val mutable x = x_init
55      val mutable y = y_init      val mutable y = y_init
56      val mutable s = name      val mutable s = name
57      val mutable flag = flag      val mutable flag = flag
58        val mutable color = c
59      method get_x () = x      method get_x () = x
60      method get_y () = y      method get_y () = y
61      method set_x xval = x <- xval      method set_x xval = x <- xval
# Line 64  class point (x_init,y_init) (name: strin Line 65  class point (x_init,y_init) (name: strin
65        if flag=NO_DRAW then ()        if flag=NO_DRAW then ()
66        else        else
67          begin          begin
68            set_color red;            set_color color;
69            fill_circle x y 4;            fill_circle x y 4;
70            moveto (x+6) (y+6);            moveto (x+6) (y+6);
71            draw_string name;            draw_string name;
# Line 72  class point (x_init,y_init) (name: strin Line 73  class point (x_init,y_init) (name: strin
73          end          end
74      method redraw () =      method redraw () =
75        begin        begin
76          set_color red;          set_color color;
77          fill_circle x y 4;          fill_circle x y 4;
78          moveto (x+6) (y+6);          moveto (x+6) (y+6);
79          draw_string name;          draw_string name;
# Line 80  class point (x_init,y_init) (name: strin Line 81  class point (x_init,y_init) (name: strin
81        end        end
82   end   end
83    
84  class line (p1: point) (p2: point) (name: string) (flag: flag_object) =  class line (p1: point) (p2: point) (name: string) c (flag: flag_object) =
85    object(self)    object(self)
86      initializer self#draw()      initializer self#draw()
87      val mutable a = p1      val mutable a = p1
88      val mutable b = p2      val mutable b = p2
89      val mutable s = name      val mutable s = name
90      val mutable flag = flag      val mutable flag = flag
91        val mutable color = c
92      method get_a () = a      method get_a () = a
93      method get_b () = b      method get_b () = b
94      method get_dx () = a#get_x () - b#get_x ()      method get_dx () = a#get_x () - b#get_x ()
# Line 98  class line (p1: point) (p2: point) (name Line 100  class line (p1: point) (p2: point) (name
100          if flag=NO_DRAW then ()          if flag=NO_DRAW then ()
101          else          else
102            begin            begin
103              set_color black;              set_color color;
104              let (x1,y1) = min (a#get_x (),a#get_y ()) (b#get_x (),b#get_y ()) in              let (x1,y1) = min (a#get_x (),a#get_y ()) (b#get_x (),b#get_y ()) in
105              let (x2,y2) = max (a#get_x (),a#get_y ()) (b#get_x (),b#get_y ()) in              let (x2,y2) = max (a#get_x (),a#get_y ()) (b#get_x (),b#get_y ()) in
106              let dx = x2 - x1 in              let dx = x2 - x1 in
# Line 109  class line (p1: point) (p2: point) (name Line 111  class line (p1: point) (p2: point) (name
111            end            end
112      method redraw () =      method redraw () =
113        begin        begin
114          set_color black;          set_color color;
115          let (x1,y1) = min (a#get_x (),a#get_y ()) (b#get_x (),b#get_y ()) in          let (x1,y1) = min (a#get_x (),a#get_y ()) (b#get_x (),b#get_y ()) in
116          let (x2,y2) = max (a#get_x (),a#get_y ()) (b#get_x (),b#get_y ()) in          let (x2,y2) = max (a#get_x (),a#get_y ()) (b#get_x (),b#get_y ()) in
117          let dx = x2 - x1 in          let dx = x2 - x1 in
# Line 120  class line (p1: point) (p2: point) (name Line 122  class line (p1: point) (p2: point) (name
122        end        end
123  end  end
124    
125  class segment (p1: point) (p2: point) (name: string) (flag: flag_object) =  class segment (p1: point) (p2: point) (name: string) c (flag: flag_object) =
126    object    object
127      inherit line p1 p2 name flag      inherit line p1 p2 name c flag
128      method draw () =      method draw () =
129        if flag=NO_DRAW then ()        if flag=NO_DRAW then ()
130        else        else
131          begin          begin
132            set_color black;            set_color color;
133            let (x1,y1) = (a#get_x (),a#get_y ()) in            let (x1,y1) = (a#get_x (),a#get_y ()) in
134            let (x2,y2) = (b#get_x (),b#get_y ()) in            let (x2,y2) = (b#get_x (),b#get_y ()) in
135            draw_poly_line [|(x2,y2);(x1,y1)|];            draw_poly_line [|(x2,y2);(x1,y1)|];
# Line 136  class segment (p1: point) (p2: point) (n Line 138  class segment (p1: point) (p2: point) (n
138          end          end
139      method redraw () =      method redraw () =
140        begin        begin
141          set_color black;          set_color color;
142          let (x1,y1) = (a#get_x (),a#get_y ()) in          let (x1,y1) = (a#get_x (),a#get_y ()) in
143          let (x2,y2) = (b#get_x (),b#get_y ()) in          let (x2,y2) = (b#get_x (),b#get_y ()) in
144            draw_poly_line [|(x2,y2);(x1,y1)|];            draw_poly_line [|(x2,y2);(x1,y1)|];
# Line 145  class segment (p1: point) (p2: point) (n Line 147  class segment (p1: point) (p2: point) (n
147        end        end
148    end    end
149    
150  class circle (p1: point) (p2: point) (name: string) (flag: flag_object) =  class circle (p1: point) (p2: point) (name: string) c (flag: flag_object) =
151    object(self)    object(self)
152      initializer self#draw()      initializer self#draw()
153      val mutable center = p1;      val mutable center = p1;
154      val mutable radius = round (sqrt (((float_of_int (p1#get_x() - p2#get_x())**2.)) +. (((float_of_int (p1#get_y() - p2#get_y())**2.)))))      val mutable radius = round (sqrt (((float_of_int (p1#get_x() - p2#get_x())**2.)) +. (((float_of_int (p1#get_y() - p2#get_y())**2.)))))
155      val mutable s = name      val mutable s = name
156      val mutable flag = flag      val mutable flag = flag
157        val mutable color = c
158      method get_center () = center      method get_center () = center
159      method get_radius () = radius      method get_radius () = radius
160      method set_radius r = radius <- r      method set_radius r = radius <- r
# Line 161  class circle (p1: point) (p2: point) (na Line 164  class circle (p1: point) (p2: point) (na
164        else        else
165          if flag=ANIMATION then          if flag=ANIMATION then
166            begin            begin
167                set_color color;
168              let teta = ref 0. in              let teta = ref 0. in
169              let rf = float_of_int radius in              let rf = float_of_int radius in
170              let xf = float_of_int (center#get_x ()) and yf = float_of_int (center#get_y ()) in              let xf = float_of_int (center#get_x ()) and yf = float_of_int (center#get_y ()) in
# Line 176  class circle (p1: point) (p2: point) (na Line 180  class circle (p1: point) (p2: point) (na
180            end            end
181          else          else
182            begin            begin
183                set_color color;
184              draw_circle (center#get_x ()) (center#get_y ()) radius;              draw_circle (center#get_x ()) (center#get_y ()) radius;
185              center#draw();              center#draw();
186              p2#draw()              p2#draw()
187            end            end
188      method redraw () =      method redraw () =
189        begin        begin
190            set_color color;
191          draw_circle (center#get_x ()) (center#get_y ()) radius;          draw_circle (center#get_x ()) (center#get_y ()) radius;
192          center#draw();          center#draw();
193          p2#draw()          p2#draw()
# Line 278  class figure (x,y) = Line 284  class figure (x,y) =
284    
285    end    end
286    
287  let point (x,y) name (flag: flag_object) (fig: figure) =  let point (x,y) name col (flag: flag_object) (fig: figure) =
288    let p = new point (x,y) name flag in    let p = new point (x,y) name col flag in
289    (fig#add_point p;p)    (fig#add_point p;p)
290    
291  let point_on_line (l: line) name (flag: flag_object) (fig: figure) =  let point_on_line (l: line) name col (flag: flag_object) (fig: figure) =
292    if l#get_dx () = 0 then    if l#get_dx () = 0 then
293      let (y1,y2) = ((l#get_a())#get_y (),(l#get_b())#get_y ()) in      let (y1,y2) = ((l#get_a())#get_y (),(l#get_b())#get_y ()) in
294      let y = (min y1 y2) + Random.int (abs(y1-y2)) in      let y = (min y1 y2) + Random.int (abs(y1-y2)) in
295      point ((l#get_a())#get_x (),y) name flag fig      point ((l#get_a())#get_x (),y) name col flag fig
296    else    else
297      let (x1,x2) = ((l#get_a())#get_x (),(l#get_b())#get_x ()) in      let (x1,x2) = ((l#get_a())#get_x (),(l#get_b())#get_x ()) in
298      let x = (min x1 x2) + Random.int (abs(x1-x2)) in      let x = (min x1 x2) + Random.int (abs(x1-x2)) in
299      point (x,int_of_float((l#get_m ()) *. float(x) +. (l#get_p ()))) name flag fig      point (x,int_of_float((l#get_m ()) *. float(x) +. (l#get_p ()))) name col flag fig
300    
301  let point_on_circle (c: circle) name (flag: flag_object) (fig: figure) =  let point_on_circle (c: circle) name col (flag: flag_object) (fig: figure) =
302    let (xcenter,ycenter) = (float((c#get_center())#get_x()),float((c#get_center())#get_y())) in    let (xcenter,ycenter) = (float((c#get_center())#get_x()),float((c#get_center())#get_y())) in
303    let radius = float(c#get_radius()) in    let radius = float(c#get_radius()) in
304    let x = xcenter -. radius +. Random.float (2.*.radius) in    let x = xcenter -. radius +. Random.float (2.*.radius) in
# Line 300  let point_on_circle (c: circle) name (fl Line 306  let point_on_circle (c: circle) name (fl
306    let b = -2.*.ycenter in    let b = -2.*.ycenter in
307    let c = ycenter**2. -. radius**2. +. (x-.xcenter)**2. in    let c = ycenter**2. -. radius**2. +. (x-.xcenter)**2. in
308    let l = List.map ( fun a -> (round(x),round(a)) ) (solve (a,b,c)) in    let l = List.map ( fun a -> (round(x),round(a)) ) (solve (a,b,c)) in
309    if (Random.int 2)=0 then point (List.hd l) name flag fig    if (Random.int 2)=0 then point (List.hd l) name col flag fig
310    else point (List.hd (List.rev l)) name flag fig    else point (List.hd (List.rev l)) name col flag fig
311    
312  let line (a: point) (b: point) name (flag: flag_object) (fig: figure) =  let line (a: point) (b: point) name col (flag: flag_object) (fig: figure) =
313    let l = new line a b name flag in    let l = new line a b name col flag in
314    (fig#add_line l;l)    (fig#add_line l;l)
315    
316  let segment (a: point) (b: point) name (flag: flag_object) (fig: figure) =  let segment (a: point) (b: point) name col (flag: flag_object) (fig: figure) =
317    let s = new segment a b name flag in    let s = new segment a b name col flag in
318    (fig#add_segment s;s)    (fig#add_segment s;s)
319    
320  let circle (a: point) (b: point) name (flag: flag_object) (fig: figure) =  let circle (a: point) (b: point) name col (flag: flag_object) (fig: figure) =
321    let c = new circle a b name flag in    let c = new circle a b name col flag in
322    (fig#add_circle c;c)    (fig#add_circle c;c)
323    
324  let middle (a: point) (b: point) name (flag: flag_object) (fig: figure) =  let middle (a: point) (b: point) name col (flag: flag_object) (fig: figure) =
325    point ((a#get_x () + b#get_x ())/2,(a#get_y () + b#get_y ())/2) name flag fig    point ((a#get_x () + b#get_x ())/2,(a#get_y () + b#get_y ())/2) name col flag fig
326    
327  let perpendicular (l: line) (p: point) name (flag: flag_object) (fig: figure) =  let perpendicular (l: line) (p: point) name col (flag: flag_object) (fig: figure) =
328    let p2 = point (p#get_x () + l#get_dy (),p#get_y () - l#get_dx ()) (Generate.point_name ()) NO_DRAW fig in    let p2 = point (p#get_x () + l#get_dy (),p#get_y () - l#get_dx ()) (Generate.point_name ()) transp NO_DRAW fig in
329    line p p2 name flag fig    line p p2 name col flag fig
330    
331  let perpendicular_seg (l: line) (p: point) (p1: point) (p2: point) name (flag: flag_object) (fig: figure) =  let perpendicular_seg (l: line) (p: point) (p1: point) (p2: point) name col (flag: flag_object) (fig: figure) =
332    let length1 = (sqrt (((float_of_int (p1#get_x() - p2#get_x())**2.)) +. (((float_of_int (p1#get_y() - p2#get_y())**2.))))) in    let length1 = (sqrt (((float_of_int (p1#get_x() - p2#get_x())**2.)) +. (((float_of_int (p1#get_y() - p2#get_y())**2.))))) in
333    let length2 = (sqrt (((float_of_int (l#get_dx ())**2.)) +. (((float_of_int (l#get_dy ())**2.))))) in    let length2 = (sqrt (((float_of_int (l#get_dx ())**2.)) +. (((float_of_int (l#get_dy ())**2.))))) in
334    let length = length1 /. length2 in    let length = length1 /. length2 in
335    let x = round ((float_of_int (l#get_dy ())) *. length) in    let x = round ((float_of_int (l#get_dy ())) *. length) in
336    let y = round ((float_of_int (l#get_dx ())) *. length) in    let y = round ((float_of_int (l#get_dx ())) *. length) in
337    let p3 = point (p#get_x () + x,p#get_y () - y) (Generate.point_name ()) NO_DRAW fig in    let p3 = point (p#get_x () + x,p#get_y () - y) (Generate.point_name ()) transp NO_DRAW fig in
338    segment p p3 name flag fig    segment p p3 name col flag fig
339    
340  let parallel (l: line) (p: point) name (flag: flag_object) (fig: figure) =  let parallel (l: line) (p: point) name col (flag: flag_object) (fig: figure) =
341    let p2 = point (p#get_x () - l#get_dx (),p#get_y () - l#get_dy ()) (Generate.point_name ()) NO_DRAW fig in    let p2 = point (p#get_x () - l#get_dx (),p#get_y () - l#get_dy ()) (Generate.point_name ()) transp NO_DRAW fig in
342    line p p2 name flag fig    line p p2 name col flag fig
343    
344  let parallel_seg (l: line) (p: point) (p1: point) (p2: point) name (flag: flag_object) (fig: figure) =  let parallel_seg (l: line) (p: point) (p1: point) (p2: point) name col (flag: flag_object) (fig: figure) =
345    let length1 = (sqrt (((float_of_int (p1#get_x() - p2#get_x())**2.)) +. (((float_of_int (p1#get_y() - p2#get_y())**2.))))) in    let length1 = (sqrt (((float_of_int (p1#get_x() - p2#get_x())**2.)) +. (((float_of_int (p1#get_y() - p2#get_y())**2.))))) in
346    let length2 = (sqrt (((float_of_int (l#get_dx ())**2.)) +. (((float_of_int (l#get_dy ())**2.))))) in    let length2 = (sqrt (((float_of_int (l#get_dx ())**2.)) +. (((float_of_int (l#get_dy ())**2.))))) in
347    let length = length1 /. length2 in    let length = length1 /. length2 in
348    let x = round ((float_of_int (l#get_dx ())) *. length) in    let x = round ((float_of_int (l#get_dx ())) *. length) in
349    let y = round ((float_of_int (l#get_dy ())) *. length) in    let y = round ((float_of_int (l#get_dy ())) *. length) in
350    let p3 = point (p#get_x () - x,p#get_y () - y) (Generate.point_name ()) NO_DRAW fig in    let p3 = point (p#get_x () - x,p#get_y () - y) (Generate.point_name ()) transp NO_DRAW fig in
351    segment p p3 name flag fig    segment p p3 name col flag fig
352    
353  let perpendicular_bissector (l: line) name (flag: flag_object) (fig: figure) =  let perpendicular_bissector (l: line) name col (flag: flag_object) (fig: figure) =
354    let a = l#get_a () in    let a = l#get_a () in
355    let b = l#get_b () in    let b = l#get_b () in
356    let i = middle a b (Generate.point_name ()) NO_DRAW fig in    let i = middle a b (Generate.point_name ()) transp NO_DRAW fig in
357    perpendicular l i name flag fig    perpendicular l i name col flag fig
358    
359  let angle_bissector (b: point) (a: point) (c: point) name (flag: flag_object) (fig: figure) =  let angle_bissector (b: point) (a: point) (c: point) name col (flag: flag_object) (fig: figure) =
360    let d1 = sqrt (((float_of_int (a#get_x() - b#get_x())**2.)) +. (((float_of_int (a#get_y() - b#get_y())**2.)))) in    let d1 = sqrt (((float_of_int (a#get_x() - b#get_x())**2.)) +. (((float_of_int (a#get_y() - b#get_y())**2.)))) in
361    let d2 = sqrt (((float_of_int (a#get_x() - c#get_x())**2.)) +. (((float_of_int (a#get_y() - c#get_y())**2.)))) in    let d2 = sqrt (((float_of_int (a#get_x() - c#get_x())**2.)) +. (((float_of_int (a#get_y() - c#get_y())**2.)))) in
362    let d = d1 /. d2 in    let d = d1 /. d2 in
363    let (x,y) = (float(a#get_x()) +. float(c#get_x()-a#get_x())*.d,float(a#get_y()) +. float(c#get_y()-a#get_y())*.d) in    let (x,y) = (float(a#get_x()) +. float(c#get_x()-a#get_x())*.d,float(a#get_y()) +. float(c#get_y()-a#get_y())*.d) in
364    let (x',y') = ((b#get_x() + round(x))/2,(b#get_y() + round(y))/2) in    let (x',y') = ((b#get_x() + round(x))/2,(b#get_y() + round(y))/2) in
365    let p = point (x',y') (Generate.point_name ()) NO_DRAW fig in    let p = point (x',y') (Generate.point_name ()) transp NO_DRAW fig in
366    line a p name flag fig    line a p name col flag fig
367    
368  let inter_ll (l1: line) (l2: line) name (flag: flag_object) (fig: figure) =  let inter_ll (l1: line) (l2: line) name col (flag: flag_object) (fig: figure) =
369    let (x,y) =    let (x,y) =
370      if l1#get_dx () = 0 then      if l1#get_dx () = 0 then
371        begin        begin
# Line 374  let inter_ll (l1: line) (l2: line) name Line 380  let inter_ll (l1: line) (l2: line) name
380          end          end
381        else        else
382          line_with_line (l1#get_m (),l1#get_p ()) (l2#get_m (),l2#get_p ()) in          line_with_line (l1#get_m (),l1#get_p ()) (l2#get_m (),l2#get_p ()) in
383    point (x,y) name flag fig    point (x,y) name col flag fig
384    
385  let inter_lc (l: line) (c: circle) name1 name2 (flag: flag_object) (fig: figure) =  let inter_lc (l: line) (c: circle) name1 name2 col (flag: flag_object) (fig: figure) =
386    let o = c#get_center () in    let o = c#get_center () in
387    let r = c#get_radius () in    let r = c#get_radius () in
388    let l =    let l =
# Line 393  let inter_lc (l: line) (c: circle) name1 Line 399  let inter_lc (l: line) (c: circle) name1
399    in    in
400    let (x1,y1) = List.hd l and (x2,y2) = List.hd (List.rev l) in    let (x1,y1) = List.hd l and (x2,y2) = List.hd (List.rev l) in
401    if (x1,y1) = (x2,y2) then    if (x1,y1) = (x2,y2) then
402      let p = point (x1,y1) name1 flag fig in (p,p)      let p = point (x1,y1) name1 col flag fig in (p,p)
403    else    else
404      let (p1,p2) = (point (x1,y1) name1 flag fig,point (x2,y2) name2 flag fig) in (p1,p2)      let (p1,p2) = (point (x1,y1) name1 col flag fig,point (x2,y2) name2 col flag fig) in (p1,p2)
405    
406  let inter_cc (c1: circle) (c2: circle) name1 name2 (flag: flag_object) (fig: figure) =  let inter_cc (c1: circle) (c2: circle) name1 name2 col (flag: flag_object) (fig: figure) =
407    let o1 = c1#get_center () in    let o1 = c1#get_center () in
408    let o2 = c2#get_center () in    let o2 = c2#get_center () in
409    let r1 = c1#get_radius () in    let r1 = c1#get_radius () in
# Line 405  let inter_cc (c1: circle) (c2: circle) n Line 411  let inter_cc (c1: circle) (c2: circle) n
411    let l = circle_with_circle (float(o1#get_x()),float(o1#get_y())+.0.01,float(r1)) (float(o2#get_x()),float(o2#get_y()),float(r2)) in    let l = circle_with_circle (float(o1#get_x()),float(o1#get_y())+.0.01,float(r1)) (float(o2#get_x()),float(o2#get_y()),float(r2)) in
412    let (x1,y1) = List.hd l and (x2,y2) = List.hd (List.rev l) in    let (x1,y1) = List.hd l and (x2,y2) = List.hd (List.rev l) in
413    if (x1,y1) = (x2,y2) then    if (x1,y1) = (x2,y2) then
414      let p = point (x1,y1) name1 flag fig in (p,p)      let p = point (x1,y1) name1 col flag fig in (p,p)
415    else    else
416      let (p1,p2) = (point (x1,y1) name1 flag fig,point (x2,y2) name2 flag fig) in (p1,p2)      let (p1,p2) = (point (x1,y1) name1 col flag fig,point (x2,y2) name2 col flag fig) in (p1,p2)
417    
418  ;;  ;;
419    

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

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