source: Deliverables/Dissemination/final-review/wp5/Pics/compilation2.ml @ 3282

Last change on this file since 3282 was 3282, checked in by regisgia, 7 years ago
  • WP5 slides for the final review.
File size: 3.6 KB
Line 
1
2open Mlpost;;
3open Box;;
4open Arrow;;
5open Path;;
6open Command;;
7open Num;;
8open Dash;;
9open Color;;
10open Pen;;
11open Point;;
12open Picture;;
13
14
15let box = Box.box ~stroke:None ~dx:zero ~dy:zero
16let path = Box.path ~stroke:None ~dx:zero ~dy:zero
17let pic = Box.pic ~stroke:None ~dx:zero ~dy:zero
18
19
20(* Helpers *)
21
22let mapi f =
23  let rec aux i = function
24    | [] -> []
25    | e :: l -> (f i e) :: (aux (i+1) l)
26  in
27  aux 0
28
29let foldi f l a =
30  let rec aux i acc = function
31    | [] -> acc
32    | e :: l -> aux (i+1) (f i e acc) l in
33  aux 0 a l
34
35
36(* Text *)
37
38let make_name i j = (string_of_int i) ^ (string_of_int j)
39
40let text_scriptsize text = "\\scriptsize{" ^ text ^ "}"
41
42let color_text color text = "\\textcolor{" ^ color ^ "}{" ^ text ^ "}"
43
44let emph_text = color_text "red"
45let invisible_text = color_text "white"
46
47let lang_emph lang emph =
48  let text = if emph then emph_text lang else lang in
49  Box.tex text
50
51let clang = lang_emph "$\\Clang$"
52let clight = lang_emph "$\\Clight$"
53let cminor = lang_emph "$\\Cminor$"
54let rtl_abs = lang_emph "$\\RTLabs$"
55let rtl = lang_emph "$\\RTL$"
56let ertl = lang_emph "$\\ERTL$"
57let ltl = lang_emph "$\\LTL$"
58let lin = lang_emph "$\\LIN$"
59let mips = lang_emph "$\\MIPS$"
60let i8051 = lang_emph "$\\Eighty$"
61let nothing _ = Box.empty ()
62
63
64(* Place Text *)
65
66let langs =
67  [[clang ; clight ; cminor ; rtl_abs ; rtl ; ertl ; ltl ; lin ; mips] ;
68   [nothing ; nothing ; nothing ; nothing ; rtl ; ertl ; ltl ; lin ; i8051]]
69
70let size = List.length langs
71let row_size = if size = 0 then 0 else List.length (List.hd langs)
72
73let langs emphs =
74  let f_col i j c =
75    let name = make_name i j in
76    let c = c (List.mem j emphs) in
77    box ~name c in
78  let f_row i l = mapi (f_col i) l in
79  mapi f_row langs
80
81let langs emphs = match langs emphs with
82  | [] -> Box.empty ()
83  | l :: langs ->
84    let f_col i j c res =
85      let b = Box.get (make_name i j) res in
86      let c = Box.place `South ~pos:`North ~padding:(Num.cm 0.25) b c in
87      Box.group [res ; c] in
88    let f_row i l res = foldi (f_col i) l res in
89    foldi f_row langs (Box.hbox ~padding:(cm 0.5) l)
90
91
92(* Strokes and arrows *)
93
94let colored_kind color =
95  let head = Arrow.head_triangle_full ~color in
96  Arrow.add_line ~color (Arrow.add_head ~head Arrow.empty)
97
98let from_top langs j i =
99  let p1 = Box.south (Box.get (make_name 0 j) langs) in
100  let p3 = Box.west (Box.get (make_name i (j+1)) langs) in
101  let p2 = Point.pt (Point.xpart p1, Point.ypart p3) in
102  pic (Arrow.simple (Path.pathp ~style:Path.jLine [p1 ; p2 ; p3]))
103
104let lang_arrow langs i j1 j2 =
105  let get j = Box.get (make_name i j) langs in
106  pic (Arrow.box_to_box (get j1) (get j2))
107
108let rec arrow_from langs i j =
109  if j >= row_size - 1 then []
110  else (lang_arrow langs i j (j+1)) ::
111       (arrow_from langs i (j+1))
112
113let arrows_top langs =
114  if size = 0 then []
115  else arrow_from langs 0 0
116
117let arrows_row langs i =
118  let rtlabs_pos = 3 in
119  (from_top langs rtlabs_pos i) :: (arrow_from langs i (rtlabs_pos + 1))
120
121let rec arrows_rows langs i =
122  if i >= size then []
123  else
124    (if i = 0 then arrows_top langs else arrows_row langs i) @
125    (arrows_rows langs (i+1))
126
127let arrows langs =
128  Box.group (arrows_rows langs 0)
129
130
131(* Main *)
132
133let compilation emphed_langs =
134  let langs = langs emphed_langs in
135  let arrows = arrows langs in
136  Box.group [arrows ; langs]
137
138let compilation21 = compilation []
139
140let compilation22 = compilation [1 ; 4]
141
142let compilation =
143  [("compilation21", compilation21) ; ("compilation22", compilation22)]
144
145let compilation =
146  let f (name, box) = (name, Box.draw box) in
147  List.map f compilation
148
149let _ =
150  let f (name, com) = Metapost.emit name com in
151  List.iter f compilation
Note: See TracBrowser for help on using the repository browser.