open Syntax open Graph let max = function (x,y) when x y | (x,_) -> x let rec expr_height = function Var(_) -> 1 | Num(_) -> 1 | Op(_,l,r) -> 1 + (max (expr_height l, expr_height r)) let rec expr_size = function Var(_) -> 1 | Num(_) -> 1 | Op(_,l,r) -> 1 + (expr_size l) + (expr_size r) let x_comp = function (x,_) -> x let y_comp = function (_,y) -> y let text_width t = let (x,_) = Graph.text_size t in x let text_height t = let (_,y) = Graph.text_size t in y exception ReallyShouldNotOccur let rec draw_expr e p1 p2 = let w = p2.x - p1.x in let h = p2.y - p1.y in let h1 = h / (expr_height e) in let h2 = h - h1 in let text = match e with Var x -> x | Num x -> string_of_int x | Op(o,_,_) -> match o with Plus -> "+" | Minus -> "-" | Mal -> "*" in let p = {x = p1.x + (w - (text_width text))/2 ; y = p1.y + h2 + (h1 - (text_height text))/2 } in ( Text(p, text) ) :: match e with Op(_,l,r) -> ( let esl = expr_size l in let wl = w * esl / (1 + esl + (expr_size r)) in let p1l = p1 in let p2l = { x = p1.x + wl ; y = p1.y + h2 } in let p1r = { x = p1.x + wl ; y = p1.y } in let p2r = { x = p1.x + w ; y = p1.y + h2 } in let left_tree = draw_expr l p1l p2l in let right_tree = draw_expr r p1r p2r in match (left_tree, right_tree) with (((Text(ql,xl))::_) , (Text(qr,xr))::_) -> let lines = [ Segment( {x=p1l.x + w/2 ; y=p.y - 2}, {x=ql.x + (text_width xl)/2 ; y=ql.y + (text_height xl) + 2} ) ; Segment( {x=p1l.x + w/2 ; y=p.y - 2}, {x=qr.x + (text_width xr)/2 ; y=qr.y + (text_height xr) + 2} ) ] in lines @ left_tree @ right_tree | _ -> raise ReallyShouldNotOccur ) | _ -> []