Help language development. Donate to The Perl Foundation
use v6; use Test; plan 76; use PDF::Class; use PDF::Class::Type; use PDF::IO::IndObj; use PDF::Grammar::Test :is-json-equiv; use PDF::Grammar::PDF; use PDF::Grammar::PDF::Actions; use PDF::Encoding; use PDF::Font::TrueType; use PDF::Font::Type0; use PDF::OutputIntent; use PDF::COS::Name; require ::('PDF::Catalog'); my $dict = { :Outlines(:ind-ref[2, 0]), :Type( :name<Catalog> ), :Pages{ :Type( :name<Pages> ) } }; my $catalog-obj = ::('PDF::Catalog').new( :$dict ); my $input = q:to"--END--"; 16 0 obj << /Type /Font /Subtype /TrueType /BaseFont /CourierNewPSMT /Encoding /WinAnsiEncoding /FirstChar 111 /FontDescriptor 15 0 R /LastChar 111 /Widths [ 600 ] >> endobj --END-- my $reader = class { has $.auto-deref = False }.new; my PDF::Grammar::PDF::Actions $actions .= new: :lite; my PDF::Grammar::PDF $grammar; $grammar.parse($input, :$actions, :rule<ind-obj>) // die "parse failed: $input"; my %ast = $/.ast; # misc types follow my $ind-obj = PDF::IO::IndObj.new( :$input, |%ast, :$reader ); my $tt-font-obj = $ind-obj.object; is $tt-font-obj.Widths[0], '600', 'Widths'; isa-ok $tt-font-obj, 'PDF::Font::TrueType'; is $tt-font-obj.Type, 'Font', 'tt font $.Type'; is $tt-font-obj.Subtype, 'TrueType', 'tt font $.Subtype'; is $tt-font-obj.Encoding, 'WinAnsiEncoding', 'tt font $.Encoding'; is $tt-font-obj.type, 'Font', 'tt font type accessor'; is $tt-font-obj.subtype, 'TrueType', 'tt font subtype accessor'; lives-ok {$tt-font-obj.check}, '$tt-font.check lives'; $dict = { :BaseFont(:name<Wingdings-Regular>), :Encoding(:name<Identity-H>), :DescendantFonts[:ind-ref[15, 0]], :Type<Font>, :Subtype<Type0> }; my $t0-font-obj = PDF::Font::Type0.new( :$dict ); is $t0-font-obj.Type, 'Font', 't0 font $.Type'; is $t0-font-obj.Subtype, 'Type0', 't0 font $.Subtype'; is $t0-font-obj.Encoding, 'Identity-H', 't0 font $.Encoding'; use PDF::Font::Type1; class SubclassedType1Font is PDF::Font::Type1 {}; my $sc-font-obj = SubclassedType1Font.new( :dict{ :BaseFont( :name<Helvetica> ), :Type<Font>, :Subtype<Type1> }, ); is $sc-font-obj.Type, 'Font', 'sc font $.Type'; is $sc-font-obj.Subtype, 'Type1', 'sc font $.Subtype'; is $sc-font-obj.BaseFont, 'Helvetica', 'sc font $.BaseFont'; lives-ok {$sc-font-obj.check}, '$sc-font-obj.check lives'; $sc-font-obj.Encoding = { :Type( :name<Encoding> ), :BaseEncoding( :name<MacRomanEncoding> ) }; my $enc-obj = $sc-font-obj.Encoding; does-ok $enc-obj, PDF::Encoding; is $enc-obj.Type, 'Encoding', '$enc.Type'; is $enc-obj.BaseEncoding, 'MacRomanEncoding', '$enc.BaseEncoding'; lives-ok {$enc-obj.check}, '$enc-obj.check lives'; my $objr-ast = :ind-obj[6, 0, :dict{ :Type( :name<OBJR> ), :Pg( :ind-ref[6, 1] ), :Obj( :ind-ref[6, 2]) } ]; my $objr-ind-obj = PDF::IO::IndObj.new( |%($objr-ast), :$reader ); my $objr-obj = $objr-ind-obj.object; isa-ok $objr-obj, 'PDF::OBJR'; is $objr-obj.Type, 'OBJR', '$objr.Type'; is-deeply $objr-obj<Pg>, (:ind-ref[6, 1]), '$objr<P>'; is-deeply $objr-obj<Obj>, (:ind-ref[6, 2]), '$objr<Obj>'; lives-ok {$objr-obj.check}, '$objr-obj.check lives'; $input = q:to"--END--"; 99 0 obj << /Type /OutputIntent % Output intent dictionary /S /GTS_PDFX /OutputCondition (CGATS TR 001 (SWOP)) /OutputConditionIdentifier (CGATS TR 001) /RegistryName (http://www.color.org) /DestOutputProfile 100 0 R >> endobj --END-- PDF::Grammar::PDF.parse($input, :$actions, :rule<ind-obj>) // die "parse failed: $input"; %ast = $/.ast; $ind-obj = PDF::IO::IndObj.new( :$input, |%ast, :$reader ); my $oi-obj = PDF::OutputIntent.COERCE: $ind-obj.object; does-ok $oi-obj, PDF::OutputIntent; is $oi-obj.S, 'GTS_PDFX', 'OutputIntent S'; is $oi-obj.OutputCondition, 'CGATS TR 001 (SWOP)', 'OutputIntent OutputCondition'; is $oi-obj.RegistryName, 'http://www.color.org', 'OutputIntent RegistryName'; lives-ok {$oi-obj.check}, '$io-obj.check lives'; use PDF::Page; use PDF::XObject::Form; use PDF::XObject::Image; my $new-page = PDF::Page.new: :dict{ :Type<Page> }; my $form1 = PDF::XObject::Form.new( :dict{ :BBox[0, 0, 100, 120], :Subtype<Form> } ); my $fm1 = $new-page.use-resource( $form1 ); is-deeply $new-page.resource-key($fm1), 'Fm1', 'xobject form name'; my $form2 = PDF::XObject::Form.new( :dict{ :BBox[-3, -3, 103, 123], :Subtype<Form> } ); my $image = PDF::XObject::Image.new( :dict{ :ColorSpace( :name<DeviceRGB> ), :Width(120), :Height(150), :Subtype<Image> } ); my $fm2 = $new-page.use-resource( $form2 ); is-deeply $new-page.resource-key($fm2), 'Fm2', 'xobject form name'; my $im1 = $new-page.use-resource( $image ); is-deeply $new-page.resource-key($im1), 'Im1', 'xobject form name'; my $font = PDF::Font::Type1.new: :dict{ :BaseFont<Helvetica>, :Type<Font>, :Subtype<Type1> }; my $f1 = $new-page.use-resource( $font ); is-deeply $new-page.resource-key($f1), 'F1', 'font name'; is-json-equiv $new-page<Resources><XObject>, { :Fm1($form1), :Fm2($form2), :Im1($image) }, 'Resource XObject content'; is-json-equiv $new-page<Resources><Font>, { :F1($font) }, 'Resource Font content'; $input = q:to"--END--"; 35 0 obj << % Graphics state parameter dictionary /Type /ExtGState /OP false /TR 36 0 R /SMask << /Type /Mask /S /Alpha /G 72 0 R >> >> endobj --END-- $grammar.parse($input, :$actions, :rule<ind-obj>) // die "parse failed: $input"; %ast = $/.ast; $ind-obj = PDF::IO::IndObj.new( :$input, |%ast, :$reader ); my $gs-obj = $ind-obj.object; does-ok $gs-obj, (require ::('PDF::ExtGState')); is $gs-obj.Type, 'ExtGState', 'ExtGState Type'; is-deeply $gs-obj.OP, False, 'ExtGState.OP'; quietly { lives-ok {$gs-obj<OP> = 42}, 'Typechecking setter bypass'; is-deeply $gs-obj<OP>, 42, 'Typechecking setter bypass'; dies-ok {$gs-obj.OP}, 'Typechecking on gettter'; lives-ok {$gs-obj.OP = False}, 'Type reassignment'; dies-ok {$gs-obj.OP = 42}, 'Typechecking on assignment'; } is-deeply $gs-obj.OP, False, 'ExtGState.OP'; $gs-obj<OP> = False; lives-ok {$gs-obj<OP> = True}, 'Valid property assignment'; is-deeply $gs-obj.OP, True, 'ExtGState.OP after assignment'; is $gs-obj.TR, (:ind-ref[36, 0]), 'ExtGState TR'; does-ok $gs-obj.SMask, (require ::('PDF::Mask')), 'ExtGState.SMask'; is $gs-obj<SMask><S>, 'Alpha', 'ExtGState<SMask><S>'; is $gs-obj.SMask.S, 'Alpha', 'ExtGState.SMask.S'; $gs-obj.SMask.TR = 'Identity'; is $gs-obj.SMask.TR, 'Identity'; does-ok $gs-obj.SMask.TR, PDF::COS::Name; $gs-obj.transparency = .5; is $gs-obj.CA, 0.5, 'transparency setter'; is $gs-obj.ca, 0.5, 'transparency setter'; lives-ok {$gs-obj.fill-alpha = .7}, 'transparency setter - alias'; is $gs-obj.fill-alpha, .7, 'transparency getter - alias'; is $gs-obj.stroke-alpha, .5, 'transparency getter - alias'; throws-like { $gs-obj.wtf }, X::Method::NotFound, 'ExtGState - unknown method'; $gs-obj.black-generation = { :FunctionType(2), :N(1), :C0[100, 0, 0], :C1[50, -30, -40], :Domain[0, 1], :Range[0, 100, -128, 127, -128, 127], }; is $gs-obj.BG2.FunctionType, 2, 'BG2 accessor'; is-json-equiv $gs-obj.black-generation.C1, [50, -30, -40], 'black-generation accessor'; $gs-obj.black-generation = PDF::COS::Name.COERCE: 'MyFunc'; is $gs-obj.BG2, 'MyFunc', 'BG2 accessor'; ok !$gs-obj.BG.defined, 'BG accessor'; is $gs-obj.black-generation, 'MyFunc', 'black-generation accessor'; my $gs1 = $new-page.use-resource( $gs-obj ); is-deeply $new-page.resource-key($gs1), 'GS1', 'ExtGState resource entry'; use PDF::ColorSpace::Lab; my $colorspace = PDF::ColorSpace::Lab.new; isa-ok $colorspace, PDF::ColorSpace::Lab; my $cs1 = $new-page.use-resource( $colorspace ); is $new-page.resource-key($cs1), 'CS1', 'ColorSpace resource entry'; use PDF::Shading::Axial; my $Shading = PDF::Shading::Axial.new( :dict{ :ColorSpace(:name<DeviceRGB>), :Function(:ind-ref[15, 0]), :Coords[ 0.0, 0.0, 0.096, 0.0, 0.0, 1.0, 0], }, :$reader ); my $sh1 = $new-page.use-resource( $Shading ); is $new-page.resource-key($sh1), 'Sh1', 'Shading resource entry'; use PDF::Pattern::Shading; my $pat-obj = PDF::Pattern::Shading.new( :dict{ :PaintType(1), :TilingType(2), :$Shading } ); my $pt1 = $new-page.use-resource( $pat-obj ); is $new-page.resource-key($pt1), 'Pt1', 'Shading resource entry'; my $resources = $new-page.Resources; does-ok $resources, ::('PDF::Resources'), 'Resources type'; for qw<ExtGState ColorSpace Pattern Shading XObject Font> { lives-ok { $resources."$_"() }, "Resource.$_ accessor"; } my %Resources = %( :ExtGState{ :GS1($gs-obj) }, :ColorSpace{ :CS1($colorspace) }, :Pattern{ :Pt1($pat-obj) }, :Shading{ :Sh1($Shading) }, :XObject{ :Fm1($form1), :Fm2($form2), :Im1($image)}, :Font{ :F1($font) }, ); is-json-equiv $new-page.Resources, %Resources, 'Resources';