home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Updates / Perl / Non-RPC / !Perl / riscos / RISCOS / DrawFile / Container.pm < prev    next >
Text File  |  1999-01-20  |  19KB  |  632 lines
  1. package RISCOS::DrawFile::Container;
  2.  
  3. require RISCOS::DrawFile::Common;
  4. require RISCOS::DrawFile::FontTable;
  5. require RISCOS::DrawFile::Text;
  6. require RISCOS::DrawFile::TextArea;
  7. require RISCOS::DrawFile::OpaqueObject;
  8. require RISCOS::DrawFile::Group;
  9. require RISCOS::DrawFile::TagObject;
  10. require RISCOS::DrawFile::Options;
  11. require RISCOS::DrawFile::Path;
  12. require RISCOS::DrawFile::Sprite;
  13. require RISCOS::DrawFile::JPEG;
  14. use Carp;
  15. use strict;
  16. use vars qw ($VERSION @ISA %objs @EXPORT_OK);
  17.  
  18. @ISA = qw(RISCOS::DrawFile::Common Exporter);
  19. @EXPORT_OK = 'split_drawobjs';
  20. $VERSION = 0.07;
  21. # 0.07 adds Translate, MoreStuff
  22. # 0.06
  23. # Replace returns () not undef. Bozo
  24. # localise $_ in map (by hook or by crook)
  25. # 0.05
  26. # split_drawobjs as a function.
  27. # 0.04
  28. # Name changes along with copy constructor.
  29. # 0.03
  30. # Added Replace. Documentation up to date
  31. # 0.02
  32. # Remember to undef the bounding box if we change the 'stuff'
  33. # Now copes elegantly if container contains no objects with valid bboxes.
  34.  
  35. sub Objfunc {
  36.     \%objs;
  37. }
  38. %objs = (
  39.     0    => sub { RISCOS::DrawFile::FontTable->new (@_) },    # FontTable
  40.     2    => sub { RISCOS::DrawFile::Path->new (@_) },        # Path
  41.     6    => sub { new RISCOS::DrawFile::Group @_ },        # Group
  42.     7    => sub { new RISCOS::DrawFile::TagObject @_ },        # Tag
  43.     9    => sub { new RISCOS::DrawFile::TextArea @_ },        # Text Area
  44.     16    => sub { new RISCOS::DrawFile::JPEG @_ },        # JPEG
  45. );
  46. $objs{1} =    # Text
  47. $objs{12} =    # Transformed Text
  48. sub { new RISCOS::DrawFile::Text @_ };
  49.  
  50. $objs{5} =    # Sprite
  51. $objs{13} =    # Transformed Sprite
  52. sub { new RISCOS::DrawFile::Sprite @_ };
  53. $objs{11} =    # Draw options
  54. $objs{101} =    # DrawPlus options
  55. sub { new RISCOS::DrawFile::Options @_ };
  56.  
  57. ### use SelfLoader;
  58. sub RISCOS::DrawFile::Container::new ;
  59. sub RISCOS::DrawFile::Container::Stuff ;
  60. sub RISCOS::DrawFile::Container::MoreStuff ;
  61. sub RISCOS::DrawFile::Container::PrePack ;
  62. sub RISCOS::DrawFile::Container::Size ;
  63. sub RISCOS::DrawFile::Container::Pack ;
  64. sub RISCOS::DrawFile::Container::Write ;
  65. sub RISCOS::DrawFile::Container::_split_drawobjs ($$$$$$$);
  66. sub RISCOS::DrawFile::Container::split_drawobjs ($$;$$$$$);
  67. sub RISCOS::DrawFile::Container::Second_Font_Table ;
  68. sub RISCOS::DrawFile::Container::Unknown_Obj ;
  69. sub RISCOS::DrawFile::Container::BBox_Calc ;
  70. sub RISCOS::DrawFile::Container::Translate ;
  71. sub RISCOS::DrawFile::Container::DoToAll ;
  72. sub RISCOS::DrawFile::Container::Do ;
  73. sub RISCOS::DrawFile::Container::Replace ;
  74. sub RISCOS::DrawFile::Container::Change ;
  75. sub RISCOS::DrawFile::Container::ChangeString ;
  76. 1;
  77. ### __DATA__
  78.  
  79. sub new {
  80.     my $proto = shift;
  81.     my $class = ref($proto) || $proto;
  82.     my $self = {};
  83.  
  84.     $self->{'__STUFF'} = (ref($_[0]) eq 'ARRAY') ? $_[0] : [@_];
  85.  
  86.     return bless ($self, $class);
  87. }
  88.  
  89. sub Stuff {
  90.     my $self = shift;
  91.     my $stuff = $self->{'__STUFF'};
  92.     my $newstuff = (ref($_[0]) eq 'ARRAY') ? $_[0] : \@_;
  93.  
  94.     if (@$newstuff) {
  95.     my $use = [];
  96.     foreach (@$newstuff) {
  97.         push @$use, $_ if defined $_;
  98.     }
  99.     $self->{'__STUFF'} = $use;
  100.     undef $self->{'__BBOX'};
  101.     }
  102.     $stuff;
  103. }
  104.  
  105. sub MoreStuff {
  106.     my $self = shift;
  107.     my $stuff = $self->{'__STUFF'};
  108.     my $newstuff = (ref($_[0]) eq 'ARRAY') ? $_[0] : \@_;
  109.  
  110.     if (@$newstuff) {
  111.     
  112.     foreach (@$newstuff) {
  113.         push @$stuff, $_ if defined $_;
  114.     }
  115.     undef $self->{'__BBOX'};
  116.     }
  117.     $stuff;
  118. }
  119.  
  120. # For me when I'm feeling daft - this recursively calls PrePack, not BBox_Calc.
  121. # So don't try to change (read break) it.
  122. sub PrePack {
  123.     my $self = shift;
  124.     return undef unless @{$self->{'__STUFF'}};
  125.     my $box;
  126.  
  127.     foreach (@{$self->{'__STUFF'}}) {
  128.     next unless (my $subbox = $_->PrePack (@_));
  129.     confess "$#$subbox $_" unless defined $$subbox[3];
  130.     if (defined $box) {
  131.         $$box[0] = $$subbox[0] if $$box[0] > $$subbox[0];    # min
  132.         $$box[1] = $$subbox[1] if $$box[1] > $$subbox[1];
  133.         $$box[2] = $$subbox[2] if $$box[2] < $$subbox[2];    # max
  134.         $$box[3] = $$subbox[3] if $$box[3] < $$subbox[3];
  135.     } else {
  136.         $box = [@$subbox];
  137.     }
  138.     }
  139.     $self->{'__BBOX'} = $box;    # Return the bbox we made, and store it
  140. }
  141.  
  142. sub Size {
  143.     my $self = shift;
  144.     my $size = 0;
  145.     foreach (@{$self->{'__STUFF'}}) {
  146.     $size += $_->Size;
  147.     }
  148.     $size;
  149. }
  150.  
  151. # fonttable    (as param 2)
  152. sub Pack {
  153.     my $self = shift;
  154.     join '', map { $_->Pack (@_)} (@{$self->{'__STUFF'}});
  155. }
  156.  
  157. # handle
  158. # fonttable
  159. sub Write {
  160.     my $self = shift;
  161.     my $good = 0;
  162.     foreach (@{$self->{'__STUFF'}}) {
  163.     $good &= $_->Write (@_);
  164.     }
  165.     $good;
  166. }
  167.  
  168. # Data    scalar        data
  169. #    scalar ref    type, length, bbox striped
  170. #    array ref    array of objects for group
  171. #            array
  172. #    hash ref    ?? array, name, type data ?? dunno...
  173. # type split
  174. #    function ref    pass unpslit type
  175. #            returns (type, layer, flags, spare) or (type)
  176. #    array ref    (type, layer, flags, spare)
  177. # ref to fonttable (starts as undef)
  178. # sub constructors (array or hash - both!)
  179. # duplicate font table
  180. # unknown object constructor.
  181.  
  182. # Constructors return an array of
  183. # single object / array ref to array of objects
  184. # type (or undef)
  185. # fonttable (if found)
  186.  
  187. sub _split_drawobjs ($$$$$$$) {
  188.     shift;    # my $self = shift;
  189.     my $data = shift;    # Don't want to clobber it.
  190.     my ($split, $fonttable, $subconst, $fontfunc, $unk) = @_;
  191.     unshift @_, undef;
  192.     carp "Can't split a " . ref ($data) . ' ref, only SCALAR refs'
  193.       unless ref ($data) eq 'LVALUE' || ref ($data) eq 'SCALAR';
  194.  
  195.     my ($position, $stuff, $font) = (0);
  196.     while ($position < length ($$data)) {
  197.     my ($type, $length) = unpack 'I2', substr $$data, $position;
  198.     $type = &$split ($type) if defined $split;
  199.  
  200.     my $func;
  201.     if (ref ($subconst) eq 'HASH') {
  202.          $func = $subconst->{$type};
  203.     } elsif (ref ($subconst) eq 'ARRAY') {
  204.          $func = $subconst->[$type];
  205.     } else {
  206.     carp "Can't lookup objects in a " . ref ($subconst) . ' ref';
  207.     }
  208.     $func = $unk unless (defined $func);
  209.  
  210.     $_[0] = substr $$data, $position, $length;
  211.     my @result = $func->(@_);
  212.     # Pass on @_;
  213.     if (ref $result[2] eq 'RISCOS::DrawFile::FontTable') {
  214.  
  215.         if (defined $$fonttable) {
  216.         $fontfunc->(@_);    # Got one already
  217.         } else {
  218.         $$fonttable = $font = $result[2];    # Store FontTable ref
  219.         }
  220.     }
  221.     push @$stuff, (ref ($result[0]) eq 'ARRAY') ? @{$result[0]} : $result[0]
  222.       if defined $result[0];
  223.     $position += $length;
  224.     }
  225.     ($stuff, undef, $font);
  226. }
  227. sub split_drawobjs ($$;$$$$$) {
  228.     if (defined ($_[2]) and $_[2] eq '+') {
  229.     $_[2] = \&RISCOS::DrawFile::Common::drawplus_split_type;
  230.     }
  231.     $_[3] = {} unless defined $_[3];
  232.     $_[4] = defined $_[0] ? $_[0]->Objfunc() : Objfunc() unless defined $_[4];
  233.     $_[5] = defined $_[0] ? $_[0]->can ('Second_Font_Table')
  234.               : \&Second_Font_Table
  235.       unless defined $_[5];
  236.     $_[6] = defined $_[0] ? $_[0]->can ('Unknown_Obj')
  237.               : \&Unknown_Obj
  238.       unless defined $_[6];
  239.     goto &_split_drawobjs;
  240. }
  241.  
  242. sub Second_Font_Table {
  243.     carp 'Duplicate font table size ' . length ($_[0]) . ' found - will ignore';
  244.     ();
  245. }
  246.  
  247. sub Unknown_Obj {
  248.     carp sprintf 'Uknown object type &%08X size %d found - will treat as opaque',
  249.          unpack ('I', $_[0]), length ($_[0]);
  250.     new RISCOS::DrawFile::OpaqueObject @_;
  251. }
  252.  
  253. sub BBox_Calc {
  254.     my $self = shift;
  255.     return undef unless @{$self->{'__STUFF'}};
  256.     my $box;
  257.  
  258.     foreach (@{$self->{'__STUFF'}}) {
  259.     next unless (my $subbox = $_->BBox_Calc);
  260.     if (defined $box) {
  261.         $$box[0] = $$subbox[0] if $$box[0] > $$subbox[0];    # min
  262.         $$box[1] = $$subbox[1] if $$box[1] > $$subbox[1];
  263.         $$box[2] = $$subbox[2] if $$box[2] < $$subbox[2];    # max
  264.         $$box[3] = $$subbox[3] if $$box[3] < $$subbox[3];
  265.     } else {
  266.         $box = [@$subbox];
  267.     }
  268.     }
  269.     $self->{'__BBOX'} = $box;    # Return the bbox we made, and store it
  270. }
  271.  
  272. sub Translate {
  273.     my $self = shift;
  274.  
  275.     foreach (@{$self->{'__STUFF'}}) {
  276.     $_->Translate (@_);
  277.     }
  278.     undef $self->{'__BBOX'};
  279.     ()
  280. }
  281.  
  282. sub DoToAll {
  283.     my $self = shift;
  284.     my $what = shift;
  285.     map {
  286.     my (@args, @result) = @_;    # @args gobbles all of @_
  287.     my ($object, $method) = $_;
  288.     if (defined ($method = $object->can ('DoToAll'))) {
  289.         @result = &$method ($object, $what, @args);
  290.     }
  291.     if ('CODE' eq ref $what) {
  292.         push @result, &$what ($object, @args);
  293.     } elsif (defined ($method = $object->can ($what))) {
  294.         push @result, &$method ($object, @args)
  295.     }
  296.     $_ = $object;    # In effect localise it
  297.     @result;    # It's map, remember.
  298.     } (@{$self->{'__STUFF'}})
  299. }
  300.  
  301. sub Do {
  302.     my $self = shift;
  303.     my $what = shift;
  304.     map {
  305.     my (@args, @result) = @_;    # @args gobbles all of @_
  306.     my ($object, $method) = $_;
  307.     if (defined ($method = $object->can ('Do'))) {
  308.         @result = &$method ($object, $what, @args);
  309.     } else {
  310.         if ('CODE' eq ref $what) {
  311.         @result = &$what ($object, @args);
  312.         } elsif (defined ($method = $object->can ($what))) {
  313.         @result = &$method ($object, @args)
  314.         }
  315.     }
  316.     $_ = $object;
  317.     @result;    # It's map, remember.
  318.     } (@{$self->{'__STUFF'}})
  319. }
  320.  
  321. sub Replace {
  322.     my $self = shift;
  323.     my $what = shift;
  324.     @{$self->{'__STUFF'}} = map {
  325.     my (@args, @result) = @_;    # @args gobbles all of @_
  326.     my ($object, $method) = $_;
  327.     if (defined ($method = $object->can ('Replace'))) {
  328.         @result = &$method ($object, $what, @args);
  329.     } else {
  330.         if ('CODE' eq ref $what) {
  331.         @result = &$what ($object, @args);
  332.         } elsif (defined ($method = $object->can ($what))) {
  333.         @result = &$method ($object, @args)
  334.         }
  335.     }
  336.     $_ = $object;
  337.     @result;    # It's map, remember.
  338.     } (@{$self->{'__STUFF'}});
  339.     # If we still contain anything, return ourself.
  340.     @{$self->{'__STUFF'}} ? $self : ();
  341. }
  342.  
  343. sub Change {
  344.     my $self = shift;
  345.     my $what = shift;
  346.     my $old = shift;
  347.     map {
  348.     my (@args, @result) = @_;    # @args gobbles all of @_
  349.     my ($object, $method) = $_;
  350.     if (defined ($method = $object->can ('Change'))) {
  351.         @result = &$method ($object, $what, @args);
  352.     }
  353.     if (defined ($method = $object->can ($what))) {
  354.         push @result, &$method ($object, @args)
  355.            if $old = &$method ($object);
  356.     }
  357.     $_ = $object;
  358.     @result;    # It's map, remember.
  359.     } (@{$self->{'__STUFF'}})
  360. }
  361.  
  362. sub ChangeString {
  363.     my $self = shift;
  364.     my $what = shift;
  365.     my $old = shift;
  366.     map {
  367.     my (@args, @result) = @_;    # @args gobbles all of @_
  368.     my ($object, $method) = $_;
  369.     if (defined ($method = $object->can ('ChangeString'))) {
  370.         @result = &$method ($object, $what, @args);
  371.     }
  372.     if (defined ($method = $object->can ($what))) {
  373.         push @result, &$method ($object, @args)
  374.            if $old eq &$method ($object);
  375.     }
  376.     $_ = $object;
  377.     @result;    # It's map, remember.
  378.     } (@{$self->{'__STUFF'}})
  379. }
  380.  
  381. 1;
  382. __END__
  383.  
  384. =head1 NAME
  385.  
  386. RISCOS::DrawFile::Container
  387.  
  388. =head1 SYNOPSIS
  389.  
  390. Abstract base class for classes that hold other DrawFile objects.
  391.  
  392. =head1 DESCRIPTION
  393.  
  394. C<RISCOS::DrawFile::Container> provides an abstract base class for classes that
  395. hold other DrawFile objects (groups, tagged objects and DrawFiles themselves.
  396. C<RISCOS::DrawFile::Container> itself is not a C<RISCOS::DrawFile::Object>, as
  397. not all classes which derive from it are objects found in DrawFiles.
  398.  
  399. =head2 Methods
  400.  
  401. =over 4
  402.  
  403. =item new <contents>
  404.  
  405. creates a new object. If I<contents> is an array reference it is dereferenced.
  406. The array of objects (if any) is used as the container's contents.
  407.  
  408. =item Stuff [<new_contents>]
  409.  
  410. returns a reference to the array of contents. If I<new_contents> are given, then
  411. these replace the existing contents (and the old contents are returned). If
  412. I<new_contents> is an array reference it is automatically dereferenced first.
  413.  
  414. =item MoreStuff [<additional_contents>]
  415.  
  416. adds I<new_contents> existing contents, returning a reference to the array of
  417. contents.  If I<additional_contents> is an array reference it is automatically
  418. dereferenced first.
  419.  
  420. =item Do <what>, arguments...
  421.  
  422. recursively does something to all contained objects.
  423.  
  424. For each contained item:
  425.  
  426. =over 4
  427.  
  428. =item *
  429.  
  430. If it has a C<Do> method, calls it with the arguments passed to this method.
  431.  
  432. =item *
  433.  
  434. If <what> is a code reference, calls it as
  435.  
  436.     &what (object, arguments...)
  437.  
  438. else looks for a method I<what> in the object, and if found calls that method
  439. with the arguments given
  440.  
  441. =back
  442.  
  443. C<Do> returns the list of all results returned from all called subroutines.
  444.  
  445. This method is extremely powerful. For example, to set all line widths to thin
  446. in the object C<$draw>
  447.  
  448.     $draw->Do('Width', 0);
  449.  
  450. To change all occurrences of the font 'Homerton.Medium' to 'AvantG.Book' in all
  451. text objects you could do:
  452.  
  453.     $draw->Do(sub {$_[0]->Font ('AvantG.Book')
  454.              if $_[0]->can('Font')
  455.             and $_[0]->Font() eq 'Homerton.Medium'});
  456.  
  457. (note that if you pass code you need to check that the method exists with C<can>
  458. before you try to call it) but you'd be much better off with
  459.  
  460.     $draw->ChangeString('Font','Homerton.Medium','AvantG.Book');
  461.  
  462. (see below)
  463.  
  464. =item DoToAll <what>, arguments...
  465.  
  466. is like C<Do> except that it also calls the named method or code reference on
  467. contained containers, unlike C<Do> which only calls it on objects which do not
  468. possess their own C<Do> to recurse to. Unless you want to alter contained Groups
  469. or Tag objects in some way, you probably don't want to call C<DoToAll> as it
  470. will return an possibly unhelpful list of results - for example if the result
  471. array is all objects inside a bounding box you may get objects within groups
  472. multiple times; once when the check is performed on the object itself, and again
  473. within each group that also meets the test condition.
  474.  
  475. =item Replace <what>, arguments...
  476.  
  477. is like C<Do> except it I<replaces> the contents of each container with the
  478. return values of I<what>, so I<what> had better be returning DrawFile objects.
  479. If a container contains at least one object afterwards it returns a reference to
  480. itself, whereas an empty container returns C<undef>. Beware that this way a
  481. container (I<e.g.> an entire DrawFile) can end up deleting itself, so B<do>
  482. check the return value, before your script crashes when attempting to call a
  483. method on a now undefined scalar.
  484.  
  485.  
  486. =item Change <method_name>, <test_value> arguments...
  487.  
  488. is similar to C<Do>, but can only take a named method. The method is called with
  489. no arguments in scalar context, and if the result is I<numerically> equal
  490. (C<==>) to I<test_value> the method is called again with the arguments supplied.
  491.  
  492. So to change all 4 point lines to 6
  493.  
  494.     $draw->Change('Width', 2560, 3840);
  495.  
  496. (without having to ungroup or regroup anything...)
  497.  
  498. =item ChangeString <method_name>, <test_value> arguments...
  499.  
  500. is identical to C<Change> except that the comparison is for a string (C<eq>).
  501.  
  502.     $draw->ChangeString('Font','Homerton.Medium','AvantG.Book');
  503.  
  504. =item BBox
  505.  
  506. returns a reference to an array giving the bounding box, or C<undef> if there is
  507. no bounding box for this object (I<e.g.> an empty group, a tagged empty path).
  508. C<BBox> will call C<BBox_Calc> if the bounding box is currently unknown.
  509.  
  510. As the returned array reference B<is> the internal copy of the bounding box it
  511. must not be modified.
  512.  
  513. =item BBox_Calc
  514.  
  515. recalculates and returns the bounding box, by calling C<BBox_Calc> for each
  516. contained object and merging the bounding boxes. C<BBox_Calc> will return
  517. C<undef> if no contained object returned a valid bounding box. (This is far more
  518. elegant than returning (int_max, int_max, int_min, int_min), as is the wont of
  519. C<Draw_ProcessPath> when presented with an empty path - yes, we're trapping this
  520. one, and C<Font_ScanString> when given an empty string).
  521.  
  522. =item PrePack <hash_reference>
  523.  
  524. is provided as a hook to perform calculations immediately before saving a
  525. DrawFile. The hash reference is used to store the names of fonts needed in the
  526. FontTable by C<RISCOS::DrawFile::Text> objects. C<PrePack> calls
  527. C<PrePack> for each contained object, and merges the bounding boxes.
  528.  
  529. =item Size
  530.  
  531. returns the size of the object when saved in a DrawFile, by summing the results
  532. of calling C<Size> on the contents.
  533.  
  534. =item Pack <undef>, fonttable, ...
  535.  
  536. returns a scalar containing the object packed ready to save into a DrawFile, by
  537. concatenating the results of calling C<Pack> on the contents.
  538.  
  539. =item Write <filehandle>, <fonttable>, ...
  540.  
  541. writes the object to the given filehandle. The default implementation calls
  542. C<Write> with the remainder of the argument list for each item in the contents,
  543. returning false if any call to C<Write> did not return true.
  544.  
  545. =item Second_Font_Table
  546.  
  547. prints a warning that a second font table has been found, and returns an empty
  548. list. Mostly of use to the DrawFile class.
  549.  
  550. =item Objfunc
  551.  
  552. returns a reference to a hash of code references, keyed by object type. This
  553. hash determines the correct object constructor to call when the DrawFile data is
  554. split into objects. Mostly of use to the DrawFile class.
  555.  
  556. =item Unknown_Obj
  557.  
  558. prints a warning that an unknown object type has been found, and returns the
  559. result of calling C<RISCOS::DrawFile::OpaqueObject>. Mostly of use to the
  560. DrawFile class.
  561.  
  562. =item _split_drawobjs <data>, <split>, <fonttable>, <sub_constructors>, <duplicate_fonttable>, <unknown_object>
  563.  
  564. splits the data passed as a B<scalar reference> into a list of DrawFile objects.
  565. I<split> is a split function as described in C<new> in
  566. C<RISCOS::DrawFile::Object>. I<fonttable> is initially C<undef>, but for
  567. recursive calls is replaced with the fonttable object once found.
  568. I<sub_constructors> is a hash or array reference used to find code to construct
  569. objects keyed by type. Usually this is supplied by calling C<Objfunc>, but a
  570. custom hash/array can be used. I<duplicate_fonttable> is called as a constructor
  571. when a second fonttable is found. Usually this is a reference to
  572. C<&Second_Font_Table>. I<unknown_object> is called as a constructor for any
  573. object type not found in I<sub_constructors>. Usually this is a reference to
  574. I<&Unknown_Obj>.
  575.  
  576. C<_split_drawobjs> returns a list ([objects], undef, fonttable) as for a
  577. DrawFile object constructor.
  578.  
  579. This method is used by groups and DrawFile objects to split their contents into
  580. objects. It probably isn't needed by anyone else.
  581.  
  582. =item Do <what>, arguments...
  583.  
  584. recursively does something to all contained objects.
  585.  
  586. For each contained item:
  587.  
  588. =over 4
  589.  
  590. =item *
  591.  
  592. If it has a C<Do> method, calls it with the arguments passed to this method.
  593.  
  594. =item *
  595.  
  596. If <what> is a code reference, calls it as
  597.  
  598.     &what (I<object>, I<arguments...>
  599.  
  600. else looks for a method I<what> in the object, and if found calls that method
  601. with the arguments given
  602.  
  603. =back
  604.  
  605. C<Do> returns the list of all results returned from all called subroutines.
  606.  
  607. This method is extremely powerful. For example, to set all line widths to thin
  608. in the object C<$draw>
  609.  
  610.     $draw->Do('Width', 0);
  611.  
  612. To change all occurrences of the font 'Homerton.Medium' to 'AvantG.Book' in all
  613. text objects:
  614.  
  615.     $draw->Do(sub {$_[0]->Font ('AvantG.Book')
  616.              if $_[0]->can('Font')
  617.             and $_[0]->Font() eq 'Homerton.Medium'});
  618.  
  619. (note that if you pass code you need to check that the method exists with C<can>
  620. before you try to call it)
  621.  
  622. =back
  623.  
  624. =head1 BUGS
  625.  
  626. Currently doesn't allow derived classes to limit the number of objects that they
  627. can hold. (C<TagObject>s only hold one object)
  628.  
  629. =head1 AUTHOR
  630.  
  631. Nicholas Clark <F<nick@unfortu.net>>
  632.