1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
|
type picture = Picture of float * float * float * float * pic_object list
and point = float * float
and pic_object = Line of point * int * int * float * option list
| Circle of point * float * option list
| Oval of point * float * float * option list
| Text of point * string * option list
| Curve of point * point * point * option list
| SubPicture of point * picture * option list
| Framebox of point * float * float * option list
and option = Arrowhead
| Anchor of anchor * anchor
| Filled
| Dashed of float
| Framed
| Points of int
and anchor = N | L | R | T | B
let string_of_anchor = function
N -> "n" | L -> "l" | R -> "r" | T -> "t" | B -> "b"
let rec extract_anchor = function
[] -> ""
| Anchor (a1, a2) :: s -> "[" ^ (string_of_anchor a1) ^
(string_of_anchor a2) ^ "]"
| _ :: s -> extract_anchor s
let rec extract_points = function
[] -> ""
| Points i :: s -> "[" ^ (string_of_int i) ^ "]"
| _ :: s -> extract_points s
let rec extract_dashed = function
[] -> ""
| Dashed i :: s -> (string_of_float i)
| _ :: s -> extract_dashed s
let string_of_point (x, y) =
"(" ^ (string_of_float x) ^ "," ^ (string_of_float y) ^ ")"
let rec output_pic_objects channel = function
[] -> ()
| Line (p, xsl, ysl, length, ol) :: s -> (
output_string channel (
"\\put" ^ (string_of_point p) ^
(if List.mem Arrowhead ol then "{\\vector(" else "{\\line(") ^
(string_of_int xsl) ^ "," ^ (string_of_int ysl) ^ "){" ^
(string_of_float length) ^ "}}%\n"
);
output_pic_objects channel s
)
| Circle (p, d, ol) :: s -> (
let framed = List.mem Framed ol in
output_string channel (
"\\put" ^ (string_of_point p) ^
(if framed then "{\\frame{" else "{") ^
(if List.mem Filled ol then "\\circle*{" else "\\circle{") ^
(string_of_float d) ^
(if framed then "}}}%\n" else "}}%\n")
);
output_pic_objects channel s
)
| Oval (p, l, h, ol) :: s -> (
let framed = List.mem Framed ol in
output_string channel (
"\\put" ^ (string_of_point p) ^
(if framed then "{\\frame{" else "{") ^
"\\oval" ^ (string_of_point (l, h)) ^ (extract_anchor ol) ^
(if framed then "}}%\n" else "}%\n")
);
output_pic_objects channel s
)
| Text (p, t, ol) :: s -> (
let framed = List.mem Framed ol in
output_string channel (
"\\put" ^ (string_of_point p) ^
(if framed then "{\\frame{" else "{") ^
"\\makebox(0,0)" ^ (extract_anchor ol) ^ "{" ^ t ^
(if framed then "}}}%\n" else "}}%\n")
);
output_pic_objects channel s
)
| Curve (p1, p2, p3, ol) :: s -> (
output_string channel (
"\\qbezier" ^ (extract_points ol) ^ (string_of_point p1) ^
(string_of_point p2) ^ (string_of_point p3) ^ "%\n"
);
output_pic_objects channel s
)
| SubPicture (p, pic, ol) :: s -> (
let framed = List.mem Framed ol in
output_string channel (
"\\put" ^ (string_of_point p) ^
(if framed then "{\\frame{" else "{")
);
output channel pic;
output_string channel (if framed then "}}%\n" else "}%\n");
output_pic_objects channel s
)
| Framebox (p, l, h, ol) :: s -> (
let framed = List.mem Framed ol in
output_string channel (
"\\put" ^ (string_of_point p) ^ "{" ^
( let dc = extract_dashed ol
in if dc = "" then "\\framebox"
else "\\dashbox{" ^ dc ^ "}" ) ^
(string_of_point (l, h)) ^ (extract_anchor ol) ^ "{%\n"
);
output_string channel "}}%\n";
output_pic_objects channel s
)
and output channel (Picture (xs, ys, xo, yo, l)) = (
output_string channel (
"\\begin{picture}" ^ (string_of_point (xs, ys)) ^
(string_of_point (xo, yo)) ^ "%\n"
);
output_pic_objects channel l;
output_string channel "\\end{picture}%\n"
)
|
