diff --git a/a.out b/a.out index 4711fa8..eb7637b 100755 Binary files a/a.out and b/a.out differ diff --git a/pretty_printing.cmi b/pretty_printing.cmi index ac021a1..3043dfc 100644 Binary files a/pretty_printing.cmi and b/pretty_printing.cmi differ diff --git a/pretty_printing.cmo b/pretty_printing.cmo index 805df6b..9cf902d 100644 Binary files a/pretty_printing.cmo and b/pretty_printing.cmo differ diff --git a/pretty_printing.ml b/pretty_printing.ml index 863cc86..4f5bd26 100644 --- a/pretty_printing.ml +++ b/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 ;;