This commit is contained in:
John Whitington 2022-12-16 13:13:55 +00:00
parent ed7cfeb72c
commit d16c7c284a
3 changed files with 75 additions and 84 deletions

View File

@ -1758,10 +1758,10 @@ let col_of_string s =
| exception _ -> Cpdfdraw.NoCol | exception _ -> Cpdfdraw.NoCol
let setstroke s = let setstroke s =
drawops := Cpdfdraw.Stroke (col_of_string s)::!drawops drawops := Cpdfdraw.SetStroke (col_of_string s)::!drawops
let setfill s = let setfill s =
drawops := Cpdfdraw.Fill (col_of_string s)::!drawops drawops := Cpdfdraw.SetFill (col_of_string s)::!drawops
let addrect s = let addrect s =
let x, y, w, h = Cpdfcoord.parse_rectangle (Pdf.empty ()) s in let x, y, w, h = Cpdfcoord.parse_rectangle (Pdf.empty ()) s in
@ -1775,8 +1775,23 @@ let addline s =
let x, y = Cpdfcoord.parse_coordinate (Pdf.empty ()) s in let x, y = Cpdfcoord.parse_coordinate (Pdf.empty ()) s in
drawops := Cpdfdraw.Line (x, y)::!drawops drawops := Cpdfdraw.Line (x, y)::!drawops
let endpath () = let stroke () =
drawops := Cpdfdraw.EndPath::!drawops drawops := Cpdfdraw.Stroke::!drawops
let fill () =
drawops := Cpdfdraw.Fill::!drawops
let fillevenodd () =
drawops := Cpdfdraw.FillEvenOdd::!drawops
let strokefill () =
drawops := Cpdfdraw.FillStroke::!drawops
let strokefillevenodd () =
drawops := Cpdfdraw.FillStrokeEvenOdd::!drawops
let closepath () =
drawops := Cpdfdraw.ClosePath::!drawops
let setthickness s = let setthickness s =
try try
@ -1820,6 +1835,20 @@ let setdash s =
with with
_ -> error "Dash pattern elements must one or more numbers" _ -> error "Dash pattern elements must one or more numbers"
let push () =
drawops := Cpdfdraw.Push::!drawops
let pop () =
drawops := Cpdfdraw.Pop::!drawops
let setmatrix s =
match map float_of_string (String.split_on_char ' ' s) with
| [a; b; c; d; e; f] ->
drawops := Cpdfdraw.Matrix {Pdftransform.a = a; Pdftransform.b = b; Pdftransform.c = c;
Pdftransform.d = d; Pdftransform.e = e; Pdftransform.f = f}::!drawops
| _ -> error "Matrix must have six numbers"
| exception _ -> error "Matrix elements must be numbers"
(* Parse a control file, make an argv, and then make Arg parse it. *) (* Parse a control file, make an argv, and then make Arg parse it. *)
let rec make_control_argv_and_parse filename = let rec make_control_argv_and_parse filename =
control_args := !control_args @ parse_control_file filename control_args := !control_args @ parse_control_file filename
@ -2602,14 +2631,22 @@ and specs =
("-rect", Arg.String addrect, " Draw rectangle"); ("-rect", Arg.String addrect, " Draw rectangle");
("-to", Arg.String addto, " Move to"); ("-to", Arg.String addto, " Move to");
("-line", Arg.String addline, " Line to"); ("-line", Arg.String addline, " Line to");
("-stroke", Arg.String setstroke, " Set stroke colour"); ("-strokecol", Arg.String setstroke, " Set stroke colour");
("-fill", Arg.String setfill, " Set fill colour"); ("-fillcol", Arg.String setfill, " Set fill colour");
("-end", Arg.Unit endpath, " End path"); ("-stroke", Arg.Unit stroke, " Stroke");
("-fill", Arg.Unit fill, " Fill");
("-filleo", Arg.Unit fill, " Fill, even odd");
("-strokefill", Arg.Unit strokefill, " Stroke and fill");
("-strokefilleo", Arg.Unit strokefillevenodd, " Stroke and fill, even odd");
("-close", Arg.Unit closepath, " Close path");
("-thick", Arg.String setthickness, " Set stroke thickness"); ("-thick", Arg.String setthickness, " Set stroke thickness");
("-cap", Arg.String setcap, " Set cap"); ("-cap", Arg.String setcap, " Set cap");
("-join", Arg.String setjoin, " Set join"); ("-join", Arg.String setjoin, " Set join");
("-miter", Arg.String setmiter, " Set miter limit"); ("-miter", Arg.String setmiter, " Set miter limit");
("-dash", Arg.String setdash, " Set dash pattern"); ("-dash", Arg.String setdash, " Set dash pattern");
("-push", Arg.Unit push, " Push graphics stack");
("-pop", Arg.Unit pop, " Pop graphics stack");
("-matrix", Arg.String setmatrix, " Append to graphics matrix");
(* These items are undocumented *) (* These items are undocumented *)
("-remove-unused-resources", Arg.Unit (setop RemoveUnusedResources), ""); ("-remove-unused-resources", Arg.Unit (setop RemoveUnusedResources), "");
("-stay-on-error", Arg.Unit setstayonerror, ""); ("-stay-on-error", Arg.Unit setstayonerror, "");

View File

@ -10,8 +10,9 @@ type drawops =
| Rect of float * float * float * float (* x, y, w, h *) | Rect of float * float * float * float (* x, y, w, h *)
| To of float * float | To of float * float
| Line of float * float | Line of float * float
| Fill of drawops_colspec | ClosePath
| Stroke of drawops_colspec | SetFill of drawops_colspec
| SetStroke of drawops_colspec
| SetLineThickness of float | SetLineThickness of float
| SetLineCap of int | SetLineCap of int
| SetLineJoin of int | SetLineJoin of int
@ -20,91 +21,48 @@ type drawops =
| Matrix of Pdftransform.transform_matrix | Matrix of Pdftransform.transform_matrix
| Push | Push
| Pop | Pop
| EndPath | Fill
| FillEvenOdd
type state = | Stroke
{mutable fill : drawops_colspec; | FillStroke
mutable stroke : drawops_colspec; | FillStrokeEvenOdd
mutable linewidth : float;
mutable linecap : int;
mutable linejoin : int;
mutable miterlimit : float;
mutable dashpattern : float list * float}
let initial_state () =
{fill = NoCol;
stroke = RGB (0., 0., 0.);
linewidth = 1.;
linecap = 0;
linejoin = 0;
miterlimit = 10.;
dashpattern = ([], 0.)}
let state =
ref [initial_state ()]
let currstate () =
match !state with s::_ -> s | [] -> assert false
let pushstate () =
match !state with s::t -> state := {s with fill = s.fill}::s::t | [] -> assert false
let popstate () =
match !state with [s] -> () | s::t -> state := t | [] -> assert false
let cleanstate () =
state := [initial_state ()]
let ops_of_drawop = function let ops_of_drawop = function
| Push -> pushstate (); [Pdfops.Op_q] | Push -> [Pdfops.Op_q]
| Pop -> popstate (); [Pdfops.Op_Q] | Pop -> [Pdfops.Op_Q]
| Matrix m -> [Pdfops.Op_cm m] | Matrix m -> [Pdfops.Op_cm m]
| Rect (x, y, w, h) -> [Pdfops.Op_re (x, y, w, h)] | Rect (x, y, w, h) -> [Pdfops.Op_re (x, y, w, h)]
| To (x, y) -> [Pdfops.Op_m (x, y)] | To (x, y) -> [Pdfops.Op_m (x, y)]
| Line (x, y) -> [Pdfops.Op_l (x, y)] | Line (x, y) -> [Pdfops.Op_l (x, y)]
| Fill x -> | SetFill x ->
(currstate ()).fill <- x;
begin match x with begin match x with
| RGB (r, g, b) -> [Op_rg (r, g, b)] | RGB (r, g, b) -> [Op_rg (r, g, b)]
| Grey g -> [Op_g g] | Grey g -> [Op_g g]
| CYMK (c, y, m, k) -> [Op_k (c, y, m, k)] | CYMK (c, y, m, k) -> [Op_k (c, y, m, k)]
| NoCol -> [] | NoCol -> []
end end
| Stroke x -> | SetStroke x ->
(currstate ()).stroke <- x;
begin match x with begin match x with
| RGB (r, g, b) -> [Op_RG (r, g, b)] | RGB (r, g, b) -> [Op_RG (r, g, b)]
| Grey g -> [Op_G g] | Grey g -> [Op_G g]
| CYMK (c, y, m, k) -> [Op_K (c, y, m, k)] | CYMK (c, y, m, k) -> [Op_K (c, y, m, k)]
| NoCol -> [] | NoCol -> []
end end
| EndPath -> | ClosePath
begin match (currstate ()).fill, (currstate ()).stroke with | Fill -> [Pdfops.Op_f]
| NoCol, NoCol -> [] | FillEvenOdd -> [Pdfops.Op_f']
| NoCol, _ -> [Pdfops.Op_S] | Stroke -> [Pdfops.Op_S]
| _, NoCol -> [Pdfops.Op_f] | FillStroke -> [Pdfops.Op_B]
| _, _ -> [Pdfops.Op_B'] | FillStrokeEvenOdd -> [Pdfops.Op_B']
end | SetLineThickness t -> [Pdfops.Op_w t]
| SetLineThickness t -> | SetLineCap c -> [Pdfops.Op_J c]
(currstate ()).linewidth <- t; | SetLineJoin j -> [Pdfops.Op_j j]
[Pdfops.Op_w t] | SetMiterLimit m -> [Pdfops.Op_M m]
| SetLineCap c -> | SetDashPattern (x, y) -> [Pdfops.Op_d (x, y)]
(currstate ()).linecap <- c;
[Pdfops.Op_J c]
| SetLineJoin j ->
(currstate ()).linejoin <- j;
[Pdfops.Op_j j]
| SetMiterLimit m ->
(currstate ()).miterlimit <- m;
[Pdfops.Op_M m]
| SetDashPattern (x, y) ->
(currstate ()).dashpattern <- (x, y);
[Pdfops.Op_d (x, y)]
let ops_of_drawops drawops = flatten (map ops_of_drawop drawops) let ops_of_drawops drawops = flatten (map ops_of_drawop drawops)
(* Draw all the accumulated operators *) (* Draw all the accumulated operators *)
let draw fast range pdf drawops = let draw fast range pdf drawops =
let s = Pdfops.string_of_ops (ops_of_drawops drawops) in let s = Pdfops.string_of_ops (ops_of_drawops drawops) in
cleanstate ();
Cpdftweak.append_page_content s false fast range pdf Cpdftweak.append_page_content s false fast range pdf

View File

@ -8,8 +8,9 @@ type drawops =
| Rect of float * float * float * float (* x, y, w, h *) | Rect of float * float * float * float (* x, y, w, h *)
| To of float * float | To of float * float
| Line of float * float | Line of float * float
| Fill of drawops_colspec | ClosePath
| Stroke of drawops_colspec | SetFill of drawops_colspec
| SetStroke of drawops_colspec
| SetLineThickness of float | SetLineThickness of float
| SetLineCap of int | SetLineCap of int
| SetLineJoin of int | SetLineJoin of int
@ -18,15 +19,10 @@ type drawops =
| Matrix of Pdftransform.transform_matrix | Matrix of Pdftransform.transform_matrix
| Push | Push
| Pop | Pop
| EndPath | Fill
| FillEvenOdd
type state = | Stroke
{mutable fill : drawops_colspec; | FillStroke
mutable stroke : drawops_colspec; | FillStrokeEvenOdd
mutable linewidth : float;
mutable linecap : int;
mutable linejoin : int;
mutable miterlimit : float;
mutable dashpattern : float list * float}
val draw : bool -> int list -> Pdf.t -> drawops list -> Pdf.t val draw : bool -> int list -> Pdf.t -> drawops list -> Pdf.t