File Coverage

blib/lib/PDF/Make/Builder/Form/Field.pm

Criterion	Covered	Total	%
statement	85	86	98.8
branch	23	26	88.4
condition	7	12	58.3
subroutine	10	11	90.9
pod	0	1	0.0
total	125	136	91.9

package PDF::Make::Builder::Form::Field;
use strict;
use warnings;
use Object::Proto;
use PDF::Make ();

BEGIN {
    Object::Proto::define('PDF::Make::Builder::Form::Field',
        'field_name:Str:required',
        'x:Num',
        'y:Num',
        'w:Num:default(200)',
        'h:Num:default(24)',
        'default_value:Str',
        'da:Str',
        'label:Str',
        'label_colour:Str:default(#444)',
        'label_size:Num:default(9)',
        'font_size:Num:default(10)',
        'font_name:Str:default(Helv)',
        'border_colour:Str:default(#aaa)',
        'bg_colour:Str:default(#fff)',
        'readonly:Bool:default(0)',
        'required:Bool:default(0)',
        'inline_label:Bool:default(0)',
        'raw_mode:Bool:default(0)',
        'margin_top:Num:default(4)',
        'margin_bottom:Num:default(8)',
    );
    Object::Proto::import_accessors('PDF::Make::Builder::Form::Field');
}

sub _ensure_form {
    my ($doc) = @_;
    my $form = eval { PDF::Make::FormPtr::get($doc) };
    unless ($form) {
        $form = PDF::Make::FormPtr::create($doc);
        PDF::Make::FormPtr::set_need_appearances($form, 1);
    }
    return $form;
}

sub _create_field {
    die "PDF::Make::Builder::Form::Field::_create_field must be overridden";
}

sub add {
    my ($self, $builder) = @_;
    my $page = $builder->page;
    my $canvas = $page->canvas;
    my $doc = $builder->doc;
    my $bfont = $builder->font;

    _ensure_form($doc);

    my $fx = $self->x // $page->content_x;
    my $fw = $self->w;
    my $fh = $self->h;
    my $name = field_name $self;
    my $is_inline = inline_label $self;
    my $lbl = $self->label;

    # ── Raw mode: create/place widget without layout/chrome/cursor changes ──
    if ($self->raw_mode) {
        my $fy = defined($self->y) ? $self->y : ($page->cursor_y - $fh);
        my $field = $self->_create_field($doc, $name, $fx, $fy, $fw, $fh);
        $self->_apply_field_props($field);
        $field->add_to_page($page->xs_page);
        return $self;
    }

    # Top margin
    $page->advance_y(margin_top $self);

    if ($is_inline) {
        # ── Inline layout (checkbox/radio): field then label beside it ──

        my $fy = $page->cursor_y - $fh;

        # Draw label to the right of the field
        if (defined $lbl && length $lbl) {
            my $lsize = label_size $self;
            my ($lr, $lg, $lb) = $bfont->hex_to_rgb(label_colour $self);
            $bfont->ensure_loaded($page->xs_page);
            my $res = $bfont->resource_name;
            $canvas->BT
                ->Tf($res, $lsize)
                ->rg($lr, $lg, $lb)
                ->Td($fx + $fw + 8, $fy + ($fh - $lsize) / 2 + 1)
                ->Tj($lbl)
                ->ET;
        }

        # Create XS field
        my $field = $self->_create_field($doc, $name, $fx, $fy, $fw, $fh);
        $self->_apply_field_props($field);
        $field->add_to_page($page->xs_page);

        # Draw styled border (unless subclass handles its own appearance)
        $self->_draw_field_chrome($canvas, $bfont, $fx, $fy, $fw, $fh)
            unless $self->_draws_own_chrome;

        # Advance past the field
        $page->advance_y($fh + margin_bottom $self);

    } else {
        # ── Stacked layout (text/combo/list): label above, field below ──

        # Draw label first
        if (defined $lbl && length $lbl) {
            my $lsize = label_size $self;
            my ($lr, $lg, $lb) = $bfont->hex_to_rgb(label_colour $self);
            $bfont->ensure_loaded($page->xs_page);
            my $res = $bfont->resource_name;
            my $req_marker = ($self->required) ? ' *' : '';
            my $label_y = $page->cursor_y - $lsize;
            $canvas->BT
                ->Tf($res, $lsize)
                ->rg($lr, $lg, $lb)
                ->Td($fx, $label_y)
                ->Tj($lbl . $req_marker)
                ->ET;
            $page->advance_y($lsize + 3);
        }

        # Field goes at current cursor
        my $fy = $page->cursor_y - $fh;

        # Create XS field
        my $field = $self->_create_field($doc, $name, $fx, $fy, $fw, $fh);
        $self->_apply_field_props($field);
        $field->add_to_page($page->xs_page);

        # Draw styled border (unless subclass handles its own appearance)
        $self->_draw_field_chrome($canvas, $bfont, $fx, $fy, $fw, $fh)
            unless $self->_draws_own_chrome;

        # Advance past the field
        $page->advance_y($fh + margin_bottom $self);
    }

    return $self;
}

sub _apply_field_props {
    my ($self, $field) = @_;
    my $da = $self->da;
    $da = sprintf('/%s %g Tf 0 g', $self->font_name, $self->font_size)
        unless defined $da && length $da;
    $field->set_da($da);
    my $dv = default_value $self;
    $field->set_value($dv) if defined $dv;
    $field->readonly if $self->readonly;
    $field->required if $self->required;
}

sub _draws_own_chrome { 0 }

sub _draw_field_chrome {
    my ($self, $canvas, $bfont, $fx, $fy, $fw, $fh) = @_;
    my ($bgr, $bgg, $bgb) = $bfont->hex_to_rgb(bg_colour $self);
    my ($bdr, $bdg, $bdb) = $bfont->hex_to_rgb(border_colour $self);

    $canvas->q;
    # White fill
    $canvas->rg($bgr, $bgg, $bgb)
           ->re($fx, $fy, $fw, $fh)->f;
    # Border stroke
    $canvas->w(0.75)
           ->RG($bdr, $bdg, $bdb)
           ->re($fx + 0.25, $fy + 0.25, $fw - 0.5, $fh - 0.5)->S;
    $canvas->Q;
}

1;

__END__