File Coverage

blib/lib/Graphics/Primitive/Component.pm
Criterion Covered Total %
statement 1 3 33.3
branch n/a
condition n/a
subroutine 1 1 100.0
pod n/a
total 2 4 50.0


line stmt bran cond sub pod time code
1             package Graphics::Primitive::Component;
2 5     5   157594 use Moose;
  0            
  0            
3             use MooseX::Storage;
4              
5             use overload ('""' => 'to_string');
6              
7             with Storage('format' => 'JSON', 'io' => 'File');
8              
9             use Forest::Tree;
10             use Graphics::Primitive::Border;
11             use Graphics::Primitive::Insets;
12             use Geometry::Primitive::Point;
13             use Geometry::Primitive::Rectangle;
14              
15             has 'background_color' => (
16             is => 'rw',
17             isa => 'Graphics::Color',
18             trigger => sub { my ($self) = @_; $self->prepared(0); }
19             );
20             has 'border' => (
21             is => 'rw',
22             isa => 'Graphics::Primitive::Border',
23             default => sub { Graphics::Primitive::Border->new },
24             trigger => sub { my ($self) = @_; $self->prepared(0); }
25             );
26             has 'callback' => (
27             traits => ['Code'],
28             is => 'rw',
29             isa => 'CodeRef',
30             predicate => 'has_callback',
31             handles => {
32             fire_callback => 'execute'
33             }
34             );
35             has 'class' => ( is => 'rw', isa => 'Str' );
36             has 'color' => (
37             is => 'rw', isa => 'Graphics::Color',
38             trigger => sub { my ($self) = @_; $self->prepared(0); },
39             trigger => sub { my ($self) = @_; $self->prepared(0); }
40             );
41             has 'height' => (
42             is => 'rw',
43             isa => 'Num',
44             default => sub { 0 },
45             trigger => sub { my ($self) = @_; $self->prepared(0); if($self->height < $self->minimum_height) { $self->height($self->minimum_height); } }
46             );
47             has 'margins' => (
48             is => 'rw',
49             isa => 'Graphics::Primitive::Insets',
50             default => sub { Graphics::Primitive::Insets->new },
51             coerce => 1,
52             trigger => sub { my ($self) = @_; $self->prepared(0); }
53             );
54             has 'minimum_height' => (
55             is => 'rw',
56             isa => 'Num',
57             default => sub { 0 },
58             trigger => sub { my ($self) = @_; $self->prepared(0); }
59             );
60             has 'minimum_width' => (
61             is => 'rw',
62             isa => 'Num',
63             default => sub { 0 },
64             trigger => sub { my ($self) = @_; $self->prepared(0); }
65             );
66             has 'name' => ( is => 'rw', isa => 'Str' );
67             has 'origin' => (
68             is => 'rw',
69             isa => 'Geometry::Primitive::Point',
70             default => sub { Geometry::Primitive::Point->new( x => 0, y => 0 ) },
71             trigger => sub { my ($self) = @_; $self->prepared(0); }
72             );
73             has 'padding' => (
74             is => 'rw',
75             isa => 'Graphics::Primitive::Insets',
76             default => sub { Graphics::Primitive::Insets->new },
77             coerce => 1,
78             trigger => sub { my ($self) = @_; $self->prepared(0); }
79             );
80             has 'page' => ( is => 'rw', isa => 'Bool', default => sub { 0 } );
81             has 'parent' => (
82             is => 'rw',
83             isa => 'Maybe[Graphics::Primitive::Component]',
84             weak_ref => 1
85             );
86             has 'prepared' => ( is => 'rw', isa => 'Bool', default => sub { 0 } );
87             has 'visible' => ( is => 'rw', isa => 'Bool', default => sub { 1 } );
88             has 'width' => (
89             is => 'rw',
90             isa => 'Num',
91             default => sub { 0 },
92             trigger => sub { my ($self) = @_; $self->prepared(0); if($self->width < $self->minimum_width) { $self->width($self->minimum_width); } }
93             );
94              
95             sub get_tree {
96             my ($self) = @_;
97              
98             return Forest::Tree->new(node => $self);
99             }
100              
101             sub inside_width {
102             my ($self) = @_;
103              
104             my $w = $self->width;
105              
106             my $padding = $self->padding;
107             my $margins = $self->margins;
108             my $border = $self->border;
109              
110             $w -= $padding->left + $padding->right;
111             $w -= $margins->left + $margins->right;
112              
113             $w -= $border->left->width + $border->right->width;
114              
115             $w = 0 if $w < 0;
116              
117             return $w;
118             }
119              
120             sub minimum_inside_width {
121             my ($self) = @_;
122              
123             my $w = $self->minimum_width;
124              
125             my $padding = $self->padding;
126             my $margins = $self->margins;
127             my $border = $self->border;
128              
129             $w -= $padding->left + $padding->right;
130             $w -= $margins->left + $margins->right;
131              
132             $w -= $border->left->width + $border->right->width;
133              
134             $w = 0 if $w < 0;
135              
136             return $w;
137             }
138              
139             sub inside_height {
140             my ($self) = @_;
141              
142             my $h = $self->height;
143              
144             my $padding = $self->padding;
145             my $margins = $self->margins;
146             my $border = $self->border;
147              
148             $h -= $padding->bottom + $padding->top;
149             $h -= $margins->bottom + $margins->top;
150             $h -= $border->top->width + $border->bottom->width;
151              
152             $h = 0 if $h < 0;
153              
154             return $h;
155             }
156              
157             sub minimum_inside_height {
158             my ($self) = @_;
159              
160             my $h = $self->minimum_height;
161              
162             my $padding = $self->padding;
163             my $margins = $self->margins;
164             my $border = $self->border;
165              
166             $h -= $padding->bottom + $padding->top;
167             $h -= $margins->bottom + $margins->top;
168             $h -= $border->top->width + $border->bottom->width;
169              
170             $h = 0 if $h < 0;
171              
172             return $h;
173             }
174              
175             sub inside_bounding_box {
176              
177             my ($self) = @_;
178              
179             my $padding = $self->padding;
180             my $margins = $self->margins;
181             my $border = $self->border;
182              
183             my $rect = Geometry::Primitive::Rectangle->new(
184             origin => Geometry::Primitive::Point->new(
185             x => $padding->left + $border->left->width + $margins->left,
186             y => $padding->top + $border->right->width + $margins->top
187             ),
188             width => $self->inside_width,
189             height => $self->inside_height
190             );
191             }
192              
193             sub outside_width {
194             my $self = shift();
195              
196             my $padding = $self->padding;
197             my $margins = $self->margins;
198             my $border = $self->border;
199              
200             my $w = $padding->left + $padding->right;
201             $w += $margins->left + $margins->right;
202             $w += $border->left->width + $border->right->width;
203              
204             return $w;
205             }
206              
207             sub outside_height {
208             my $self = shift();
209              
210             my $padding = $self->padding;
211             my $margins = $self->margins;
212             my $border = $self->border;
213              
214             my $w = $padding->top + $padding->bottom;
215             $w += $margins->top + $margins->bottom;
216             $w += $border->bottom->width + $border->top->width;
217              
218             return $w;
219             }
220              
221             sub finalize {
222             my ($self) = @_;
223              
224             $self->fire_callback($self) if $self->has_callback;
225             }
226              
227             sub prepare {
228             my ($self, $driver) = @_;
229              
230             return if $self->prepared;
231              
232             unless($self->minimum_width) {
233             $self->minimum_width($self->outside_width);
234             }
235             unless($self->minimum_height) {
236             $self->minimum_height($self->outside_height);
237             }
238             }
239              
240             sub to_string {
241             my ($self) = @_;
242              
243             my $buff = defined($self->name) ? $self->name : ref($self);
244             $buff .= ': '.$self->origin->to_string;
245             $buff .= ' ('.$self->width.'x'.$self->height.')';
246             return $buff;
247             }
248              
249             __PACKAGE__->meta->make_immutable;
250              
251             no Moose;
252             1;
253             __END__
254              
255             =head1 NAME
256              
257             Graphics::Primitive::Component - Base graphical unit
258              
259             =head1 DESCRIPTION
260              
261             A Component is an entity with a graphical representation.
262              
263             =head1 SYNOPSIS
264              
265             my $c = Graphics::Primitive::Component->new({
266             origin => Geometry::Primitive::Point->new({
267             x => $x, y => $y
268             }),
269             width => 500, height => 350
270             });
271              
272             =head1 LIFECYCLE
273              
274             =over 4
275              
276             =item B<prepare>
277              
278             Most components do the majority of their setup in the B<prepare>. The goal of
279             prepare is to establish it's minimum height and width so that it can be
280             properly positioned by a layout manager.
281              
282             $driver->prepare($comp);
283              
284             =item B<layout>
285              
286             This is not a method of Component, but a phase introduced by the use of
287             L<Layout::Manager>. If the component is a container then each of it's
288             child components (even the containers) will be positioned according to the
289             minimum height and width determined during B<prepare>. Different layout
290             manager implementations have different rules, so consult the documentation
291             for each for details. After this phase has completed the origin, height and
292             width should be set for all components.
293              
294             $lm->do_layout($comp);
295              
296             =item B<finalize>
297              
298             This final phase provides and opportunity for the component to do any final
299             changes to it's internals before being passed to a driver for drawing.
300             An example might be a component that draws a fleuron at it's extremities.
301             Since the final height and width isn't known until this phase, it was
302             impossible for it to position these internal components until now. It may
303             even defer creation of this components until now.
304              
305             B<It is not ok to defer all action to the finalize phase. If you do not
306             establish a minimum hieght and width during prepare then the layout manager
307             may not provide you with enough space to draw.>
308              
309             $driver->finalize($comp);
310              
311             =item B<draw>
312              
313             Handled by L<Graphics::Primitive::Driver>.
314              
315             $driver->draw($comp);
316              
317             =back
318              
319             =head1 METHODS
320              
321             =head2 Constructor
322              
323             =over 4
324              
325             =item I<new>
326              
327             Creates a new Component.
328              
329             =back
330              
331             =head2 Instance Methods
332              
333             =over 4
334              
335             =item I<background_color>
336              
337             Set this component's background color.
338              
339             =item I<border>
340              
341             Set this component's border, which should be an instance of
342             L<Border|Graphics::Primitive::Border>.
343              
344             =item I<callback>
345              
346             Optional callback that is fired at the beginning of the C<finalize> phase.
347             This allows you to add some sort of custom code that can modify the component
348             just before it is rendered. The only argument is the component itself.
349              
350             Note that changing the position or the dimensions of the component will B<not>
351             re-layout the scene. You may have weird results of you manipulate the
352             component's dimensions here.
353              
354             =item I<class>
355              
356             Set/Get this component's class, which is an abitrary string.
357             Graphics::Primitive has no internal use for this attribute but provides it for
358             outside use.
359              
360             =item I<color>
361              
362             Set this component's foreground color.
363              
364             =item I<fire_callback>
365              
366             Method to execute this component's C<callback>.
367              
368             =item I<get_tree>
369              
370             Get a tree for this component. Since components are -- by definiton -- leaf
371             nodes, this tree will only have the one member at it's root.
372              
373             =item I<has_callback>
374              
375             Predicate that tells if this component has a C<callback>.
376              
377             =item I<height>
378              
379             Set this component's height.
380              
381             =item I<inside_bounding_box>
382              
383             Returns a L<Rectangle|Geometry::Primitive::Rectangle> that defines the edges
384             of the 'inside' box for this component. This box is relative to the origin
385             of the component.
386              
387             =item I<inside_height>
388              
389             Get the height available in this container after taking away space for
390             padding, margin and borders.
391              
392             =item I<inside_width>
393              
394             Get the width available in this container after taking away space for
395             padding, margin and borders.
396              
397             =item I<margins>
398              
399             Set this component's margins, which should be an instance of
400             L<Insets|Graphics::Primitive::Insets>. Margins are the space I<outside> the
401             component's bounding box, as in CSS. The margins should be outside the
402             border.
403              
404             =item I<maximum_height>
405              
406             Set/Get this component's maximum height. Used to inform a layout manager.
407              
408             =item I<maximum_width>
409              
410             Set/Get this component's maximum width. Used to inform a layout manager.
411              
412             =item I<minimum_height>
413              
414             Set/Get this component's minimum height. Used to inform a layout manager.
415              
416             =item I<minimum_inside_height>
417              
418             Get the minimum height available in this container after taking away space for
419             padding, margin and borders.
420              
421             =item I<minimum_inside_width>
422              
423             Get the minimum width available in this container after taking away space for
424             padding, margin and borders.
425              
426             =item I<minimum_width>
427              
428             Set/Get this component's minimum width. Used to inform a layout manager.
429              
430             =item I<name>
431              
432             Set this component's name. This is not required, but may inform consumers
433             of a component. Pay attention to that library's documentation.
434              
435             =item I<origin>
436              
437             Set/Get the origin point for this component.
438              
439             =item I<outside_height>
440              
441             Get the height consumed by padding, margin and borders.
442              
443             =item I<outside_width>
444              
445             Get the width consumed by padding, margin and borders.
446              
447             =item I<finalize>
448              
449             Method provided to give component one last opportunity to put it's contents
450             into the provided space. Called after prepare.
451              
452             =item I<padding>
453              
454             Set this component's padding, which should be an instance of
455             L<Insets|Graphics::Primitive::Insets>. Padding is the space I<inside> the
456             component's bounding box, as in CSS. This padding should be between the
457             border and the component's content.
458              
459             =item I<page>
460              
461             If true then this component represents stand-alone page. This informs the
462             driver that this component (and any children) are to be renderered on a single
463             surface. This only really makes sense in formats that have pages such as PDF
464             of PostScript.
465              
466             =item I<prepare>
467              
468             Method to prepare this component for drawing. This is an empty sub and is
469             meant to be overridden by a specific implementation.
470              
471             =item I<preferred_height>
472              
473             Set/Get this component's preferred height. Used to inform a layout manager.
474              
475             =item I<preferred_width>
476              
477             Set/Get this component's preferred width. Used to inform a layout manager.
478              
479             =item I<to_string>
480              
481             Get a string representation of this component in the form of:
482              
483             $name $x,$y ($widthx$height)
484              
485             =item I<visible>
486              
487             Set/Get this component's visible flag.
488              
489             =item I<width>
490              
491             Set/Get this component's width.
492              
493             =back
494              
495             =head1 AUTHOR
496              
497             Cory Watson, C<< <gphat@cpan.org> >>
498              
499             =head1 BUGS
500              
501             Please report any bugs or feature requests to C<bug-geometry-primitive at rt.cpan.org>, or through
502             the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Geometry-Primitive>. I will be notified, and then you'll
503             automatically be notified of progress on your bug as I make changes.
504              
505             =head1 COPYRIGHT & LICENSE
506              
507             Copyright 2008-2009 by Cory G Watson.
508              
509             This program is free software; you can redistribute it and/or modify it
510             under the same terms as Perl itself.