#!/usr/bin/perl -w

if (! @ARGV) {
	die ("Usage: $0 <Filename.avi> [<Filename.ani> [...]]\n");
}

foreach $file (@ARGV) {
	if (! -f $file) {
		die "Animation file '$file' not found!\n";
	}
	if (not $file =~ /\.ani$/i) {
		print STDERR "$file is not an animation file, skipping.\n";
		continue;
	}

	# open files
	$filename = $file;
	$filename =~ s/\.ani$//i;
	open IN, $file or die "Failed to open '$file': $!";
	open OUT, ">$filename.bin" or die "Failed to open '$filename.bin': $!";

	$count = 0;
	$context = "command";
	@repeat = ();
	$prefix = "";
	while (<IN>) {
		s/[#;].*$//; # remove comments
		foreach (split()) {
			#print "$_\n";
			if (/^rotate$/i) {
				# rotate
				if ($context ne "command") {
					die "Rotate out of context (expected $context)";
				}
				$context = "rotate_n";
			} elsif (/^[0-9]+$/ and ($context eq "rotate_n")) {
				# rotate: number of LEDs
				if (($_ < 1) or ($_ > 15)) {
					die "Rotate: invalid number of steps ($_), must be 0~15.";
				}
				print $prefix, "Rotate $_\n";
				print OUT pack('C', 0x80 | $_); # Rotate n
				$context = "set";
			} elsif (/^set$/i) {
				# set
				if (($context ne "command") && ($context ne "set") &&
					($context ne "set_or_fade")) {
					die "Set out of context (expected $context)";
				}
				if ($context eq "set_or_fade") {
					set_leds($set_n, $set_addr, 1, @LEDS);
				}
				$context = "set_n";
			} elsif (/^[0-9]+$/ and ($context eq "set_n")) {
				# set: number of LEDs
				if ($_ > 16) {
					die "Set: invalid number of LEDs ($_), must be 0~16";
				}
				$set_n = $_;
				$count = $_;
				$set_addr = -1;
				@LEDS = ();
				if ($_ == 0) {
					$context = "fade";
				} elsif ($_ >= 16) {
					$context = "led_colour";
				} else {
					$context = "led_addr";
				}
			} elsif (/^addr$/) {
				# address
				if ($context ne "led_addr") {
					die "Addr out of context (expected $context)";
				}
				$context = "addr_n";
			} elsif (/^[0-9]+$/ and ($context eq "addr_n")) {
				# set: address of 1st LED
				if ($_ > 16) {
					die "Set: invalid address ($_), must be 0~15.";
				}
				if (($_ + $set_n) > 16) {
					die "Set: number of LEDs ($set_n) too high for address ($_)."
				}
				$set_addr = $_;
				$context = "led_colour";
			} elsif (/^[0-9a-f]{3}$/ and ($context eq "led_colour")) {
				# LED colour
				$napf = $_;
				push @LEDS, $napf;
				if (--$count == 0) {
					$context = ($set_n < 16) ? "set_or_fade" : "fade";
				}
			} elsif (/^fade$/) {
				# fade
				if (($context ne "fade") && ($context ne "set_or_fade")) {
					die "Fade out of context (expected $context)";
				}
				set_leds($set_n, $set_addr, 0, @LEDS);
				$context = "fade_n";
			} elsif (/^[0-9]+$/ and ($context eq "fade_n")) {
				# fade: number of steps
				if (($_ < 1) || ($_ > 255)) {
					die "Fade: invalid number of steps ($_), must be 1~255";
				}
				print $prefix, "Fade $_\n";
				print OUT pack('C', $_); # fade steps
				$context = "command";
			} elsif (/^repeat/) {
				# repeat
				if ($context ne "command") {
					die "Repeat out of context (expected $context)";
				}
				if (scalar(@repeat) == 4) {
					die "Repeat exceeds maximum nesting depth of 4";
				}
				$context = "repeat_n";
			} elsif (/^[0-9]+$/ and ($context eq "repeat_n")) {
				# repeat: number of times
				if (($_ < 3) || ($_ > 64)) {
					die "Repeat: invalid number of repetitions ($_), must be 3~64";
				}
				print $prefix, "Repeat $_\n";
				print OUT pack('C', 0xC0 | (64 - $_)); # repeat n
				$context = "command";
				push @repeat, "yes";
				$prefix = "  " x scalar(@repeat);
			} elsif (/^infinite$/ and ($context eq "repeat_n")) {
				# repeat: number of times
				print $prefix, "Repeat (infinite)\n";
				print OUT pack('C', 0xC0); # repeat 64
				$context = "command";
				push @repeat, "infinite";
				$prefix = "  " x scalar(@repeat);
			} elsif (/^end$/) {
				# repeat end
				if ($context ne "command") {
					die "End out of context (expected $context)";
				}
				if (scalar(@repeat) == 0) {
					die "End without repeat";
				}
				$rep = pop @repeat;
				$prefix = "  " x scalar(@repeat);
				if ($rep eq "infinite") {
					print $prefix, "Repeat end infinite\n";
					print OUT pack('C', 0xFF); # repeat end infinite
					$context = "end_of_file";
				} else {
					print $prefix, "Repeat end\n";
					print OUT pack('C', 0xFE); # repeat end
					$context = "command";
				}
			} elsif (/^delay$/) {
				# delay
				if ($context ne "command") {
					die "End out of context (expected $context)";
				}
				$context = "delay_n";
			} elsif (/^[0-9]+$/ and ($context eq "delay_n")) {
				# delay: time
				$time = $_;
				if ($_ % 10 != 0) {
					$time = int($_ / 10 + 0.5) * 10;
					print STDERR "Delay: $_ rounded to $time.\n";
				}
				if (($time < 10) || ($time > 325110)) {
					die "Delay: invalid time ($time), must be 10~325110 ms";
				}
				print $prefix, "Delay $time\n";
				$time /= 10;
				print OUT pack('CC', $time >> 8, $time & 0xFF); # delay
				$context = "command";
			} else {
				die "Unexpected token: '$_' (expected $context)";
			}
		
		}
	}
	
	if ($context ne "end_of_file") {
		if (scalar(@repeat) != 0) {
			die "Unexpected end of file: ", scalar(@repeat),
				" unfinished repeat loop(s)";
		}
		print "End of animation\n";
		print OUT pack('C', 0x7F); # end of animation
	}
	
	close IN;
	close OUT;
	
	print STDOUT "\n$file compiled successfully.\n\n";

}

sub set_leds {
	my ($n, $addr, $continued, @LEDS) = @_;
	print $prefix, "Set $set_n",
		(($n > 0) && ($n < 16)) ? " [+$set_addr]" : "",
		($n > 0) ? " (" . join(' ', @LEDS) . ")" : "",
		($continued) ? " continued\n" : "\n";
	if ($continued) {
		$continued = 0x40;
	} else {
		$continued = 0x00;
	}
	print OUT pack('C', 0xA0 | $n); # Set n
	return if ($n == 0);
	if ($n < 16) {
		print OUT pack('C', $continued | (16+$addr)); # Addr cont'd a
	} else {
		$addr = 0;
	}
	if ($addr & 1) {
		# 1st LED is odd
		my $led = hex(reverse shift @LEDS);
		print OUT pack('CC',
			($led << 4) & 0xF0,
			$led >> 4);
	}
	while (scalar(@LEDS) >= 2) {
		# groups of 2 LEDs each (even, odd)
		my $led1 = hex(reverse shift @LEDS);
		my $led2 = hex(reverse shift @LEDS);
		print OUT pack('CCC',
			$led1 & 0xFF,
			($led1 >> 8) | (($led2 << 4) & 0xF0),
			$led2 >> 4);
	}
	if (scalar(@LEDS) == 1) {
		# one additional LED (always even)
		my $led = hex(reverse shift @LEDS);
		print OUT pack('CC',
			$led & 0xFF,
			$led >> 8);
	}
}
