data/models/sprites/makespr32

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