open Mlpost
(* Helpers *)
let tex = Box.tex ~dx:(Num.cm 0.1) ~dy:(Num.cm 0.05)
let texttt s = "\\texttt{" ^ s ^ "}"
let string_of_color c = match c with
| _ when c = Color.orange -> "orange"
| _ when c = Color.blue -> "blue"
| _ when c = Color.white -> "white"
| _ -> "black"
let textcolor color s =
"\\textcolor{" ^ (string_of_color color) ^ "}{" ^ s ^ "}"
let code s = tex (texttt s)
let middle p1 p2 =
let p = Point.add p1 p2 in
Point.mult (Num.of_float 0.5) p
let path points = Path.pathp ~style:Path.jLine points
let arrow points =
Box.pic (Arrow.simple (path points))
let point_x_y px py = Point.pt (Point.xpart px, Point.ypart py)
(* Boxes *)
let cell1 = code "x++;"
let cell2 = code "f(\\&x);"
let cell3 = code "y = x;"
let cell4 = code "void f(int* x) \\{"
let cell5 = code "\\quad ...\\textcolor{white}{A}"
let cell6 = code "\\quad return; \\}"
let place_below c1 c2 = Box.place `Southwest ~pos:`Northwest c1 c2
let cell2 = place_below cell1 cell2
let cell3 = place_below cell2 cell3
let cell4 = Box.place `East ~pos:`West ~padding:(Num.cm 1.5) cell1 cell4
let place c1 c2 =
let target = point_x_y (Box.west cell4) (Box.east c1) in
let target = Box.center target (Box.empty ()) in
Box.place `Center ~pos:`West target c2
let cell5 = place cell2 cell5
let cell6 = place cell3 cell6
(* Arrows *)
let arrow1 =
let p1 = Box.east cell2 in
let p4 = Box.west cell4 in
let x = Point.xpart (middle p1 p4) in
let p2 = Point.pt (x, Point.ypart p1) in
let p3 = Point.pt (x, Point.ypart p4) in
arrow [p1 ; p2 ; p3 ; p4]
let arrow2 =
let p1 = Box.west cell6 in
let p2 = Box.east cell3 in
arrow [p1 ; p2]
let delta_x = 0.1
let delta_y = 0.025
let shift_x x = Point.shift (Point.pt (Num.cm x, Num.zero))
let shift_y y = Point.shift (Point.pt (Num.zero, Num.cm y))
let shift_right = shift_x delta_x
let shift_left = shift_x (-.delta_x)
let shift_up = shift_y delta_y
let shift_down = shift_y (-.delta_y)
let scope x pos ?tex color p1 p2 =
let p1 = shift_down p1 in
let p0 = shift_x x p1 in
let p2 = shift_up p2 in
let p3 = shift_x x p2 in
let path = Box.pic (Path.draw ~color (path [p0 ; p1 ; p2 ; p3])) in
match tex with
| None -> path
| Some tex ->
let tex = Box.tex (textcolor color tex) in
let target = Box.center p1 (Box.empty ()) in
let tex = Box.place `Center ~pos target tex in
Box.group [tex ; path]
let scope_left = scope delta_x `Northeast
let scope_right = scope (-.delta_x) `Northwest
let pscope1 = Box.north_west cell1
let pscope2 =
let p = Box.south_west cell2 in
point_x_y pscope1 p
let pscope3 =
let p = Box.south_west cell3 in
point_x_y pscope1 p
let pscope4 = Box.north_east cell4
let pscope5 =
let p = middle (Box.north_east cell5) (Box.south_east cell5) in
point_x_y pscope4 p
let pscope6 =
let p = Box.south_east cell6 in
point_x_y pscope4 p
let scope1 color =
scope_left ~tex:"scope$_1$" color pscope1 pscope2
let scope2 color =
scope_right color pscope4 pscope5
let scope3 color =
scope_right ~tex:"scope$_2$" color pscope5 pscope6
let scope4 color =
scope_left color pscope2 pscope3
let scope5 = scope1 Color.orange
let scope6 = scope2 Color.orange
let scope7 = scope3 Color.blue
let scope8 = scope4 Color.blue
let scope1 = scope1 Color.white
let scope2 = scope2 Color.white
let scope3 = scope3 Color.white
let scope4 = scope4 Color.white
let scope9 = scope_left ~tex:"scope$_1$" Color.orange pscope1 pscope3
let scope10 = scope_right ~tex:"scope$_2$" Color.blue pscope4 pscope6
(* Call *)
let call scope =
let (arrows, scopes) = match scope with
| 1 -> ([arrow1 ; arrow2], [scope1 ; scope2 ; scope3 ; scope4])
| 2 -> ([arrow1 ; arrow2], [scope5 ; scope6 ; scope7 ; scope8])
| _ -> ([], [scope9 ; scope10]) in
Box.group ([cell1 ; cell2 ; cell3 ; cell4 ; cell5 ; cell6] @
arrows @ scopes)
(* Main *)
let result1 = call 1
let result2 = call 2
let result3 = call 3
(* Output pictures *)
let results = [result1 ; result2 ; result3]
let results = List.map Box.draw results
let iteri f =
let rec aux i = function
| [] -> []
| e :: l -> f i e ; aux (i+1) l
in
aux 1
let _ =
iteri (fun i b -> Metapost.emit ("call" ^ (string_of_int i)) b) results