home *** CD-ROM | disk | FTP | other *** search
/ Acorn User 10 / AU_CD10.iso / Updates / Perl / Non-RPC / !Perl / riscos / RISCOS / DrawFile.pm < prev    next >
Text File  |  1999-01-19  |  8KB  |  240 lines
  1. package RISCOS::DrawFile;
  2.  
  3. use strict;
  4. use vars qw ($VERSION @ISA);
  5.  
  6. require RISCOS::DrawFile::Container;
  7.  
  8. use RISCOS::File 0.03 qw(load filetype settype);
  9. use Carp;
  10. use IO::File;
  11.  
  12. $VERSION = 0.04;
  13. @ISA = 'RISCOS::DrawFile::Container';
  14.  
  15. # 0.04
  16. # Add undef as a possible [] of contents, and as a Filetype(undef)
  17. # 0.03
  18. # Write blank DrawFiles.
  19. # Add Write to documentation
  20.  
  21. sub group {new RISCOS::DrawFile::Group @_}
  22.  
  23. sub new {
  24.     my $proto = shift;
  25.     my $class = ref($proto) || $proto;
  26.     
  27.     if (defined $_[0] and ref ($_[0]) eq $class) {
  28.     return $_[0]->Clone();
  29.     # Copy it and all done [note that this is derived class safe :-) ]
  30.     }
  31.  
  32.     my $self = $class->SUPER::new();
  33.  
  34.     my ($contents, $oldfont, $minor, $creator, $filetype);
  35.     
  36.     if (ref($_[0]) eq 'ARRAY' or !defined $_[0]) {
  37.     ($contents, $creator, $oldfont, $filetype) = @_;
  38.     $contents = [] unless defined $contents;
  39.     $filetype = 0xAFF unless defined $filetype;
  40.     $minor = 0;
  41.     } else {
  42.     # arg 0 is filename (whatever)
  43.     # arg 1 is type splitfunction
  44.     my $split = $_[1];
  45.     $split = \&RISCOS::DrawFile::Common::drawplus_split_type
  46.       if defined $split and $split eq '+';
  47.     my ($file, $a, $b, $load, $exec) = &load;    # Pass on our arguments
  48.     
  49.     unless (defined $file) {
  50.         carp 'Could not load file' if $^W;
  51.         return undef;
  52.     }
  53.     $filetype = defined $load ? filetype ($load) : 0xAFF;
  54.     my ($tag, $major);    # Ignore BBox in file header - will recalculate
  55.     ($tag, $major, $minor, $creator) = unpack 'a4I2A12', $file;
  56.     unless ($tag eq 'Draw') {
  57.         carp "File is not a DrawFile ('$tag')" if $^W;
  58.         return undef;
  59.     }
  60.     unless ($major == 201) {
  61.         carp "DrawFile major version $major != 201" if $^W;
  62.         return undef;
  63.     }
  64.     
  65.     ($contents, undef, $oldfont) = $self->_split_drawobjs
  66.       (\(substr $file, 40), $split, \$oldfont, $self->Objfunc(),
  67.        $self->can ('Second_Font_Table'), $self->can ('Unknown_Obj'));
  68.     }
  69.     $self->Stuff ($contents);
  70.     $self->{'__CREATOR'} = defined $creator ? $creator : "PerlDraw$VERSION";
  71.     $self->{'__MINOR'} = $minor;
  72.     $self->{'__FONT'} = defined ($oldfont) ? $oldfont : [];
  73.     $self->{'__FILETYPE'} = $filetype;
  74.         
  75.     bless ($self, $class);
  76. }
  77.  
  78. # Really not tested.
  79. sub Pack {
  80.     my $self = shift;
  81.  
  82.     my $used_fonts = {};
  83.     my $bbox = $self->PrePack($used_fonts);
  84.     $_[1] = RISCOS::DrawFile::FontTable->new($used_fonts);
  85.     pack ('A4I2A12i4', 'Draw', $self->Major(), $self->Minor(), $self->Creator(),
  86.       ($bbox ? @$bbox : (0,0,0,0)))
  87.       . $_[1]->Pack (@_)    # Fonttable
  88.       . $self->SUPER::Pack (@_);
  89. }
  90.  
  91. sub Write {
  92.     local $\; undef $\;
  93.     my $self = shift;
  94.     $self = RISCOS::DrawFile->new ([])
  95.       if !defined $self or $self eq __PACKAGE__;
  96.     # Create an empty DrawFile to write
  97.  
  98.     unless (ref($_[0]) ? (ref($_[0]) eq 'GLOB'
  99.               || UNIVERSAL::isa($_[0], 'GLOB')
  100.               || UNIVERSAL::isa($_[0], 'IO::Handle'))
  101.                : (ref(\$_[0]) eq 'GLOB')) {
  102.     my $file = shift;
  103.     unshift @_ , new IO::File ">$file";
  104.     croak "Unable to open '$file': $!" unless $_[0];
  105.     # Can't overwrite $_[0] as it may be read only.
  106.     }
  107.     my $used_fonts = {};
  108.     my $bbox = $self->PrePack($used_fonts);
  109.     my $good = print {$_[0]} pack 'A4I2A12i4', 'Draw', $self->Major(),
  110.                         $self->Minor(),
  111.                         $self->Creator(),
  112.                         ($bbox ? @$bbox : (0,0,0,0));
  113.     # Do the fonttable here.
  114.     if (%$used_fonts) {
  115.         $_[1] = RISCOS::DrawFile::FontTable->new($used_fonts);
  116.         $_[1]->Write (@_);
  117.     }
  118.     $good = settype ($self->{'__FILETYPE'}, $_[0])
  119.       if defined $self->{'__FILETYPE'};
  120.     $good & $self->SUPER::Write (@_);
  121. }
  122.  
  123. sub Major { 201; }
  124. sub Minor {
  125.     my $self = shift;
  126.     my $minor = $self->{'__MINOR'};
  127.     $self->{'__MINOR'} = $_[0] if defined $_[0];
  128.     $minor;
  129. }
  130. sub Creator {
  131.     my $self = shift;
  132.     my $creator = $self->{'__CREATOR'};
  133.     $self->{'__CREATOR'} = $_[0] if defined $_[0];
  134.     $creator;
  135. }
  136.  
  137. sub FileType {
  138.     my $self = shift;
  139.     my $filetype = $self->{'__FILETYPE'};
  140.     $self->{'__FILETYPE'} = $_[0] if @_;
  141.     $filetype;
  142. }
  143. 1;
  144. __END__
  145.  
  146. =head1 NAME
  147.  
  148. RISCOS::DrawFile
  149.  
  150. =head1 SYNOPSIS
  151.  
  152. A class to manipulate DrawFiles
  153.  
  154. =head1 DESCRIPTION
  155.  
  156. C<RISCOS::DrawFile> provides a class to manipulate DrawFiles. It is derived from
  157. C<RISCOS::DrawFile::Container> (which provides all the really cool methods),
  158. and provides the following additional methods.
  159.  
  160. =over 4
  161.  
  162. =item new [<contents>, [<creator>, [<oldfont>, [<filetype>]]]]
  163.  
  164. =item new <filename>, [<split_function>]
  165.  
  166. creates a new DrawFile. If the first argument is C<undef> or a reference to an
  167. array it is taken to be an array of objects derived from
  168. <RISCOS::DrawFile::Object> which are to be used as the contents. Otherwise the
  169. first argument is passed to C<RISCOS::File::load>, so I<filename> can actually
  170. be a filehandle, or the file data to use.
  171.  
  172. I<creator> defaults to C<"PerlDraw$VERSION">, which at 12 characters can cause
  173. problems for some drawing programs (I<e.g.> DrawPlus prior to 2.41). I<oldfont>
  174. if defined should be a reference to an array of fonts found when loading the
  175. DrawFile and isn't really used, as C<RISCOS::DrawFile::TextObject> objects each
  176. store their own font. I<filetype> defaults to 0xAFF (DrawFile).
  177.  
  178. I<split_function> is passed as the second argument to
  179. C<RISCOS::DrawFile::Object::new> for each object found in the DrawFile to
  180. process the DrawFile object type to extract layer information. If defined this
  181. should either be a code reference, or the string 'C<+>' to use
  182. C<RISCOS::DrawFile::Common::drawplus_split_type>
  183.  
  184. =item Write <filename>
  185.  
  186. =item Write <filehandle>
  187.  
  188. writes the DrawFile to the given filename or filehandle, and attempts to set the
  189. file's filetype to the type set/returned with C<FileType>. Calling this Write as
  190. a class method will write an empty DrawFile:
  191.  
  192.     
  193.     Write RISCOS::DrawFile ('DrawFile')    # Write a blank DrawFile
  194.     RISCOS::DrawFile->Write ('DrawFile')   # There's More Than One Way To Do It
  195.  
  196. =item Major
  197.  
  198. returns the major version number of this DrawFile, which will always be 201.
  199. C<new> will correctly refuse to load DrawFiles with any other major version
  200. number.
  201.  
  202. =item Minor [<version>]
  203.  
  204. returns the minor version number of this DrawFile. If an defined argument is
  205. supplied sets the minor verion to this, and returns the old value.
  206.  
  207. =item Creator [<creator>]
  208.  
  209. returns the creator string for this DrawFile. If an defined argument is
  210. supplied sets the creator, and returns the old value. Creator strings are
  211. truncated or padded with B<spaces> to give 12 characters when the DrawFile is
  212. written out. Note that 12 character creator names can cause problems for poorly
  213. written programs.
  214.  
  215. =item FileType [<filetype>]
  216.  
  217. returns the filetype that C<Write> will give this file. If I<filetype> is
  218. supplied this value is set, and the old value returned. The value is stored
  219. verbatim, relying on C<RISCOS::File::settype> to do any conversion necessary.
  220. If the filetype is C<undef> then C<Write> will not attempt to set the filetype.
  221.  
  222. Note that while C<RISCOS::DrawFile> has no problem loading Equasor files, the
  223. file written out will have the FontTable as first object, rather than the tagged
  224. empty path that Equasor expects, and so Equasor will refuse to recognise the
  225. file. Regrettably the transparency that C<RISCOS::DrawFile> by automaticaly
  226. tabulating fonts and creating a FontTable means that it is not possible for this
  227. general purpose class to ensure that the FontTable is at a specific loation
  228. within the file. (Well, not without breaking various other programs that wrongly
  229. expect the FontTable to be the B<very> first object in a file. RTFM carefully.)
  230.  
  231. =back
  232.  
  233. =head1 BUGS
  234.  
  235. Not tested enough. Especially C<Pack>
  236.  
  237. =head1 AUTHOR
  238.  
  239. Nicholas Clark <F<nick@unfortu.net>>
  240.