blob: 941567ea8e2d13fd3b04abab507862d23d29c79a (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
package Games::NES::SpriteMaker;
use strict;
use warnings;
use Image::PNM;
sub image_to_sprite {
my ($data) = @_;
my $image = Image::PNM->new($data);
if ($image->width % 8 || $image->height % 8) {
die "Sprite collections must be tiles of 8x8 sprites (not "
. $image->width . "x" . $image->height . ")";
}
my %colors = _get_palette_colors($image);
my $sprite_x = $image->width / 8;
my $sprite_y = $image->height / 8;
my $bytes = '';
for my $base_x (0..$sprite_x-1) {
for my $base_y (0..$sprite_y-1) {
for my $pixel_x ($base_x..$base_x + 7) {
my $bits;
for my $pixel_y ($base_y..$base_y + 7) {
my $pixel = $image->raw_pixel($pixel_y, $pixel_x);
my $pixel_value = $colors{_color_key($pixel)};
$bits .= $pixel_value & 0x01 ? "1" : "0";
}
$bytes .= pack("C", oct("0b$bits"));
}
for my $pixel_x ($base_x..$base_x + 7) {
my $bits;
for my $pixel_y ($base_y..$base_y + 7) {
my $pixel = $image->raw_pixel($pixel_y, $pixel_x);
my $pixel_value = $colors{_color_key($pixel)};
$bits .= $pixel_value & 0x02 ? "1" : "0";
}
$bytes .= pack("C", oct("0b$bits"));
}
}
}
return $bytes;
}
sub _get_palette_colors {
my ($image) = @_;
my %unique_values;
my $idx = 0;
for my $row (0..$image->height - 1) {
for my $col (0..$image->width - 1) {
my $pixel = $image->raw_pixel($row, $col);
$unique_values{_color_key($pixel)} = $idx++
unless defined $unique_values{_color_key($pixel)};
}
}
if ($idx > 4) {
die "Sprites can only use four colors";
}
return %unique_values;
}
sub _color_key {
my ($pixel) = @_;
return "$pixel->[0];$pixel->[1];$pixel->[2]";
}
1;
|
