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 |
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; |
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; |
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 () |
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 |
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 |
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)|]; |
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)|]; |
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 |
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 |
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() |
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 |
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 |
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 = |
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 |
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 |
|
|