Help language development. Donate to The Perl Foundation

PDF::Class zef:dwarring last updated on 2023-08-20

t/pdf-pattern.t
use v6;
use Test;

plan 8;

use PDF::Class;
use PDF::IO::IndObj;
use PDF::Grammar::Test :is-json-equiv;
use PDF::Grammar::PDF;
use PDF::Grammar::PDF::Actions;
use PDF::Content::FontObj;

my PDF::Grammar::PDF::Actions $actions .= new: :lite;

# example taken from PDF 1.7 Specification

my $input = q:to"--END-OBJ--";
15 0 obj << % Pattern definition
  /Type /Pattern
  /PatternType 1  % Tiling pattern
  /PaintType 1    % Colored
  /TilingType 2
  /BBox [ 0 0 100 100 ]
  /XStep 100
  /YStep 100
  /Resources << >>
  /Matrix [ 0.4 0.0 0.0 0.4 0.0 0.0 ]
  /Length 183
>> endobj
--END-OBJ--

PDF::Grammar::PDF.parse($input, :$actions, :rule<ind-obj>)
    // die "parse failed";
my %ast = $/.ast;
my PDF::IO::IndObj $ind-obj .= new( |%ast, :$input);
is $ind-obj.obj-num, 15, '$.obj-num';
is $ind-obj.gen-num, 0, '$.gen-num';
my $pattern-obj = $ind-obj.object;
isa-ok $pattern-obj, 'PDF::Pattern::Tiling';
is $pattern-obj.Type, 'Pattern', '$.Type accessor';
is-json-equiv $pattern-obj.BBox, [ 0, 0, 100, 100 ], '$.BBox accessor';
my PDF::Content::FontObj $zfont = $pattern-obj.core-font('ZapfDingbats');
# example from [PDF 1.7 Example 4.24]
$pattern-obj.gfx.ops: [
    'q',
    'BT',                              # Begin text object
    :Tf[$pattern-obj.resource-key($zfont.to-dict), 1],                # Set text font and size
    :Tm[64, 0, 0, 64, 7.1771, 2.4414], # Set text matrix
    :Tc[0],                            # Set character spacing
    :Tw[0],                            # Set word spacing

    :rg[1.0, 0.0, 0.0],                # Set nonstroking color to red
    :Tj($zfont.encode("♠", :str)),     # Show spade glyph

    :TD[0.7478, -0.007],               # Move text position
    :rg[0.0, 1.0, 0.0],                # Set nonstroking color to green
    :Tj($zfont.encode("♥", :str)),     # Show heart glyph

    :TD[-0.7323, 0.7813],              # Move text position
    :rg[0.0, 0.0, 1.0],                # Set nonstroking color to blue
    :Tj($zfont.encode("♦", :str)),     # Show diamond glyph

    :TD[0.6913, 0.007],                # Move text position
    :rg[0.0, 0.0, 0.0],                # Set nonstroking color to black
    :Tj($zfont.encode("♣", :str)),     # Show club glyph
    'ET',                              # End text object
    'Q',
    ];

$pattern-obj.cb-finish;
lives-ok {$pattern-obj.check}, '$pattern-obj.check lives';

my $contents = $pattern-obj.decoded;
my @lines = $contents.lines;
is-deeply [ @lines.head(3) ], ['q', '  BT', '    /F1 1 Tf'], 'first three lines of content';
is-deeply [ @lines.tail(4) ], ['    0 0 0 rg', '    (¨) Tj', '  ET', 'Q'], 'last 5 lines of content';

my PDF::Class $pdf .= new;
my $page = $pdf.Pages.add-page;
$page.media-box = [0, 0, 230, 210];
$page.gfx.ops: [
    :q[],                                       # Graphics save
    :G[0.0],                                    # Set stroking color to black
    :rg[1.0, 1.0, 0.0],                         # Set nonstroking color to yellow
    :re[25, 175, 175, -150],                    # Construct rectangular path
    :f[],                                       # Fill path
    :cs[<Pattern>],                             # Set pattern color space
    :scn[$page.resource-key($pattern-obj)],     # Set pattern as nonstroking color

    :m[99.92, 49.92],                                # Start new path
    :c[99.92, 77.52, 77.52, 99.92, 49.92, 99.92],    # Construct lower-left circle
    :c[22.32, 99.92, -0.08, 77.52, -0.08, 49.92],
    :c[-0.08, 22.32, 22.32, -0.08, 49.92, -0.08],
    :c[77.52, -0.08, 99.92, 22.32, 99.92, 49.92],
    :B[],                                            # Fill and stroke path

    :m[224.96, 49.92],                               # Start new path
    :c[224.96, 77.52, 202.56, 99.92, 174.96, 99.92], # Construct lower-right circle
    :c[147.36, 99.92, 124.96, 77.52, 124.96, 49.92],
    :c[124.96, 22.32, 147.36, -0.08, 174.96, -0.08],
    :c[202.56, -0.08, 224.96, 22.32, 224.96, 49.92],
    :B[],                                            # Fill and stroke path

    :m[87.56, 201.70],                               # Start new path
    :c[63.66, 187.90, 55.46, 157.32, 69.26, 133.40], # Construct upper circle
    :c[83.06, 109.50, 113.66, 101.30, 137.56, 115.10],
    :c[161.46, 128.90, 169.66, 159.50, 155.86, 183.40],
    :c[142.06, 207.30, 111.46, 215.50, 87.56, 201.70],
    :B[],                                            # Fill and stroke path

    :m[50, 50],         # Start new path
    :l[175, 50],        # Construct triangular path
    :l[112.5, 158.253],
    :b[],               # Close, fill, and stroke path
    :Q[],               # Graphics restore
    ];

# ensure consistant document ID generation
$pdf.id =  $*PROGRAM-NAME.fmt('%-16.16s');

$pdf.save-as('t/pdf-pattern.pdf', :!info);