401 lines
11 KiB
OCaml
401 lines
11 KiB
OCaml
(* Drawing operations. *)
|
|
open Pdfutil
|
|
open Cpdferror
|
|
|
|
let embed_font = ref (fun () -> Printf.printf "BAD *\n%!"; Cpdfembed.ExistingNamedFont)
|
|
let setdrawing = ref (fun () -> Printf.printf "BAD **\n%!")
|
|
let getfontname = ref (fun () -> Printf.printf "BAD ***\n%!"; "")
|
|
let getfontsize = ref (fun () -> Printf.printf "BAD ****\n%!"; 0.)
|
|
let setfontname = ref (fun _ -> Printf.printf "BAD *****\n%!")
|
|
let setfontsize = ref (fun _ -> Printf.printf "BAD ******\n%!")
|
|
let loadttf = ref (fun _ -> Printf.printf "BAD *******\n%!")
|
|
let setembedstd14 = ref (fun _ _ -> Printf.printf "BAD ********\n%!")
|
|
let getindent = ref (fun () -> Printf.printf "BAD *********\n%!"; None)
|
|
|
|
let ttfs = null_hash ()
|
|
|
|
let loadttfseparate name filename = !loadttf (name ^ "=" ^ filename)
|
|
|
|
let fontpack_initialised = ref false
|
|
|
|
let drawops = ref [("_MAIN", [])]
|
|
|
|
let startxobj n =
|
|
drawops := (n, [])::!drawops
|
|
|
|
let xobj_bbox = ref (0., 0., 1000., 1000.)
|
|
|
|
let xobjbbox s =
|
|
xobj_bbox := Cpdfcoord.parse_rectangle (Pdf.empty ()) s
|
|
|
|
let addop o =
|
|
match !drawops with
|
|
| (n, ops)::t -> drawops := (n, (o::ops))::t
|
|
| [] -> error "no drawops"
|
|
|
|
let endxobj () =
|
|
match !drawops with
|
|
| (n, ops)::t ->
|
|
drawops := t;
|
|
let a, b, c, d = !xobj_bbox in
|
|
addop (Cpdfdraw.FormXObject (a, b, c, d, n, rev ops))
|
|
| [] ->
|
|
error "too many -end-xobj or -et"
|
|
|
|
let addbt () =
|
|
drawops := ("_TEXT", [])::!drawops
|
|
|
|
let addet () =
|
|
match !drawops with
|
|
| ("_TEXT", ops)::t ->
|
|
drawops := t;
|
|
addop (Cpdfdraw.TextSection (rev ops))
|
|
| _ -> error "not in a text section at -et"
|
|
|
|
let push () =
|
|
drawops := ("_PUSH", [])::!drawops
|
|
|
|
let pop () =
|
|
match !drawops with
|
|
| ("_PUSH", ops)::t ->
|
|
drawops := t;
|
|
addop (Cpdfdraw.Qq (rev ops))
|
|
| _ -> error "not in a pushed section at -pop"
|
|
|
|
let readfloats s = map float_of_string (String.split_on_char ' ' s)
|
|
|
|
let parse_colour s =
|
|
match lookup (String.lowercase_ascii s) Cpdfcolours.colours with
|
|
| Some c ->
|
|
let r = float_of_int ((c land 0xFF0000) lsr 16) /. 255. in
|
|
let g = float_of_int ((c land 0x00FF00) lsr 8) /. 255. in
|
|
let b = float_of_int (c land 0x0000FF) /. 255. in
|
|
Cpdfaddtext.RGB (r, g, b)
|
|
| None ->
|
|
let getnum = function
|
|
| Pdfgenlex.LexInt i -> float i
|
|
| Pdfgenlex.LexReal f -> f
|
|
| _ -> error "Bad color"
|
|
in
|
|
match Pdfgenlex.lex_string s with
|
|
| [g] -> Cpdfaddtext.Grey (getnum g)
|
|
| [r; g; b] -> Cpdfaddtext.RGB (getnum r, getnum g, getnum b)
|
|
| [c; y; m; k] -> Cpdfaddtext.CYMK (getnum c, getnum y, getnum m, getnum k)
|
|
| _ -> error "Bad color"
|
|
|
|
let col_of_string s =
|
|
match parse_colour s with
|
|
| Cpdfaddtext.RGB (r, g, b) -> Cpdfdraw.RGB (r, g, b)
|
|
| Cpdfaddtext.Grey g -> Cpdfdraw.Grey g
|
|
| Cpdfaddtext.CYMK (c, y, m, k) -> Cpdfdraw.CYMK (c, y, m, k)
|
|
| exception _ -> Cpdfdraw.NoCol
|
|
|
|
let setstroke s =
|
|
addop (Cpdfdraw.SetStroke (col_of_string s))
|
|
|
|
let setfill s =
|
|
addop (Cpdfdraw.SetFill (col_of_string s))
|
|
|
|
let addtag t =
|
|
addop (Cpdfdraw.Tag t)
|
|
|
|
let addstag t =
|
|
addop (Cpdfdraw.STag t)
|
|
|
|
let endtag () =
|
|
addop Cpdfdraw.EndTag
|
|
|
|
let endstag () =
|
|
addop Cpdfdraw.EndSTag
|
|
|
|
let autotags b =
|
|
Cpdfdraw.do_auto_tag := b
|
|
|
|
let autoartifacts b =
|
|
Cpdfdraw.do_add_artifacts := b
|
|
|
|
let artifact () =
|
|
addop Cpdfdraw.BeginArtifact
|
|
|
|
let endartifact () =
|
|
addop Cpdfdraw.EndArtifact
|
|
|
|
let addnamespace s =
|
|
addop (Cpdfdraw.Namespace s)
|
|
|
|
let eltinfo k v =
|
|
addop (Cpdfdraw.EltInfo (k, v))
|
|
|
|
let endeltinfo s =
|
|
addop (Cpdfdraw.EndEltInfo s)
|
|
|
|
let setrolemap s =
|
|
Cpdfdraw.rolemap := s
|
|
|
|
let addrect s =
|
|
let x, y, w, h = Cpdfcoord.parse_rectangle (Pdf.empty ()) s in
|
|
addop (Cpdfdraw.Rect (x, y, w, h))
|
|
|
|
let addto s =
|
|
let x, y = Cpdfcoord.parse_coordinate (Pdf.empty ()) s in
|
|
addop (Cpdfdraw.To (x, y))
|
|
|
|
let addline s =
|
|
let x, y = Cpdfcoord.parse_coordinate (Pdf.empty ()) s in
|
|
addop (Cpdfdraw.Line (x, y))
|
|
|
|
let addbezier s =
|
|
match readfloats s with
|
|
| [a; b; c; d; e; f] -> addop (Cpdfdraw.Bezier (a, b, c, d, e, f))
|
|
| _ -> error "-bez requires six numbers"
|
|
| exception _ -> error "malformed -bez"
|
|
|
|
let addbezier23 s =
|
|
match readfloats s with
|
|
| [a; b; c; d] -> addop (Cpdfdraw.Bezier23 (a, b, c, d))
|
|
| _ -> error "-bez23 requires four numbers"
|
|
| exception _ -> error "malformed -bez23"
|
|
|
|
let addbezier13 s =
|
|
match readfloats s with
|
|
| [a; b; c; d] -> addop (Cpdfdraw.Bezier13 (a, b, c, d))
|
|
| _ -> error "-bez13 requires four numbers"
|
|
| exception _ -> error "malformed -bez13"
|
|
|
|
let addcircle s =
|
|
match readfloats s with
|
|
| [x; y; r] ->
|
|
let _, _, segs = hd (snd (Cpdfshape.circle x y r)) in
|
|
(match segs with
|
|
| Cpdfshape.Bezier ((a, b), _, _, _)::_ -> addop (Cpdfdraw.To (a, b))
|
|
| _ -> assert false);
|
|
iter
|
|
(function
|
|
| Cpdfshape.Bezier (_, (c, d), (e, f), (g, h)) -> addop (Cpdfdraw.Bezier (c, d, e, f, g, h))
|
|
| Cpdfshape.Straight _ -> assert false)
|
|
segs
|
|
| _ -> error "-circle requires three numbers"
|
|
| exception _ -> error "malformed -circle"
|
|
|
|
let stroke () =
|
|
addop Cpdfdraw.Stroke
|
|
|
|
let fill () =
|
|
addop Cpdfdraw.Fill
|
|
|
|
let fillevenodd () =
|
|
addop Cpdfdraw.FillEvenOdd
|
|
|
|
let strokefill () =
|
|
addop Cpdfdraw.FillStroke
|
|
|
|
let strokefillevenodd () =
|
|
addop Cpdfdraw.FillStrokeEvenOdd
|
|
|
|
let clip () =
|
|
addop Cpdfdraw.Clip
|
|
|
|
let clipevenodd () =
|
|
addop Cpdfdraw.ClipEvenOdd
|
|
|
|
let closepath () =
|
|
addop Cpdfdraw.ClosePath
|
|
|
|
let setthickness s =
|
|
try addop (Cpdfdraw.SetLineThickness (float_of_string s)) with
|
|
_ -> error "Thickness must be a number"
|
|
|
|
let setcap s =
|
|
let num =
|
|
match s with
|
|
| "butt" -> 0
|
|
| "round" -> 1
|
|
| "square" -> 2
|
|
| _ -> error "Unknown cap type"
|
|
in
|
|
addop (Cpdfdraw.SetLineCap num)
|
|
|
|
let setjoin s =
|
|
let num =
|
|
match s with
|
|
| "miter" -> 0
|
|
| "round" -> 1
|
|
| "bevel" -> 2
|
|
| _ -> error "Unknown join type"
|
|
in
|
|
addop (Cpdfdraw.SetLineJoin num)
|
|
|
|
let setmiter s =
|
|
try addop (Cpdfdraw.SetMiterLimit (float_of_string s)) with
|
|
_ -> error "Miter limit must be a number"
|
|
|
|
let setdash s =
|
|
try
|
|
let x, y =
|
|
let nums = readfloats s in all_but_last nums, last nums
|
|
in
|
|
addop (Cpdfdraw.SetDashPattern (x, y))
|
|
with
|
|
_ -> error "Dash pattern elements must one or more numbers"
|
|
|
|
let setmatrix s =
|
|
match readfloats s with
|
|
| [a; b; c; d; e; f] ->
|
|
addop (Cpdfdraw.Matrix {Pdftransform.a = a; Pdftransform.b = b; Pdftransform.c = c;
|
|
Pdftransform.d = d; Pdftransform.e = e; Pdftransform.f = f})
|
|
| _ -> error "Matrix must have six numbers"
|
|
| exception _ -> error "Matrix elements must be numbers"
|
|
|
|
let setmtranslate s =
|
|
match readfloats s with
|
|
| [a; b] -> addop (Cpdfdraw.Matrix (Pdftransform.matrix_of_transform [Pdftransform.Translate (a, b)]))
|
|
| _ | exception _ -> error "-mtrans takes two numbers"
|
|
|
|
let setmrotate s =
|
|
match readfloats s with
|
|
| [a; b; c] -> addop (Cpdfdraw.Matrix (Pdftransform.matrix_of_transform [Pdftransform.Rotate ((a, b), c)]))
|
|
| _ | exception _ -> error "-mrot takes three numbers"
|
|
|
|
let setmscale s =
|
|
match readfloats s with
|
|
| [a; b; c; d] -> addop (Cpdfdraw.Matrix (Pdftransform.matrix_of_transform [Pdftransform.Scale ((a, b), c, d)]))
|
|
| _ | exception _ -> error "-mscale takes four numbers"
|
|
|
|
let setmshearx s =
|
|
match readfloats s with
|
|
| [a; b; c] -> addop (Cpdfdraw.Matrix (Pdftransform.matrix_of_transform [Pdftransform.ShearX ((a, b), c)]))
|
|
| _ | exception _ -> error "-mshearx takes three numbers"
|
|
|
|
let setmsheary s =
|
|
match readfloats s with
|
|
| [a; b; c] -> addop (Cpdfdraw.Matrix (Pdftransform.matrix_of_transform [Pdftransform.ShearY ((a, b), c)]))
|
|
| _ | exception _ -> error "-msheary takes three numbers"
|
|
|
|
let usexobj s =
|
|
addop (Cpdfdraw.Use s)
|
|
|
|
let addjpeg ?data n =
|
|
match data with
|
|
| Some d ->
|
|
addop
|
|
(Cpdfdraw.ImageXObject
|
|
(n, fst (Cpdfimage.obj_of_jpeg_data (Pdfio.bytes_of_raw d))))
|
|
| None ->
|
|
let name, filename =
|
|
match String.split_on_char '=' n with
|
|
| [name; filename] -> name, filename
|
|
| _ -> error "addjpeg: bad file specification"
|
|
in
|
|
try
|
|
let data = Pdfio.bytes_of_string (contents_of_file filename) in
|
|
addop (Cpdfdraw.ImageXObject (name, fst (Cpdfimage.obj_of_jpeg_data data)))
|
|
with
|
|
_ -> error "addjpeg: could not load JPEG"
|
|
|
|
let addpng ?data n =
|
|
match data with
|
|
| Some d ->
|
|
addop
|
|
(Cpdfdraw.ImageXObject
|
|
(n, fst (Cpdfimage.obj_of_png_data (Pdfio.bytes_of_raw d))))
|
|
| None ->
|
|
let name, filename =
|
|
match String.split_on_char '=' n with
|
|
| [name; filename] -> name, filename
|
|
| _ -> error "addpng: bad file specification"
|
|
in
|
|
let data = Pdfio.bytes_of_string (contents_of_file filename) in
|
|
addop (Cpdfdraw.ImageXObject (name, fst (Cpdfimage.obj_of_png_data data)))
|
|
|
|
let addimage s =
|
|
addop (Cpdfdraw.Image s)
|
|
|
|
let addnewpage s =
|
|
addop Cpdfdraw.NewPage
|
|
|
|
let addopacity f =
|
|
addop (Cpdfdraw.Opacity f)
|
|
|
|
let addsopacity f =
|
|
addop (Cpdfdraw.SOpacity f)
|
|
|
|
let addleading f =
|
|
addop (Cpdfdraw.Leading f)
|
|
|
|
let addcharspace f =
|
|
addop (Cpdfdraw.CharSpace f)
|
|
|
|
let addwordspace f =
|
|
addop (Cpdfdraw.WordSpace f)
|
|
|
|
let addtextscale f =
|
|
addop (Cpdfdraw.TextScale f)
|
|
|
|
let addrendermode i =
|
|
addop (Cpdfdraw.RenderMode i)
|
|
|
|
let addrise f =
|
|
addop (Cpdfdraw.Rise f)
|
|
|
|
let addnewline () =
|
|
addop Cpdfdraw.Newline
|
|
|
|
let add_default_fontpack fontname =
|
|
if not !fontpack_initialised then
|
|
begin
|
|
addop (Cpdfdraw.FontPack (fontname, !embed_font (), null_hash ()));
|
|
set fontpack_initialised
|
|
end
|
|
|
|
let addtext s =
|
|
begin match !drawops with _::_::_ -> () | _ -> error "-text must be in a -bt / -et section" end;
|
|
add_default_fontpack (!getfontname ());
|
|
addop (Cpdfdraw.Font (!getfontname (), !getfontsize ()));
|
|
addop (Cpdfdraw.Text s)
|
|
|
|
let addspecialtext s =
|
|
begin match !drawops with _::_::_ -> () | _ -> error "-stext must be in a -bt / -et section" end;
|
|
add_default_fontpack (!getfontname ());
|
|
addop (Cpdfdraw.Font (!getfontname (), !getfontsize ()));
|
|
addop (Cpdfdraw.SpecialText s)
|
|
|
|
(* "L200pt=....." *)
|
|
let jws s =
|
|
let j, rest =
|
|
match explode s with
|
|
| 'L'::t -> (Cpdfdraw.Left, t)
|
|
| 'R'::t -> (Cpdfdraw.Right, t)
|
|
| 'C'::t -> (Cpdfdraw.Centre, t)
|
|
| _ -> error "Unknown justification specification"
|
|
in
|
|
let w, s =
|
|
match String.split_on_char '=' (implode rest) with
|
|
| [w; s] -> (Cpdfcoord.parse_single_number (Pdf.empty ()) w, s)
|
|
| _ -> error "addjpeg: bad file specification"
|
|
in
|
|
j, w, s
|
|
|
|
let addpara s =
|
|
begin match !drawops with _::_::_ -> () | _ -> error "-para must be in a -bt / -et section" end;
|
|
add_default_fontpack (!getfontname ());
|
|
addop (Cpdfdraw.Font (!getfontname (), !getfontsize ()));
|
|
let j, w, s = jws s in
|
|
addop (Cpdfdraw.Para (None, j, w, [s]))
|
|
|
|
let rec split_on_newlines a = function
|
|
| 0x005c::0x006e::t -> rev a::split_on_newlines [] t
|
|
| h::t -> split_on_newlines (h::a) t
|
|
| [] -> if a = [] then [] else [rev a]
|
|
|
|
let split_on_newlines s =
|
|
map Pdftext.utf8_of_codepoints (split_on_newlines [] (Pdftext.codepoints_of_utf8 s))
|
|
|
|
let addparas s =
|
|
begin match !drawops with _::_::_ -> () | _ -> error "-paras must be in a -bt / -et section" end;
|
|
add_default_fontpack (!getfontname ());
|
|
addop (Cpdfdraw.Font (!getfontname (), !getfontsize ()));
|
|
let j, w, s = jws s in
|
|
let splits = split_on_newlines s in
|
|
let indent = !getindent () in
|
|
addop (Cpdfdraw.Para (indent, j, w, splits))
|