source: Deliverables/Dissemination/final-review/wp5/Pics/label_annot.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: 7.4 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
18let tex = Box.tex ~stroke:None ~dx:(cm 0.2) ~dy:(cm 0.2)
19
20(* Helpers *)
21
22let darkgreen = Color.rgb8 0 102 0
23let darkred = Color.rgb8 102 0 0
24
25let trans_black = Color.rgb8 217 217 217
26let trans_red = Color.rgb8 255 215 215
27let trans_blue = Color.rgb8 215 215 255
28let trans_orange = Color.rgb8 255 235 215
29let trans_magenta = Color.rgb8 255 215 235
30let trans_darkred = Color.rgb8 230 215 215
31let trans_darkgreen = Color.rgb8 215 230 215
32
33let trans c = match c with
34  | _ when c = Color.black -> trans_black
35  | _ when c = Color.red -> trans_red
36  | _ when c = Color.blue -> trans_blue
37  | _ when c = Color.orange -> trans_orange
38  | _ when c = Color.magenta -> trans_magenta
39  | _ when c = darkred -> trans_darkred
40  | _ when c = darkgreen -> trans_darkgreen
41  | _ -> assert false
42
43let text_color1 =
44  let assoc =
45    [("black", Color.black) ; ("red", Color.red) ; ("blue", Color.blue) ;
46     ("orange", Color.orange) ; ("magenta", Color.magenta) ;
47     ("darkred", darkred) ; ("darkgreen", darkgreen)] in
48  let f (text, color) = ("trans" ^ text, trans color) in
49  assoc @ (List.map f assoc)
50let text_color2 = List.map (fun (text, color) -> (color, text)) text_color1
51
52let color_of_text c = List.assoc c text_color1
53let text_of_color c = List.assoc c text_color2
54
55let colored_text color text =
56  "\\textcolor{" ^ (text_of_color color) ^ "}{" ^ text ^ "}"
57
58
59(* Text *)
60
61let lang lab l trans =
62  let text = if lab then "\\LabLang{" ^ l ^ "}" else l in
63  let text = if trans then colored_text trans_black text else text in
64  tex text
65
66let c_lang = lang false "C"
67
68let clab = lang true "C"
69let cminor = lang false "Cminor"
70let cminorlab = lang true "Cminor"
71let etc_lang = lang false "..."
72let etclab = lang true "..."
73let mips = lang false "ASM"
74let mipslab = lang true "ASM"
75let cost_fun = lang false "$\\kappa: \\Lab \\rightarrow \\N$"
76
77
78(* Place Text *)
79
80let place_next b1 b2 = Box.place `East ~pos:`West ~padding:(cm 1.) b1 b2
81let place_beyond b1 b2 = Box.place `North ~pos:`South ~padding:(cm 0.5) b1 b2
82
83let place_cost langs cost_fun =
84  let get b = Box.get b langs in
85  let p1 = Box.south (get "c_lang2") in
86  let p2 = Box.north (get "mipslab") in
87  let p = Point.mult (Num.of_float 0.5) (Point.add p1 p2) in
88  let p =
89    Point.pt (Point.xpart (Box.north_east (get "mipslab")), Point.ypart p) in
90  let b = Box.center p (Box.empty ()) in
91  Box.place `Center ~pos:`West b cost_fun
92
93
94let langs t_lab t_comp_lab t_erase t_comp t_cost t_instr =
95
96  let c_lang1 = c_lang false in
97  let cminorlab = cminorlab t_comp_lab in
98  let etclab = etclab t_comp_lab in
99  let mipslab = mipslab t_comp_lab in
100  let cminor = cminor t_erase in
101  let etc_lang = etc_lang t_erase in
102  let mips = mips t_erase in
103  let clab = clab t_lab in
104  let c_lang2 = c_lang t_instr in
105  let cost_fun = cost_fun t_cost in
106
107  let langs =
108    Box.tabular ~hpadding:(cm 1.) ~vpadding:(cm 0.5)
109      [|[|box ~name:"c_lang2" c_lang2 ; Box.empty () ;
110          Box.empty () ; Box.empty ()|] ;
111        [|box ~name:"clab" clab ; box ~name:"cminorlab" cminorlab ;
112          box ~name:"etclab" etclab ; box ~name:"mipslab" mipslab|] ;
113        [|box ~name:"c_lang1" c_lang1 ; box ~name:"cminor" cminor ;
114          box ~name:"etc_lang" etc_lang ; box ~name:"mips" mips|]|] in
115
116  let cost_fun = place_cost langs cost_fun in
117
118  Box.group [langs ; box ~name:"cost_fun" cost_fun]
119
120
121(* Strokes and arrows *)
122
123let colored_head_triangle_full color = Arrow.head_triangle_full ~color
124let colored_add_line color kind = Arrow.add_line ~color kind
125let colored_kind color =
126  Arrow.add_head ~head:(colored_head_triangle_full color)
127    (colored_add_line color Arrow.empty)
128
129let box_to_boxc color t b1 b2 =
130  let color = if t then trans color else color in
131  let kind = colored_kind color in
132  pic (Arrow.box_to_box ~kind b1 b2)
133
134let arrowc color t p =
135  let color = if t then trans color else color in
136  let kind = colored_kind color in
137  pic (Arrow.draw ~kind p)
138
139let pathc color t p =
140  let color = if t then trans color else color in
141  pic (Path.draw ~color p)
142
143let to_cost mipslab cost_fun t_cost =
144  let p1 = Box.east mipslab in
145  let p3 = Box.south cost_fun in
146  let p2 = Point.pt (Point.xpart p3, Point.ypart p1) in
147  let p = Path.pathp ~style:jLine [p1 ; p2 ; p3] in
148  arrowc orange t_cost p
149
150let to_c2 clab cost_fun c_lang2 t_instr =
151  let p1 = Box.north clab in
152  let x = Point.xpart p1 in
153  let p2 = Box.south c_lang2 in
154  let p = Path.pathp [p1 ; p2] in
155  let b1 = arrowc magenta t_instr p in
156  let p1 = Box.west cost_fun in
157  let p2 = Point.pt (x, Point.ypart p1) in
158  let p = Path.pathp [p1 ; p2] in
159  let b2 = pathc magenta t_instr p in
160  Box.group [b1 ; b2]
161
162
163let arrows langs t_lab t_comp_lab t_erase t_comp t_cost t_instr =
164
165  let get s = Box.get s langs in
166  let box_to_box c t b1 b2 = box_to_boxc c t (get b1) (get b2) in
167
168  let shft = 0.1 in
169  let pm = Point.pt (cm (-.shft), zero) in
170  let pp = Point.pt (cm shft, zero) in
171
172  let c1_to_clab = box_to_box Color.blue t_lab "c_lang1" "clab" in
173  let c1_to_clab = Box.shift pm c1_to_clab in
174  let clab_to_cminorlab = box_to_box red t_comp_lab "clab" "cminorlab" in
175  let cminorlab_to_etclab = box_to_box red t_comp_lab "cminorlab" "etclab" in
176  let etclab_to_mipslab = box_to_box red t_comp_lab "etclab" "mipslab" in
177
178  let clab_to_c1 = box_to_box darkgreen t_erase "clab" "c_lang1" in
179  let clab_to_c1 = Box.shift pp clab_to_c1 in
180  let cminorlab_to_cminor = box_to_box darkgreen t_erase "cminorlab" "cminor" in
181  let etclab_to_etc = box_to_box darkgreen t_erase "etclab" "etc_lang" in
182  let mipslab_to_mips = box_to_box darkgreen t_erase "mipslab" "mips" in
183
184  let c1_to_cminor = box_to_box darkred t_comp "c_lang1" "cminor" in
185  let cminor_to_etc = box_to_box darkred t_comp "cminor" "etc_lang" in
186  let etc_to_mips = box_to_box darkred t_comp "etc_lang" "mips" in
187
188  let mipslab_to_cost = to_cost (get "mipslab") (get "cost_fun") t_cost in
189
190  let to_c2 = to_c2 (get "clab") (get "cost_fun") (get "c_lang2") t_instr in
191
192  Box.group [c1_to_clab ; clab_to_cminorlab ; cminorlab_to_etclab ;
193             etclab_to_mipslab ;
194             clab_to_c1 ; cminorlab_to_cminor ; etclab_to_etc ;
195             mipslab_to_mips ;
196             c1_to_cminor ; cminor_to_etc ; etc_to_mips ;
197             mipslab_to_cost ; to_c2]
198
199
200(* Main *)
201
202let label_annot t_lab t_comp_lab t_erase t_comp t_cost t_instr =
203  let langs = langs t_lab t_comp_lab t_erase t_comp t_cost t_instr in
204  let arrows = arrows langs t_lab t_comp_lab t_erase t_comp t_cost t_instr in
205  Box.group [langs ; arrows]
206
207let label_annot1 = Box.draw (label_annot true true true true true true)
208let label_annot2 = Box.draw (label_annot false true true true true true)
209let label_annot3 = Box.draw (label_annot false false true true true true)
210let label_annot4 = Box.draw (label_annot false false false true true true)
211let label_annot5 = Box.draw (label_annot false false false false true true)
212let label_annot6 = Box.draw (label_annot false false false false false true)
213let label_annot7 = Box.draw (label_annot false false false false false false)
214
215let _ = Metapost.emit "label_annot" label_annot1
216let _ = Metapost.emit "label_annot1" label_annot1
217let _ = Metapost.emit "label_annot2" label_annot2
218let _ = Metapost.emit "label_annot3" label_annot3
219let _ = Metapost.emit "label_annot4" label_annot4
220let _ = Metapost.emit "label_annot5" label_annot5
221let _ = Metapost.emit "label_annot6" label_annot6
222let _ = Metapost.emit "label_annot7" label_annot7
Note: See TracBrowser for help on using the repository browser.