source: Deliverables/Dissemination/final-review/wp5/Pics/labelling.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.1 KB
Line 
1
2open Mlpost
3
4
5(* Helpers *)
6
7let tex = Box.tex ~dx:(Num.cm 0.2) ~dy:(Num.cm 0.2) ~stroke:(Some Color.black)
8
9let cells_of_tab g =
10  let lines = Box.elts g in
11  Array.map Box.elts lines
12
13let fill_cells colors cells =
14  let fill_cell i j text =
15    if text = "" then Box.empty ()
16    else
17      let text = "\\texttt{" ^ text ^ "}" in
18      if List.mem_assoc (i, j) colors then
19        tex ~fill:(List.assoc (i, j) colors) text
20      else tex text in
21  let fill_line i line = Array.mapi (fill_cell i) line in
22  Array.mapi fill_line cells
23
24let get_cell cells i j = Box.nth 0 cells.(i).(j)
25
26let arrow path = Arrow.simple (Path.pathp ~style:Path.jLine path)
27
28let directed_arrow direction1 direction2 c1 c2 =
29  let p1 = direction1 c1 in
30  let p2 = direction2 c2 in
31  arrow [p1 ; p2]
32
33let right_arrow = directed_arrow Box.east Box.west
34let left_arrow = directed_arrow Box.west Box.east
35let up_arrow = directed_arrow Box.north Box.south
36let down_arrow = directed_arrow Box.south Box.north
37
38let middle p1 p2 =
39  let p = Point.add p1 p2 in
40  Point.mult (Num.of_float 0.5) p
41
42
43(* Boxes *)
44
45let code soundness =
46  let text =
47    "\\begin{tabular}{l}" ^
48(*      "\\texttt{prog}\\\\" ^*)
49      "\\texttt{\\textcolor{magenta}{$\\lbl_1$:}}\\\\" ^
50      "\\texttt{if (n < 1) }\\\\" ^
51      "\\quad \\texttt{\\textcolor{magenta}{$\\lbl_2$:} res = 0}\\\\" ^
52      "\\texttt{else}\\\\" ^
53      "\\quad \\texttt{\\textcolor{" ^
54      (if not soundness then "white" else "magenta") ^
55      "}{$\\lbl_3$:}}\\\\" ^
56      "\\quad \\texttt{while (res < 5) }\\\\" ^
57      "\\quad \\quad \\texttt{\\textcolor{" ^
58      (if soundness then "white" else "magenta") ^
59      "}{$\\lbl_4$:} res = res + n}\\\\" ^
60    "\\end{tabular}" in
61  let pen = Brush.Pen.scale (Num.of_float 3.) Brush.Pen.default in
62  Box.tex ~dx:(Num.cm 0.2) ~dy:(Num.cm 0.2) ~stroke:(Some Color.red) ~pen text
63
64let states soundness =
65  let label3 = if not soundness then "" else "emit $\\lbl_3$" in
66  let label4 = if soundness then "" else "emit $\\lbl_4$" in
67  let cells =
68    [|[|"" ; "" ; "" ; "emit $\\lbl_2$" ; "loadi R0,0" ;
69        "store R0,$\\mathit{l_\\mathit{res}}$" ; "branch" ; "halt"|] ;
70      [|"emit $\\lbl_1$" ; "load R0,$\\mathit{l_n}$" ; "loadi R1,1" ;
71        "bge R1,R0" ;
72        "loadi R0,5" ; "load R1,$\\mathit{l_\\mathit{res}}$" ; "bge R0,R1" ;
73        label4|] ;
74      [|"" ; "" ; "" ; label3 ; "" ; "" ; "" ;
75        "load R0,$\\mathit{l_\\mathit{res}}$"|] ;
76      [|"" ; "" ; "" ; "" ; "branch" ; "store R0,$\\mathit{l_\\mathit{res}}$" ;
77        "add R0,R0,R1" ; "load R1,$\\mathit{l_n}$"|]|] in
78  let colors =
79    [((0, 3), Color.magenta) ; ((1, 0), Color.magenta) ;
80     ((2, 3), Color.magenta) ; ((1, 7), Color.magenta) ;
81     ((1, 4), Color.orange) ; ((1, 5), Color.orange) ;
82     ((1, 6), Color.orange)] in
83  let dependent_colors =
84    if soundness then
85      [((2, 7), Color.orange) ; ((3, 4), Color.orange) ;
86       ((3, 5), Color.orange) ; ((3, 6), Color.orange) ;
87       ((3, 7), Color.orange)]
88    else [((0, 7), Color.orange) ; ((1, 1), Color.orange) ;
89          ((1, 2), Color.orange) ; ((1, 3), Color.orange)] in
90  let colors = colors @ dependent_colors in
91  Box.tabular ~hpadding:(Num.cm 1.) ~vpadding:(Num.cm 1.)
92    (fill_cells colors cells)
93
94let place_code code cells =
95  let ref_cell = get_cell cells 1 0 in
96  let code = Box.place `Northwest ~pos:`Southwest ref_cell code in
97  let shift = Point.pt (Num.zero, Num.cm 2.) in
98  Box.shift shift code
99
100
101(* Arrows *)
102
103let from_emit_l3 cells =
104  let src_cell = get_cell cells 2 3 in
105  let dst_cell = get_cell cells 1 4 in
106  let p1 = Box.south_west dst_cell in
107  let p2 = Box.south dst_cell in
108  let p3 = middle p1 p2 in
109  let p1 = Box.east src_cell in
110  let p2 = Point.pt (Point.xpart p3, Point.ypart p1) in
111  let path = [p1 ; p2 ; p3] in
112  arrow path
113
114let from_branch cells =
115  Box.pic (up_arrow (get_cell cells 3 4) (get_cell cells 1 4))
116
117let from_bge_soundness1 cells =
118  [from_emit_l3 cells ; down_arrow (get_cell cells 1 3) (get_cell cells 2 3)]
119
120let from_bge_precision1 cells =
121  let src_cell = get_cell cells 1 3 in
122  let dst_cell = get_cell cells 1 4 in
123  let int_cell = get_cell cells 2 3 in
124  let p1 = Box.south_west dst_cell in
125  let p2 = Box.south dst_cell in
126  let p4 = middle p1 p2 in
127  let p1 = Box.south src_cell in
128  let p2 = Box.ctr int_cell in
129  let p3 = Point.pt (Point.xpart p4, Point.ypart p2) in
130  let path = [p1 ; p2 ; p3 ; p4] in
131  [arrow path]
132
133let from_bge1 soundness cells =
134  let arrows =
135    if soundness then from_bge_soundness1 cells
136    else from_bge_precision1 cells in
137  Box.group (List.map Box.pic arrows)
138
139let from_bge_soundness2 cells =
140  let get_cell = get_cell cells in
141  let src_cell = get_cell 1 6 in
142  let dst_cell1 = get_cell 0 7 in
143  let dst_cell2 = get_cell 2 7 in
144  let p1 = Box.east src_cell in
145  let p3 = Box.south dst_cell1 in
146  let p2 = Point.pt (Point.xpart p3, Point.ypart p1) in
147  let p4 = Box.north dst_cell2 in
148  let paths = [[p1 ; p2 ; p3] ; [p2 ; p4]] in
149  List.map arrow paths
150
151let from_bge_precision2 cells =
152  let get_cell = get_cell cells in
153  let src_cell1 = get_cell 1 6 in
154  let src_cell2 = get_cell 1 7 in
155  let dst_cell1 = get_cell 0 7 in
156  let dst_cell2 = get_cell 2 7 in
157  let arrow1 = down_arrow src_cell2 dst_cell2 in
158  let p1 = Box.east src_cell1 in
159  let p2 = Box.west src_cell2 in
160  let arrow2 = arrow [p1 ; p2] in
161  let p1 = middle p1 p2 in
162  let p4 = Box.south dst_cell1 in
163  let p3 = middle (Box.north src_cell2) p4 in
164  let p2 = Point.pt (Point.xpart p1, Point.ypart p3) in
165  let arrow3 = arrow [p1 ; p2 ; p3 ; p4] in
166  [arrow1 ; arrow2 ; arrow3]
167
168let from_bge2 soundness cells =
169  let arrows =
170    if soundness then from_bge_soundness2 cells
171    else from_bge_precision2 cells in
172  Box.group (List.map Box.pic arrows)
173
174let place_arrows soundness cells =
175  let get_cell = get_cell cells in
176  let f directed_arrow (i1, j1) (i2, j2) =
177    directed_arrow (get_cell i1 j1) (get_cell i2 j2) in
178  let right_arrow (i, j) = f right_arrow (i, j) (i, j+1) in
179  let left_arrow (i, j) = f left_arrow (i, j) (i, j-1) in
180  let up_arrow (i, j) = f up_arrow (i, j) (i-1, j) in
181  let down_arrow (i, j) = f down_arrow (i, j) (i+1, j) in
182  let arrows =
183    [right_arrow (1, 0) ; right_arrow (1, 1) ; right_arrow (1, 2) ;
184     up_arrow (1, 3) ; right_arrow (0, 3) ;
185     right_arrow (0, 4) ; right_arrow (0, 5) ; right_arrow (0, 6) ;
186     right_arrow (1, 4) ; right_arrow (1, 5) ; down_arrow (2, 7) ;
187     left_arrow (3, 7) ; left_arrow (3, 6) ; left_arrow (3, 5)] in
188  let special_arrows = [from_branch cells ;
189                        from_bge1 soundness cells ;
190                        from_bge2 soundness cells] in
191  Box.group (special_arrows @ (List.map Box.pic arrows))
192
193
194(* Labelling *)
195
196let labelling soundness =
197  let code = code soundness in
198  let code = Box.scale (Num.of_float 1.3) code in
199  let states = states soundness in
200  let cells = cells_of_tab states in
201  let code = place_code code cells in
202  let arrows = place_arrows soundness cells in
203  Box.group [code ; states ; arrows]
204
205
206(* Main *)
207
208let result1 = labelling true
209
210let result2 = labelling false
211
212
213(* Output pictures *)
214
215let results = [result1 ; result2]
216let results = List.map Box.draw results
217
218let iteri f =
219  let rec aux i = function
220    | [] -> []
221    | e :: l -> f i e ; aux (i+1) l
222  in
223  aux 1
224
225let _ =
226  iteri (fun i b -> Metapost.emit ("labelling" ^ (string_of_int i)) b) results
Note: See TracBrowser for help on using the repository browser.