Clean up Cpdfcommand/Cpdfdrawcontrol mutual recursion

This commit is contained in:
John Whitington 2023-10-04 15:07:29 +01:00
parent df85eb1740
commit 88c6a12de6
5 changed files with 21 additions and 12 deletions

View File

@ -14,6 +14,8 @@ let exit n =
begin try iter Sys.remove !tempfiles with _ -> exit n end; begin try iter Sys.remove !tempfiles with _ -> exit n end;
exit n exit n
let null () = ()
let initial_file_size = ref 0 let initial_file_size = ref 0
let empty = Pdf.empty () let empty = Pdf.empty ()
@ -1771,7 +1773,10 @@ let embed_font () = embed_font_inner args.font
let _ = Cpdfdrawcontrol.embed_font := embed_font let _ = Cpdfdrawcontrol.embed_font := embed_font
let _ = Cpdfdrawcontrol.setdrawing := (fun () -> args.op <- Some Draw)
let setfont f = let setfont f =
(*Printf.printf "Cpdfcommand.setfont: |%s|\n%!" f;*)
try try
let fontname, _ = Hashtbl.find Cpdfdrawcontrol.ttfs f in let fontname, _ = Hashtbl.find Cpdfdrawcontrol.ttfs f in
args.font <- EmbeddedFont f; args.font <- EmbeddedFont f;

View File

@ -8,3 +8,5 @@ val go_withargv : string array -> unit
(**/**) (**/**)
exception StayOnError exception StayOnError
val null : unit -> unit

View File

@ -248,22 +248,22 @@ let rec ops_of_drawop dryrun pdf endpage filename bates batespad num page = func
| Opacity v -> [Pdfops.Op_gs (extgstate "/ca" v)] | Opacity v -> [Pdfops.Op_gs (extgstate "/ca" v)]
| SOpacity v -> [Pdfops.Op_gs (extgstate "/CA" v)] | SOpacity v -> [Pdfops.Op_gs (extgstate "/CA" v)]
| FontPack (identifier, cpdffont, codepoints) -> | FontPack (identifier, cpdffont, codepoints) ->
(*Printf.printf "FontPack op: %s\n" identifier;*) (*Printf.printf "FontPack op: |%s|\n%!" identifier;*)
let fontpack = let fontpack =
match Hashtbl.find !fontpacks identifier with match Hashtbl.find !fontpacks identifier with
| (fontpack, _) -> | (fontpack, _) ->
(*Printf.printf "Cpdfdraw FontPack op: using existing fontpack %s\n" identifier;*) (*Printf.printf "Cpdfdraw FontPack op: using existing fontpack |%s|\n%!" identifier;*)
fontpack fontpack
| exception Not_found -> | exception Not_found ->
(*Printf.printf "Cpdfdraw FontPack op: storing new fontpack %s\n" identifier;*) (*Printf.printf "Cpdfdraw FontPack op: storing new fontpack |%s|\n%!" identifier;*)
let fontpack = let fontpack =
match cpdffont with match cpdffont with
| PreMadeFontPack fp -> | PreMadeFontPack fp ->
(*Printf.printf "it's a pre-made font pack\n"; *) (*Printf.printf "it's a pre-made font pack\n%!";*)
fp fp
| EmbedInfo {fontfile; fontname; encoding} -> | EmbedInfo {fontfile; fontname; encoding} ->
let codepoints = map fst (list_of_hashtbl codepoints) in let codepoints = map fst (list_of_hashtbl codepoints) in
(*Printf.printf "%i codepoints to embed\n" (length codepoints);*) (*Printf.printf "%i codepoints to embed\n%!" (length codepoints);*)
if codepoints = [] then default_fontpack else if codepoints = [] then default_fontpack else
Cpdfembed.embed_truetype pdf ~fontfile ~fontname ~codepoints ~encoding Cpdfembed.embed_truetype pdf ~fontfile ~fontname ~codepoints ~encoding
| ExistingNamedFont -> | ExistingNamedFont ->
@ -279,7 +279,7 @@ let rec ops_of_drawop dryrun pdf endpage filename bates batespad num page = func
Not_found -> Not_found ->
let o = if dryrun then 0 else Pdftext.write_font pdf font in let o = if dryrun then 0 else Pdftext.write_font pdf font in
let name = fresh_name "/F" in let name = fresh_name "/F" in
(*Printf.printf "Adding font %s as %s\n" identifier name;*) (*Printf.printf "Adding font %s as %s\n%!" identifier name;*)
Hashtbl.replace (res ()).fonts (identifier, n) (name, o); Hashtbl.replace (res ()).fonts (identifier, n) (name, o);
name) name)
(fst fontpack) (fst fontpack)
@ -288,7 +288,7 @@ let rec ops_of_drawop dryrun pdf endpage filename bates batespad num page = func
(res ()).page_names <- ns @ (res ()).page_names; (res ()).page_names <- ns @ (res ()).page_names;
[] []
| Font (identifier, size) -> | Font (identifier, size) ->
(*Printf.printf "Cpdfdraw Font op: Changing to stored font %s\n" identifier;*) (*Printf.printf "Cpdfdraw Font op: Changing to stored font %s\n%!" identifier;*)
let fontpack, codepoints = Hashtbl.find !fontpacks identifier in let fontpack, codepoints = Hashtbl.find !fontpacks identifier in
(res ()).current_fontpack <- (identifier, fontpack); (res ()).current_fontpack <- (identifier, fontpack);
if dryrun then (res ()).current_fontpack_codepoints <- codepoints; if dryrun then (res ()).current_fontpack_codepoints <- codepoints;

View File

@ -2,11 +2,12 @@
open Pdfutil open Pdfutil
open Cpdferror open Cpdferror
let embed_font = ref (fun () -> Cpdfembed.ExistingNamedFont) let embed_font = ref (fun () -> Printf.printf "BAD *\n%!"; Cpdfembed.ExistingNamedFont)
let getfontname = ref (fun () -> "") let setdrawing = ref (fun () -> Printf.printf "BAD **\n%!"; ())
let getfontsize = ref (fun () -> 0.) let getfontname = ref (fun () -> Printf.printf "BAD ***\n%!"; "")
let setfontname = ref (fun _ -> ()) let getfontsize = ref (fun () -> Printf.printf "BAD ****\n%!"; 0.)
let setfontsize = ref (fun _ -> ()) let setfontname = ref (fun _ -> Printf.printf "BAD *****\n%!"; ())
let setfontsize = ref (fun _ -> Printf.printf "BAD ******\n%!"; ())
let ttfs = null_hash () let ttfs = null_hash ()

View File

@ -3,6 +3,7 @@ val getfontname : (unit -> string) ref
val getfontsize : (unit -> float) ref val getfontsize : (unit -> float) ref
val setfontname : (string -> unit) ref val setfontname : (string -> unit) ref
val setfontsize : (float -> unit) ref val setfontsize : (float -> unit) ref
val setdrawing : (unit -> unit) ref
val ttfs : (string, (string * Cpdfembed.cpdffont)) Hashtbl.t val ttfs : (string, (string * Cpdfembed.cpdffont)) Hashtbl.t
val fontpack_initialised : bool ref val fontpack_initialised : bool ref
val drawops : (string * Cpdfdraw.drawops list) list ref val drawops : (string * Cpdfdraw.drawops list) list ref