231 lines
5.0 KiB
OCaml
231 lines
5.0 KiB
OCaml
open Graphics;;
|
|
|
|
let window_w = 800.;;
|
|
let window_h = 800.;;
|
|
|
|
let screen_space (x, y) =
|
|
(
|
|
int_of_float ((x +. 1.) /. 2. *. window_w),
|
|
int_of_float ((1. -. (y +. 1.) /. 2.) *. window_h)
|
|
);;
|
|
|
|
let project (x, y, z) =
|
|
(x /. z, y /. z);;
|
|
|
|
let rotate_y (x, y, z) angle =
|
|
(
|
|
x *. cos(angle) -. z *. sin(angle),
|
|
y,
|
|
x *. sin(angle) +. z *. cos(angle)
|
|
);;
|
|
|
|
let rotate_x (x, y, z) angle =
|
|
(
|
|
x,
|
|
y *. cos(angle) -. z *. sin(angle),
|
|
y *. sin(angle) +. z *. cos(angle)
|
|
);;
|
|
|
|
let rotate_z (x, y, z) angle =
|
|
(
|
|
x *. cos(angle) -. y *. sin(angle),
|
|
x *. sin(angle) +. y *. cos(angle),
|
|
z
|
|
);;
|
|
|
|
let translate_x (x, y, z) dx =
|
|
(x +. dx, y, z);;
|
|
|
|
let translate_y (x, y, z) dy =
|
|
(x, y +. dy, z);;
|
|
|
|
let translate_z (x, y, z) dz =
|
|
(x, y, z +. dz);;
|
|
|
|
(* CUBE *)
|
|
let vertecies = [
|
|
(0.3, 0.3, 0.3);
|
|
(-0.3, 0.3, 0.3);
|
|
(-0.3, -0.3, 0.3);
|
|
( 0.3, -0.3, 0.3);
|
|
(0.3, 0.3, -0.3);
|
|
(-0.3, 0.3, -0.3);
|
|
(-0.3, -0.3, -0.3);
|
|
(0.3, -0.3, -0.3)
|
|
];;
|
|
|
|
let faces = [
|
|
(0, 1, 2, 3); (* front *)
|
|
(4, 5, 6, 7); (* back *)
|
|
(0, 1, 5, 4); (* top *)
|
|
(2, 3, 7, 6) (* bottom *)
|
|
];;
|
|
|
|
let draw_line va vb =
|
|
let va = project va in
|
|
let vb = project vb in
|
|
|
|
let (x1, y1) = screen_space va in
|
|
let (x2, y2) = screen_space vb in
|
|
|
|
moveto x1 y1;
|
|
lineto x2 y2;
|
|
();;
|
|
|
|
let rec get_vertex v i =
|
|
match v with
|
|
| [] -> (0., 0., 0.)
|
|
| x :: xs ->
|
|
if i = 0 then x
|
|
else get_vertex xs (i - 1);;
|
|
|
|
let draw_face (a, b, c, d) v angle =
|
|
let va = get_vertex v a in
|
|
let vb = get_vertex v b in
|
|
let vc = get_vertex v c in
|
|
let vd = get_vertex v d in
|
|
|
|
draw_line va vb;
|
|
draw_line vb vc;
|
|
draw_line vc vd;
|
|
draw_line vd va;;
|
|
|
|
let rec draw_cube faces v angle =
|
|
match faces with
|
|
| [] -> ()
|
|
| (a, b, c, d) :: fs ->
|
|
draw_face (a, b, c, d) v angle;
|
|
draw_cube fs v angle;;
|
|
(* END CUBE *)
|
|
|
|
(* SPHERE *)
|
|
let stacks = 10;;
|
|
let slices = 12;;
|
|
let radius = 0.175;;
|
|
|
|
let gen_sphere_vertecies st sl r =
|
|
let rec gen_slice j sp cp sv =
|
|
if j = -1 then sv
|
|
else
|
|
let theta = 2. *. 3.1415926 *. float_of_int j /. float_of_int sl in
|
|
let sinTheta = sin theta in
|
|
let cosTheta = cos theta in
|
|
gen_slice (j - 1) sp cp ((r *. cosTheta *. sp, r *. cp, r *. sinTheta *. sp) :: sv)
|
|
in
|
|
|
|
let rec gen_stack i sv =
|
|
if i = -1 then sv
|
|
else
|
|
let phi = 3.1415926 *. float_of_int i /. float_of_int (st - 1) in
|
|
let sinPhi = sin phi in
|
|
let cosPhi = cos phi in
|
|
gen_stack (i - 1) (gen_slice (sl - 1) sinPhi cosPhi sv)
|
|
in
|
|
|
|
gen_stack (st - 1) [];;
|
|
|
|
let s_vertecies = gen_sphere_vertecies stacks slices radius;;
|
|
|
|
let draw_ellipse ev o =
|
|
let f = match ev with
|
|
| [] -> (0., 0., 0.)
|
|
| a :: _ -> a in
|
|
|
|
let rec iter_vertex l v =
|
|
match v with
|
|
| [] -> l
|
|
| [a] -> draw_line a l; a
|
|
| [a; b] -> draw_line a b; b
|
|
| a :: b :: vs ->
|
|
draw_line a b;
|
|
iter_vertex b (b :: vs)
|
|
in
|
|
let l = iter_vertex (0., 0., 0.) ev in
|
|
|
|
if o then draw_line f l;;
|
|
|
|
let rec get_nth_vert e n =
|
|
match e with
|
|
| [] -> failwith "cannot find nth vertex"
|
|
| x :: xs ->
|
|
if n = 0 then x
|
|
else get_nth_vert xs (n - 1);;
|
|
|
|
let draw_sphere v st sl =
|
|
let rec render_slices i =
|
|
let rec iter_slices j e =
|
|
if j = sl then e
|
|
else iter_slices (j + 1) (get_nth_vert v (i * sl + j) :: e)
|
|
in
|
|
let e = iter_slices 0 [] in
|
|
draw_ellipse e true;
|
|
if i = st - 1 then ()
|
|
else render_slices (i + 1)
|
|
in
|
|
|
|
let rec render_stacks j =
|
|
let rec iter_stacks i e =
|
|
if i = st then e
|
|
else iter_stacks (i + 1) (get_nth_vert v (i * sl + j) :: e)
|
|
in
|
|
let e = iter_stacks 0 [] in
|
|
draw_ellipse e false;
|
|
if j = st + 1 then ()
|
|
else render_stacks (j + 1)
|
|
in
|
|
|
|
render_slices 0;
|
|
render_stacks 0;;
|
|
|
|
let list_transform t l d =
|
|
let rec translate r n =
|
|
match r with
|
|
| [] -> n
|
|
| x :: xs -> translate (xs) (t x d :: n)
|
|
in
|
|
|
|
translate l [];;
|
|
|
|
(* END SPHERE *)
|
|
|
|
let rec animate angle sv sqv =
|
|
clear_graph ();
|
|
|
|
set_color (rgb 0 0 0);
|
|
fill_rect 0 0 (int_of_float window_w) (int_of_float window_h);
|
|
|
|
set_color cyan;
|
|
|
|
draw_cube faces sqv angle;
|
|
draw_sphere sv stacks slices;
|
|
|
|
Graphics.synchronize ();
|
|
|
|
let nsv = gen_sphere_vertecies 10 12 0.175 in
|
|
let nsv = list_transform rotate_y nsv (-1. *. angle) in
|
|
let nsv = list_transform rotate_x nsv (-1. *. angle) in
|
|
let nsv = list_transform translate_x nsv (sin angle /. -2.) in
|
|
let nsv = list_transform translate_y nsv (cos angle /. -2.) in
|
|
let nsv = list_transform translate_z nsv (1. +. sin(angle) /. 2.) in
|
|
|
|
let nsqv = vertecies in
|
|
let nsqv = list_transform rotate_y nsqv angle in
|
|
let nsqv = list_transform rotate_x nsqv angle in
|
|
let nsqv = list_transform translate_x nsqv (sin angle) in
|
|
let nsqv = list_transform translate_y nsqv (cos angle) in
|
|
let nsqv = list_transform translate_z nsqv (2. +. (sin (-1. *. angle)) /. 2.) in
|
|
|
|
animate (angle +. 0.0005) nsv nsqv;;
|
|
|
|
let () =
|
|
let size = " " ^ (string_of_float window_w) ^ "x" ^ (string_of_float window_h) ^ "+560+140" in
|
|
Printf.printf "Size: %s\n" size;
|
|
(* open_graph size; *)
|
|
open_graph " 800x800+560+140";
|
|
|
|
auto_synchronize false;
|
|
|
|
animate 0. s_vertecies vertecies;
|
|
|
|
close_graph ()
|