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" )