#!/usr/local/bin/perl -w
# $Id: hscdump.pl,v 1.2 2004/10/09 08:56:09 emikulic Exp $
#
# copyright (c) 2002 Emil Mikulic
#

use strict;
use Fcntl qw(:seek);

sub usage
{
	print <<USAGE;
Dump orderlist and patterns from HSC file
Copyright (c) 2002, Emil Mikulic.

usage: ./hscdump.pl <victim.hsc>
USAGE
	exit;
}

&usage unless scalar @ARGV == 1;
open INFILE, "<$ARGV[0]" or die "can't open $ARGV[0] for reading: $!";
binmode INFILE;

# skip instruments
seek INFILE, 128*12, SEEK_SET
	or die "Couldn't skip instruments: $!";

&dump_orderlist;
my ($pattern) = 0;
&dump_pattern while (filesize($ARGV[0])-tell(INFILE) >= 64*9*2);

close INFILE;



sub dump_orderlist
{
	read INFILE, my ($orderlist), 51
		or die "Couldn't read orderlist: $!";
	my @list = unpack "C51", $orderlist;
	print "[ orderlist ]\n";
	my ($i) = 0;
	ORDER: foreach (@list)
	{
		last ORDER if $_ == 0xFF;
		printf "[%02x] %02x\n", $i++, $_;
	}
	print "\n\n";
}



sub dump_pattern
{
	my ($row, $chan);

	printf "[ pattern %02x ]\n", $pattern;
	for ($row = 0; $row < 64; $row++)
	{
		printf "[%02x] |", $row;
		for ($chan = 0; $chan < 9; $chan++)
		{
			read INFILE, my ($event), 2
			or die "Couldn't read chan $chan, ".
				"row $row, pattern $pattern: $!";

			my ($note, $effect) = unpack "CC", $event;

			print format_note($note)." ".
				format_effect($effect)."|";
		}
		print "\n";
	}
	printf "[ end pattern %02x ]\n\n\n", $pattern++;
}



sub format_note
{
	my ($note) = @_;
	return "..." if $note == 0;	# empty
	return "===" if $note == 0x7F;	# key off
	return sprintf "I%02x", ($note&127) if $note & 128;	# instr

	$note--;
	my @pref = ("C-","C#","D-","D#","E-","F-","F#","G-","G#",
		"A-","A#","B-");
	return sprintf("%s%d", $pref[$note % 12], $note / 12);
}



sub format_effect
{
	my ($eff) = @_;
	return ".." if $eff == 0;
	return sprintf "%02x", $eff;
}



sub filesize
{
	my ($victim) = @_;
	my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
	    $atime,$mtime,$ctime,$blksize,$blocks) = stat($victim);
	return $size;
}