tree display

pretty_printing.ml

@@ -352,7 +352,7 @@ fancy_dfs gr coords map blank_color_map ;;
 (* --------------------------------------------------------------------------------------------------------- *)
 open Graphics ;;
 
-type 'a tree = Leaf of 'a | Node of 'a * 'a tree * 'a tree ;;
+type 'a tree = Empty | Leaf of 'a | Node of 'a * 'a tree * 'a tree ;;
 
 (* 
 STRUCT : (digit, xcoord, ycoord) 
@@ -366,45 +366,131 @@ let rec pw x n = match n with
 
 let rec depth_of_tree t = match t with
     | Leaf _ -> 1
-    | Node (_, g, d) -> 1 + max (depth_of_tree g) (depth_of_tree d) ;;
+    | Node (_, g, d) -> 1 + max (depth_of_tree g) (depth_of_tree d) 
+    | Empty -> 0;;
 
 let fill_data te ystep sx sy r =
     let depth = depth_of_tree te in
     let res = Array.make (depth+1) [] in
-    let rec aux t cur_x cur_d spacing = match t with
+    let rec aux t cur_x cur_d spacing pcx pcy = match t with
         | Node (x, g, d) -> begin
-            aux g (cur_x - spacing) (cur_d+1) (spacing/2);
-            res.(cur_d) <- ((x, (cur_x, sy - r - ystep * cur_d)))::(res.(cur_d));
-            aux d (cur_x + spacing) (cur_d+1) (spacing/2);
+            aux g (cur_x - spacing) (cur_d+1) (spacing/2) cur_x (sy - r - 20 - ystep * cur_d);
+            res.(cur_d) <- (((x, (pcx, pcy)), (cur_x, sy - r - 20 - ystep * cur_d)))::(res.(cur_d));
+            aux d (cur_x + spacing) (cur_d+1) (spacing/2) cur_x (sy - r - 20 - ystep * cur_d);
         end
         | Leaf x -> begin
-            res.(cur_d) <- ((x, (cur_x, sy - r - ystep * cur_d)))::(res.(cur_d));
+            res.(cur_d) <- (((x, (pcx, pcy)), (cur_x, sy - r - ystep * cur_d)))::(res.(cur_d));
         end
-    in aux te (sx/2) 0 (r/2 + r * ((pw 2 (depth-1)) - 1)); res ;;
+        | Empty -> ()
+    in aux te (sx/2) 0 (r/2 + r * ((pw 2 (depth-1)) - 1)) (-1) (-1); res ;;
+
+let rec ln10 n = match n with
+    | k when k < 0 -> failwith "Are you sure about that ?"
+    | k when k < 10 -> 0
+    | k -> 1 + ln10 (k/10) ;;
+
+let delta i j =
+    if i = j then 1 else 0 ;;
+
+let draw_integer x0 y n0 r =
+    (* 7-seg display *)
+    let n = ref n0 in
+    let size = ln10 n0 in
+    let len = r/3 in
+    let offset = size*(len/2) in
+    for i = 0 to size do
+        let x = -(1 - delta size 0)*4 + x0 - offset + i * (len+8) in
+        if Array.mem (!n mod 10) [|0; 4; 5; 6; 7; 8; 9|] then
+            draw_poly_line [|(x-len/2, y+len); (x-len/2, y)|];
+
+        if Array.mem (!n mod 10) [|0; 2; 3; 5; 6; 7; 8; 9|] then
+            draw_poly_line [|(x-len/2, y+len); (x+len/2, y+len)|];
+
+        if Array.mem (!n mod 10) [|0; 1; 2; 3; 4; 7; 8; 9|] then
+            draw_poly_line [|(x+len/2, y+len); (x+len/2, y)|];
+
+        if Array.mem (!n mod 10) [|2; 3; 4; 5; 6; 8; 9|] then
+            draw_poly_line [|(x-len/2, y); (x+len/2, y)|];
+
+        if Array.mem (!n mod 10) [|0; 1; 3; 4; 5; 6; 7; 8; 9|] then
+            draw_poly_line [|(x+len/2, y-len); (x+len/2, y)|];
+
+        if Array.mem (!n mod 10) [|0; 2; 3; 5; 6; 8; 9|] then
+            draw_poly_line [|(x-len/2, y-len); (x+len/2, y-len)|];
+
+        if Array.mem (!n mod 10) [|0; 2; 6; 8|] then
+            draw_poly_line [|(x-len/2, y-len); (x-len/2, y)|];
+
+        n := !n/10;
+    done ;;
 
 let rec draw_list l d r = match l with
     | [] -> ()
-    | h::t -> draw_circle (fst (snd h)) (snd (snd h)) r; draw_list t d r ;;
+    | h::t -> begin
+        set_color (rgb 192 192 192);
+        fill_circle (fst (snd h)) (snd (snd h)) r;
+        set_color black;
+        draw_circle (fst (snd h)) (snd (snd h)) r;
+        moveto (fst (snd h)) (snd (snd h)); 
+        set_color (rgb 32 192 32);
+        draw_integer (fst (snd h)) (snd (snd h)) (fst (fst h)) r; 
+        draw_list t d r 
+    end;;
+
+let connect l0 =
+    let rec aux l = match l with
+        | [] -> ()
+        | ((_, (xf, yf)), (x, y))::t -> 
+            if xf >= 0 && yf >= 0 then begin
+                set_color (rgb 192 192 192);
+                draw_poly_line [|(xf, yf); (x, y)|];
+                aux t
+            end
+    in aux l0 ;;
 
 let even_more_pretty_printing t r ystep =
-    open_graph " 1600x800" ;
+    open_graph " 1800x800" ;
+    set_window_title "Trees" ;
+
     let sx = Graphics.size_x () in
     let sy = Graphics.size_y () in
 
-    let graphdata = fill_data t ystep sx sy r in
+    let graphdata = fill_data t ystep sx sy (3*r/4) in
+    (* graphdata is a ((int * (int * int)) * (int * int)) list array *)
 
-    print_int 3;
+    set_color (rgb 192 192 192);
+    set_line_width 15 ;
+    for dpth = 1 to (Array.length graphdata -1) do
+        connect graphdata.(dpth-1);
+    done;
 
+    set_line_width 5 ;
     for dpth = 0 to (Array.length graphdata -1) do
         draw_list graphdata.(dpth) dpth r
     done;
 
-    ignore (Sys.command "sleep 1");
+    let halt = ref false in 
+    while !halt = false do
+        Unix.sleepf 0.1 ;
+        Unix.sleepf 2.0 ;
+        halt := true;
+    done;
 
     close_graph () ;
     () ;;
 
-even_more_pretty_printing (Node (2, Node (3, Leaf 1, Leaf 6), Node (9, Leaf 0, Node (4, Leaf 0, Node (2, Leaf 5, Leaf 2))))) 25 100 ;
+(* --------------------------------------| TESTS |-------------------------------------- *)
+Random.self_init ;;
+
+let generate_full_graph d = 
+    let rec aux n = match n with
+    | 0 -> Leaf (Random.int 99)
+    | k -> begin 
+        Node (Random.int 99, aux (n-1), aux (n-1))
+    end 
+    in aux d ;;
+
+even_more_pretty_printing (generate_full_graph 3) 40 100 ;
 
 (* compilation command : ocamlfind ocamlc -linkpkg -package unix -linkpkg -package graphics pretty_printing.ml *)
 print_int 0 ;;