data/models/sprites/makespr32

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5 use Image::Magick;
   6
   7 # SPR32 file format:
   8 #
   9 #       dsprite_s =
  10 #               int ident = "IDSP"
  11 #               int version = 32
  12 #               int type = {projection type enum}
  13 #               float boundingradius
  14 #               int width = width of largest frame
  15 #               int height = height of largest frame
  16 #               int numframes
  17 #               float beamlength
  18 #               int synctype = {ST_SYNC=0, ST_RAND=1}
  19 #
  20 #       Shared Setup:
  21 #               for 1..numframes:
  22 #                       int type = {SPR_SINGLE=0, SPR_GROUP=1}
  23 #                       if type == SPR_GROUP:
  24 #                               int numframes_thisgroup
  25 #                               for 1..numframes_thisgroup:
  26 #                                       float interval
  27 #                       for 1..numframes_thisgroup:
  28 #                               dspriteframe_s =
  29 #                                       int origin_x
  30 #                                       int origin_y
  31 #                                       int width
  32 #                                       int height
  33 #                               width*height*4 bytes of image data, RGBA
  34
  35 my $magick = Image::Magick->new();
  36
  37 sub checkmagick($)
  38 {
  39         my ($e) = @_;
  40         die $e if $e;
  41         return $e;
  42 }
  43
  44 sub writesprite($$)
  45 {
  46         my ($spritestruct, $filename) = @_;
  47         open my $fh, '>', $filename;
  48         binmode $fh;
  49         syswrite $fh, "IDSP";
  50         syswrite $fh, pack 'V', 32;
  51         syswrite $fh, pack 'V', $spritestruct->{type};
  52
  53         my $radius_x = abs(abs($spritestruct->{x0}) > abs($spritestruct->{x1}) ? $spritestruct->{x0} : $spritestruct->{x1});
  54         my $radius_y = abs(abs($spritestruct->{y0}) > abs($spritestruct->{y1}) ? $spritestruct->{y0} : $spritestruct->{y1});
  55
  56         syswrite $fh, pack 'f', sqrt($radius_x * $radius_x + $radius_y * $radius_y);
  57         syswrite $fh, pack 'V', $spritestruct->{x1} - $spritestruct->{x0};
  58         syswrite $fh, pack 'V', $spritestruct->{y1} - $spritestruct->{y0};
  59         syswrite $fh, pack 'V', scalar @{$spritestruct->{groups}};
  60         syswrite $fh, pack 'f', $spritestruct->{beamlength};
  61         syswrite $fh, pack 'V', $spritestruct->{synctype};
  62
  63         for my $g(@{$spritestruct->{groups}})
  64         {
  65                 my $f = $g->{frames};
  66                 if(@$f == 1)
  67                 {
  68                         # no group
  69                         syswrite $fh, pack 'V', 0;
  70                 }
  71                 else
  72                 {
  73                         # group
  74                         syswrite $fh, pack 'V', 1;
  75                         syswrite $fh, pack 'V', scalar @$f;
  76                         syswrite $fh, pack 'f', $_->{interval} for @$f;
  77                 }
  78                 for(@$f)
  79                 {
  80                         syswrite $fh, pack 'V', -$_->{orgx};
  81                         syswrite $fh, pack 'V', $_->{orgy};
  82                         syswrite $fh, pack 'V', $_->{width};
  83                         syswrite $fh, pack 'V', $_->{height};
  84                         syswrite $fh, $_->{data};
  85                 }
  86         }
  87 }
  88
  89 sub spritestruct($$$)
  90 {
  91         my ($type, $beamlength, $synctype) = @_;
  92         return {
  93                 type => $type,
  94                 beamlength => $beamlength,
  95                 synctype => $synctype,
  96                 x0 => 0,
  97                 y0 => 0,
  98                 x1 => 0,
  99                 y1 => 0,
 100                 groups => [
 101                         #       {
 102                         #               frames => [
 103                         #                       {
 104                         #                               width => ...,
 105                         #                               height => ...,
 106                         #                               orgx => ...,
 107                         #                               orgy => ...,
 108                         #                               data => ...,
 109                         #                               interval => ...,
 110                         #                       },
 111                         #               ]
 112                         #       },
 113                 ],
 114         };
 115 }
 116
 117 sub spriteframe($$$$$)
 118 {
 119         my ($spritestruct, $imagefile, $orgx, $orgy, $interval) = @_;
 120         checkmagick $magick->Read($imagefile);
 121         my ($width, $height) = $magick->Get('columns', 'rows');
 122         my $data = $magick->ImageToBlob(depth => 8, magick => 'RGBA');
 123         @$magick = ();
 124         die "Size mismatch for $imagefile: @{[length $data]} is not @{[4 * $width * $height]}"
 125                 if length $data != 4 * $width * $height;
 126         my $g = ($spritestruct->{groups}->[-1]);
 127         push @{$g->{frames}}, my $s = {};
 128         $s->{width} = $width;
 129         $s->{orgx} = $orgx;
 130         $s->{orgy} = $orgy;
 131         $s->{width} = $width;
 132         $s->{height} = $height;
 133         $s->{data} = $data;
 134         $s->{interval} = $interval;
 135
 136         my $x0 = 0 - $orgx;
 137         my $y0 = 0 - $orgy;
 138         my $x1 = $width - $orgx;
 139         my $y1 = $height - $orgy;
 140
 141         $spritestruct->{x0} = $x0 if $width > $spritestruct->{x0};
 142         $spritestruct->{y0} = $y0 if $width > $spritestruct->{y0};
 143         $spritestruct->{x1} = $x1 if $width > $spritestruct->{x1};
 144         $spritestruct->{y1} = $y1 if $width > $spritestruct->{y1};
 145 }
 146
 147 sub spritegroup($)
 148 {
 149         my ($spritestruct) = @_;
 150         push @{$spritestruct->{groups}}, my $g = {};
 151 }
 152
 153 sub usage()
 154 {
 155         die <<EOF;
 156 Usage: $0
 157         -o outfile.spr
 158         [-proj projectiontype]
 159         [-beam beamlength]
 160         [-rand]
 161         [-group]
 162                 -sprite filename.tga orgx orgy interval
 163                 [-sprite filename.tga orgx orgy interval [...]]
 164         [-group
 165                 -sprite filename.tga orgx orgy interval
 166                 [-sprite filename.tga orgx orgy interval [...]] [...]]
 167 EOF
 168 }
 169
 170 my $proj = 2; # SPR_VP_PARALLEL
 171 my $beam = 0;
 172 my $synctype = 0;
 173 my $outfile = undef;
 174
 175 for(;;)
 176 {
 177         usage()
 178                 unless @ARGV;
 179         my $s = shift @ARGV;
 180         if($s eq '-proj')
 181         {
 182                 $proj = shift @ARGV;
 183         }
 184         elsif($s eq '-beam')
 185         {
 186                 $beam = shift @ARGV;
 187         }
 188         elsif($s eq '-rand')
 189         {
 190                 $synctype = 1;
 191         }
 192         elsif($s eq '-o')
 193         {
 194                 $outfile = shift @ARGV;
 195         }
 196         elsif($s eq '-group')
 197         {
 198                 last;
 199         }
 200         elsif($s eq '-sprite')
 201         {
 202                 unshift @ARGV, $s;
 203                 last;
 204         }
 205         else
 206         {
 207                 unshift @ARGV, $s;
 208                 unshift @ARGV, '-sprite';
 209                 last;
 210         }
 211 }
 212
 213 usage() unless defined $outfile;
 214
 215 my $spritestruct = spritestruct($proj, $beam, $synctype);
 216 print "created sprite with projection $proj, beam length $beam, sync type $synctype\n";
 217
 218 spritegroup($spritestruct);
 219 print "  created sprite group\n";
 220
 221 for(;;)
 222 {
 223         last
 224                 unless @ARGV;
 225         my $s = shift @ARGV;
 226         if($s eq '-sprite')
 227         {
 228                 my ($filename, $orgx, $orgy, $interval) = splice @ARGV, 0, 4;
 229                 usage() if not defined $interval;
 230                 spriteframe($spritestruct, $filename, $orgx, $orgy, $interval);
 231                 print "    created sprite frame $filename, origin at $orgx|$orgy, interval $interval\n";
 232         }
 233         elsif($s eq '-group')
 234         {
 235                 spritegroup($spritestruct);
 236                 print "  created sprite group\n";
 237         }
 238         else
 239         {
 240                 my ($orgx, $orgy, $interval) = splice @ARGV, 0, 3;
 241                 usage() if not defined $interval;
 242                 spriteframe($spritestruct, $s, $orgx, $orgy, $interval);
 243                 print "    created sprite frame $s, origin at $orgx|$orgy, interval $interval\n";
 244         }
 245 }
 246
 247 writesprite($spritestruct, $outfile);
 248 print "written to $outfile\n";