X-Git-Url: http://git.shiar.nl/wormy.git/blobdiff_plain/580332877fa744e0653d74d92dc29346b9245093..6d64bb2aa29809c9c24fb5ee036766440b62bf4a:/lib/Games/Wormy/WormEdit.pm?ds=sidebyside

diff --git a/lib/Games/Wormy/WormEdit.pm b/lib/Games/Wormy/WormEdit.pm
new file mode 100644
index 0000000..3a729ed
--- /dev/null
+++ b/lib/Games/Wormy/WormEdit.pm
@@ -0,0 +1,170 @@
+package Games::Wormy::WormEdit;
+
+use 5.010;
+use strict;
+use warnings;
+
+use Parse::Binary::Nested qw(unpackf);
+
+our $VERSION = '1.00';
+
+our %MAGICID = (
+	"WormEdit053\000LVL" => 53,
+	"WormEdit\34195\000LVL" => 95,
+	"WormEdit\34194\000LVL" => 94,
+	"WormEdit\34193\000LVL" => 93,
+);
+
+sub read {
+	my ($self, $input, $override) = @_;
+	my ($id, $version) = (substr($input, 0, 15), ord substr($input, 15, 1));
+	my $fileversion = $MAGICID{$id}
+		or die "File does not match any known WormEdit level header\n";
+
+	if ($override) {
+		warn "Override version $version to $override\n";
+		$version = $override;
+	}
+	elsif ($version != $fileversion) {
+		warn "Unexpected version $version (expecting $fileversion)\n";
+	}
+	elsif ($version == 95) {
+		# auto-detect exact variant
+		if (ord substr($input, 70, 1) ~~ [1 .. 8]) {
+			# valid sprite length instead of description byte
+			# (which is usually a letter or nul)
+			$version = 94;
+		}
+		elsif (ord substr($input, 147, 1) == 0) {
+			# nul of finish type is 2 bytes later (unlike first char of message)
+			$version = 96;
+		}
+		warn "Ambiguous file version 95; guessing subversion $version\n";
+	};
+
+	$fileversion += 100 if $fileversion < 90;  # 93..95 came before 50..53
+
+	my @FORMAT = (
+		magic       => 'a15',
+		version     => 'C',
+		name        => 'C/a32',
+		description => 'C/a64x256',
+		levelcount  => [1,
+			single => 'C',
+			multi  => 'C',
+			race   => 'C',
+			ctf    => 'C',
+			total  => 'C',
+		],
+		moderef     => [1,
+			map { (start => $_, end => $_) } [1,
+				single     => 'C',
+				peaworm    => 'C',
+				tron       => 'C',
+				deathmatch => 'C',
+				foodmatch  => 'C',
+				multifood  => 'C',
+				timematch  => 'C',
+				race       => 'C',
+				ctf        => 'C',
+				reserved   => 'x',
+			],
+		],
+		sprite     => ['8C',
+			line => 'B8',
+		],
+		finish      => [1,
+			type    => 's',
+			message => 'C/a255',
+			code    => 'C/a255',
+			reserved=> 'x256',
+		],
+		hiname      => 'a3',
+		levels      => ['*', # levelcount->total actually
+			id         => 'C/a22',
+			name       => 'C/a22',
+			size       => 'C',
+			peas       => 'C',
+			delay      => 'C',
+			growth     => 'C',
+			bsize      => 'C',
+			sprite     => ['8C',
+				line => 'B8',
+			],
+			balls      => ['32C',
+				y   => 'C',
+				x   => 'C',
+				dir => 'C',
+			],
+			worms      => [4,
+				d => 'C',
+				y => 'C',
+				x => 'C',
+			],
+			width      => 'C',
+			height     => 'C',
+			flags      => [2,
+				y => 'C',
+				x => 'C',
+			],
+			objects    => ['128C',
+				type => 'C',
+				x1   => 'C',
+				y1   => 'C',
+				x2   => 'C',
+				y2   => 'C',
+			],
+		],
+	);
+
+	given ($fileversion) {
+		when (153) { } # current @FORMAT
+			$FORMAT[7] = 'C/a64'; # no reserved space after description
+			splice @{ $FORMAT[15] }, -2; # finish reserve
+			$FORMAT[-1]->[-1]->[0] = '32C'; # less objects
+			ref $_ and pop @$_ for @{ $FORMAT[11] }; # 9 moderefs
+		when ($version == 96) { }
+			ref $_ and pop @$_ for @{ $FORMAT[11] }; # only 8 moderefs (no ctf)
+			splice @FORMAT, 6, 2 if $version <= 94;  # earlier version without description
+		when (95) { }
+			splice @{ $FORMAT[7] }, 4, 2;  # no race
+			splice @{ $FORMAT[13] }, 4, 2; # no enddata
+			splice @{ $FORMAT[-1] }, 1, 2; # no name
+		when (94) { }
+			splice @FORMAT, 14, 2; # no hiname
+			$FORMAT[-1]->[0] = 64; # constant amount of levels
+		when (93) { }
+		default {
+			die "Cannot parse data for Wormedit $fileversion/$version\n";
+		}
+	}
+
+	# convert to an easily accessible hash
+	push @FORMAT, -trail => 'a*';
+	my $data = unpackf(\@FORMAT, $input);
+	warn "Trailing data left unparsed\n" if length delete $data->{-trail};
+	$data->{format} = 'WormEdit';
+	return $data;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Games::Wormy::WormEdit - Read Wormy levelset from a wormedit file
+
+=head1 SYNOPSIS
+
+	my $levelset = Games::Wormy::WormEdit->read($filecontents);
+	print $levelset->{name};
+
+=head1 AUTHOR
+
+Mischa POSLAWSKY <perl@shiar.org>
+
+=head1 LICENSE
+
+LGPL version 3.
+