#!/usr/bin/perl
# Convert a SAP TYPE R to Csound data
# -Don Mahurin, 2006-12
#
# Usage: sapr2csound < in.sap > out.csd
#

my $debug = 0;
my $note_volume_scale = 1;
;my $fps = 60;
my $fps = 50;


######

my($clock_burst) = 3579545.0;


my $line = <STDIN>;
$line =~ s:\r$::g;
chomp($line);

unless($line eq "SAP")
{
	print STDERR "Not SAP file\n";
	exit 1;
}

my @sap_param_names = ( "SAP" );
my %sap_params;

while($line = <STDIN>)
{
	if($line =~ /\xff/)
	{
		print STDERR "SAP Header not terminated\n";
		exit 1;
	}
	$line =~ s:\r$::g;
	chomp($line);
	last if($line eq '');
	if($line =~ /^([A-Z]+)(\s+(.*))$/)
	{
		my($name) = $1;
		my($value) = '';
		$value = $3 if(defined($2));
		push(@sap_param_names, $name);
		$sap_params{$name} = $value;
	}
}

if($sap_params{TYPE} != "R")
{
	print STDERR "Not SAP Type R\n";
	exit 1;
}

my $stereo = defined($sap_params{"STEREO"});
my $fastplay = $sap_params{"FASTPLAY"};
$fastplay = 312 unless(defined($fastplay));
my $bpm = $sap_params{"BPM"};
unless(defined($bpm))
{
$bpm = (60 * 50 * 312 / $fastplay);
}

my $data_size = 9 * ($stereo + 1);

my $common;
my $last;
my $count = 0;
my @all_data = ();
my $common;

my @last_audf = ( 0,0,0,0,0,0,0,0 );
my @last_audc = ( 0,0,0,0,0,0,0,0 );
my @last_audctl = ( 0, 0 );
my @last_clock_count = ( 0,0,0,0,0,0,0,0 );

my $clock_count = 0;

my %score;
my %inst_score;

my(@prev_channel_dist);

my(@need_dist15);
my(@need_dist31);

sub add_music_score
{
	my($channel, $audf, $audc, $audctl, $start_clock, $clocks) = @_;

	my($prev_dist) = $prev_channel_dist[$channel];

	## we could use seconds as time unit
	#my($start_time) = 1.0 * $start_clock * 60 / $bpm;
	#my($play_time) = 1.0 * $clocks * 60 / $bpm;
	my($start_time) = $start_clock;
	my($play_time) = $clocks;

# 
# xxx1 volume only
# xx11 quiet ?
# 0000 div by freq, select by 5, 17, div by 2
# 0x10 div by freq, select by 5, div by 2
# 0100 div by freq, select by 5, 4, div by 2
# 1000 div by freq, select by 17, div by 2
# 1x10 div by freq, div by 2
# 1100 div by freq, select by 4, div by 2
#

	my($volume) = $audc & 0x0F;
	my($dist) = ($audc & 0xF0) >> 4;
	$dist = 1 if($dist & 0x1); # volume only - ***1
	$dist = 0x2 if(($dist & 0xa) == 0x2); # pply5 - 0*10, 0x2
	$dist = 0xa if(($dist & 0xa) == 0xa); # pure tone - 1*10, 0xa
	# TODO: need some explanation of which dist audf=0,1 means silence
	# example of audf=1 silence: William_Tell.sap 
	# example of audf=2 silence: Loco.sap
	#unless($volume and ( $audf >4 || $dist ==8 || ($dist != 0xa && $dist != 1)))
	unless($volume and ( $audf >1 || $dist ==8))
	{
		$prev_channel_dist[$channel] = undef;
		return;
	}
	$dist = 8 if($dist == 0);  # poly5, poly17

	$prev_channel_dist[$channel] = $dist;

	my(%support_dist) = ( 0xa => 1, # pure
			 0xc => 1, # poly4
			 0x2 => 1, # poly5
			 0x0=> 1, # poly5, poly17
			 0x8=> 1 # poly17
	);
	if(!defined($support_dist{$dist})) { print STDERR "unsupported dist: $dist\n"; }

	my($clock_div) = 64;
	my($clock_cpu) = $clock_burst / 2;
	my($clock_64k) = $clock_burst / 56;
	my($clock_15k) = $clock_burst / 228;
	my($M) = 1;

	my(@M_for_channel) = ( 1, 1, 1, 1);
	my(@D_for_channel) = ( 56, 56, 56, 56);

# audctl
# 7 makes the 17-bit poly counter into a 9-bit poly counter.
# 6 clocks channel 1 with 1.79 MHz, instead of 64 kHz
# 5 clocks channel 3 with 1.79 MHz, instead of 64 kHz
# 4 clock channel 2 with channel 1, instead of 64 kHz (16-bit)
# 3 clock channel 4 with channel 3, instead of 64 kHz (16-bit)
# 2 inserts high-pass filter into channel 1, clocked by chan 3 (see section 2)
# 1 inserts high-pass filter into channel 2, clocked by chan 4
# 0 change normal clock base from 64 kHz to 15 kHz

	# need to check for base clock change first.
	if($audctl & 0x1) # 15K base clock
	{
		@D_for_channel = ( 228, 228, 228, 228);
		print STDERR "15k base clock\n" if($debug);
	}

	if($audctl & 0x80) # 7 makes the 17-bit poly counter into a 9-bit poly counter.
	{
		print STDERR "note: 9 bit high rand distinction from 17bit not yeet supported\n" if($debug);
	}
# for 1.79 clock
#    M = 4 if 8 bit counter (AUDCTL bit 3 or 4 = 0),
#    M = 7 if 16 bit counter (AUDCTL bit 3 or 4 = 1)
	if($audctl & 0x40) # 6 clocks channel 1 with 1.79 MHz, instead of 64 kHz
	{
		print STDERR "ch1 is 1.79mhz\n" if($debug);
		$D_for_channel[0] = 2;
		$M_for_channel[0] = 4;
	}
	if($audctl & 0x20) # 5 clocks channel 3 with 1.79 MHz, instead of 64 kHz
	{
		print STDERR "ch3 is 1.79mhz\n" if($debug);
		$D_for_channel[2] = 2;
		$M_for_channel[2] = 4;
	}
	if($audctl & 0x10) # 4 clock channel 2 with channel 1, instead of 64 kHz (16-bit)
	{
		print STDERR "join ch1/ch2 ($channel)\n" if($debug);
		$D_for_channel[1] = $D_for_channel[0];
		$M_for_channel[1] = 7 if($D_for_channel[1] == 2);
	}
	if($audctl & 0x8) # 3 clock channel 4 with channel 3, instead of 64 kHz (16-bit)
	{
		print STDERR "join ch3/ch4 ($channel)\n" if($debug);
		$D_for_channel[3] = $D_for_channel[2];
		$M_for_channel[3] = 7 if($D_for_channel[3] == 2);
	}
	if($audctl & 0x4) # 2  inserts high-pass filter into channel 1, clocked by chan 3 (see section 2)
	{
		print STDERR "not implemented high pass filter in channel 1\n"  if($debug);
	}
	if($audctl & 0x2) # 1 inserts high-pass filter into channel 2, clocked by chan 4
	{
		print STDERR "not implemented high pass filter in channel 2\n" if($debug);
	}
	# for ($audctl & 0x1), se above

	my($F);
	my($distdiv) = 1;
	my($distsize,$distnum) = (0,0);
	if($dist == 0xc)
	{
		($distsize, $distnum) = poly_pattern(4,$D_for_channel[$channel], $audf, $M_for_channel[$channel]);
		$need_dist15[$channel] = 1;
	}
	elsif($dist == 0x2)
	{
		($distsize, $distnum) = poly_pattern(5,$D_for_channel[$channel], $audf, $M_for_channel[$channel]);
		$need_dist31[$channel] = 1;
	}
	$F = $clock_burst/$D_for_channel[$channel]/(2*($audf+$M_for_channel[$channel]));

#	print STDERR "(ch=$channel, af=$audf,F=$F, ac=$audc(d=$dist,v=$volume, al=$audctl, c=$start_clock, cc=$clocks, s=$start_time, p=$play_time)\n";

	print STDERR "Freq $F \n" if($debug);
	my $note = [$channel + 1, $start_time, $play_time, $F, $volume , $dist, $distsize, $distnum, defined($prev_dist) && $dist == $prev_dist ? 0 : 1];
	push(@{$score{$start_clock}}, $note);
	push(@{$inst_score{$channel}}, $note);
}

sub add_music_data
{
	my(@data) = @_;
	my(@audf);
	my(@audc);
	my(@audctl);
	$offset = 0;

	while(@data)
	{
		for($i = 0; $i < 4; $i++)
		{
			push(@audf, shift(@data));
			push(@audc, shift(@data));
		}
		my $audctlv = shift(@data);
		push(@audctl, $audctlv);

		# we need to just check for joining here.
		# other audctl/audc processing happens when adding score
		if($audctlv & 0x10) # join 1 and 2
		{
			print STDERR "join 1 and 2\n" if($debug);
			$audf[@audf - 3] = ($audf[@audf - 3] << 8) + $audf[@audf - 4];
			# TODO: is joined-from channel valid for playing?
			# some tunes have invalid data there: Loco.sap
			$audc[@audf - 4] = 0;
		}
		if($audctlv & 0x8) # join 3 and 4
		{
			print STDERR "join 3 and 4\n" if($debug);
			$audf[@audf - 1] = ($audf[@audf - 1] << 8) + $audf[@audf - 2];
			# TODO: is joined-from channel valid for playing?
			# some tunes have invalid data there: Loco.sap
			$audc[@audf - 2] = 0;
		}
	}

	for($i = 0; $i < @audc; $i++)
	{
		if(
			$last_audf[$i] != $audf[$i] ||
			$last_audc[$i] != $audc[$i] ||
			$last_audctl[$i>=4] != $audctl[$i>=4])
		{
			add_music_score($i, $last_audf[$i], $last_audc[$i], $last_audctl[$i>=4], $last_clock_count[$i], $clock_count - $last_clock_count[$i]);
			$last_clock_count[$i] = $clock_count;
		}
		$last_audf[$i] = $audf[$i];
		$last_audc[$i] = $audc[$i];
		$last_audctl[$i>=4] = $audctl[$i>=4];
	}
	$clock_count++;
}

while(read(STDIN, $data, $data_size))
{
	my @aud = unpack("C*", $data);
	add_music_data(@aud);
}

# add one more set of zeros to end any open notes.
my(@end);
for($i = 0; $i < $data_size; $i++) { push(@end, 0); }
add_music_data(@end);

my $note_volume_csound_scale = 1000 / $note_volume_scale;

my $dist15csoundcode = 
'if (idistsize == 15) then
asound0 oscilikt kdeclickamp/2, kdeclickfreq/7.5, gipokeydist15ft, 0, iskipinit
asound1 oscilikt kdeclickamp/2, kdeclickfreq/7.5, gipokeydist15ft, 1/15, iskipinit
asound2 oscilikt kdeclickamp/2, kdeclickfreq/7.5, gipokeydist15ft, 2/15, iskipinit
asound3 oscilikt kdeclickamp/2, kdeclickfreq/7.5, gipokeydist15ft, 3/15, iskipinit
asound4 oscilikt kdeclickamp/2, kdeclickfreq/7.5, gipokeydist15ft, 4/15, iskipinit
asound5 oscilikt kdeclickamp/2, kdeclickfreq/7.5, gipokeydist15ft, 5/15, iskipinit
asound6 oscilikt kdeclickamp/2, kdeclickfreq/7.5, gipokeydist15ft, 6/15, iskipinit
asound7 oscilikt kdeclickamp/2, kdeclickfreq/7.5, gipokeydist15ft, 7/15, iskipinit
asound8 oscilikt kdeclickamp/2, kdeclickfreq/7.5, gipokeydist15ft, 7/15, iskipinit
asound9 oscilikt kdeclickamp/2, kdeclickfreq/7.5, gipokeydist15ft, 9/15, iskipinit
asound10 oscilikt kdeclickamp/2, kdeclickfreq/7.5, gipokeydist15ft, 10/15, iskipinit
asound11 oscilikt kdeclickamp/2, kdeclickfreq/7.5, gipokeydist15ft, 11/15, iskipinit
asound12 oscilikt kdeclickamp/2, kdeclickfreq/7.5, gipokeydist15ft, 12/15, iskipinit
asound13 oscilikt kdeclickamp/2, kdeclickfreq/7.5, gipokeydist15ft, 13/15, iskipinit
asound14 oscilikt kdeclickamp/2, kdeclickfreq/7.5, gipokeydist15ft, 14/15, iskipinit
asound	sum	\
			asound0 * ((idistnum)&1),\
			asound1 * ((idistnum>>1)&1),\
			asound2 * ((idistnum>>2)&1),\
			asound3 * ((idistnum>>3)&1),\
			asound4 * ((idistnum>>4)&1),\
			asound5 * ((idistnum>>5)&1),\
			asound6 * ((idistnum>>6)&1),\
			asound7 * ((idistnum>>7)&1),\
			asound8 * ((idistnum>>8)&1),\
			asound9 * ((idistnum>>9)&1),\
			asound10 * ((idistnum>>10)&1),\
			asound11 * ((idistnum>>11)&1),\
			asound12 * ((idistnum>>12)&1),\
			asound13 * ((idistnum>>13)&1),\
			asound14 * ((idistnum>>14)&1)
else';

my $dist31csoundcode = 
'if (idistsize == 31) then
asound0 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 0, iskipinit
asound1 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 1/31, iskipinit
asound2 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 2/31, iskipinit
asound3 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 3/31, iskipinit
asound4 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 4/31, iskipinit
asound5 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 5/31, iskipinit
asound6 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 6/31, iskipinit
asound7 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 7/31, iskipinit
asound8 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 8/31, iskipinit
asound9 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 9/31, iskipinit
asound10 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 10/31, iskipinit
asound11 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 11/31, iskipinit
asound12 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 12/31, iskipinit
asound13 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 13/31, iskipinit
asound14 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 14/31, iskipinit
asound15 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 15/31, iskipinit
asound16 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 16/31, iskipinit
asound17 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 17/31, iskipinit
asound18 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 18/31, iskipinit
asound19 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 19/31, iskipinit
asound20 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 20/31, iskipinit
asound21 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 21/31, iskipinit
asound22 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 22/31, iskipinit
asound23 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 23/31, iskipinit
asound24 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 24/31, iskipinit
asound25 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 25/31, iskipinit
asound26 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 26/31, iskipinit
asound27 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 27/31, iskipinit
asound28 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 28/31, iskipinit
asound29 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 29/31, iskipinit
asound30 oscilikt kdeclickamp/2, kdeclickfreq/15.5, gipokeydist31ft, 30/31, iskipinit
asound	sum	\
			asound0 * ((idistnum)&1),\
			asound1 * ((idistnum>>1)&1),\
			asound2 * ((idistnum>>2)&1),\
			asound3 * ((idistnum>>3)&1),\
			asound4 * ((idistnum>>4)&1),\
			asound5 * ((idistnum>>5)&1),\
			asound6 * ((idistnum>>6)&1),\
			asound7 * ((idistnum>>7)&1),\
			asound8 * ((idistnum>>8)&1),\
			asound9 * ((idistnum>>9)&1),\
			asound10 * ((idistnum>>10)&1),\
			asound11 * ((idistnum>>11)&1),\
			asound12 * ((idistnum>>12)&1),\
			asound13 * ((idistnum>>13)&1),\
			asound14 * ((idistnum>>14)&1),\
			asound15 * ((idistnum>>15)&1),\
			asound16 * ((idistnum>>16)&1),\
			asound17 * ((idistnum>>17)&1),\
			asound18 * ((idistnum>>18)&1),\
			asound19 * ((idistnum>>19)&1),\
			asound20 * ((idistnum>>20)&1),\
			asound21 * ((idistnum>>21)&1),\
			asound22 * ((idistnum>>22)&1),\
			asound23 * ((idistnum>>23)&1),\
			asound24 * ((idistnum>>24)&1),\
			asound25 * ((idistnum>>25)&1),\
			asound26 * ((idistnum>>26)&1),\
			asound27 * ((idistnum>>27)&1),\
			asound28 * ((idistnum>>28)&1),\
			asound29 * ((idistnum>>29)&1),\
			asound30 * ((idistnum>>30)&1)
else';

my $distcsoundcode = $dist15csoundcode . $dist31csoundcode;

unless($score_only)
{
print "<CsoundSynthesizer>\n<CsInstruments>\n";
print "sr= 44100 
kr= 882
ksmps= 50 
nchnls= 1 

giphasor ftgen 0, 0,  8192, 7, 0, 8192, 1

gimsrtub ftgen 0, 0,  8193, 7, -.8, 934, -.79, 934, -.77, 934, -.64, 1034, -.48, 520, .47, 2300, .48, 1536, .48

gimsrsin ftgen 0, 0, 8193, 10, 1
;gimsrsin ftgen 0, 0, 1024, 10, 1

gimsrsqr	ftgen 0, 0, 8193, 7, 1,  4096, 1, 0, -1, 4096, -1

gimsrdon1 ftgen 0, 0, 256, 5, 1, 8, 150, 2, 170, 2, 180, 4, 190, 8, 200, 16, 200, 8, 190, 4, 180, 2, 170, 4, 150, 72, 1, 0, -1, 8, -150, 2, -180, 4, -190, 8, -200, 16, -200, 8, -190, 4, -180, 2, -170, 4, -150, 72, -1

gimsrdon2 ftgen 0, 0, 64, 5, 1, 2, 120, 60, 1, 1, 0.001, 1

gimsrdonrsquare ftgen 0, 0, 1024, 10, 1.5, 0, .333333, 0, .2, 0,.142857, 0, .111111, 0,  .090909, 0, .076923, 0.066667, ; Rounded Square
gimsrdonsquare ftgen 0, 0, 1024, 10, 1, 0, .333333, 0,.2, 0, .142857,  0,  .111111, 0,  .090909, 0,     .076923 ; Square
gimsrdon4 ftgen 0, 0, 2048, 7, 0, 12, 1, 1000, 1, 24, -1, 1000, -1, 12, 0
gimsrdon5 ftgen 0,  0, 1024, 10, 1, .7, .7, .7, .7, .7, .7, .7, .7, .7,  .4, .4, .4, .4, .3, .3, .3, .3, .2, .2, .2, .2

;gisquarepulse116  ftgen 0, 0, 1024, 7, 0, 0, 1,64,1, 0, 0,960,0
;gisquarepulse116  ftgen 0, 0, 1024, 7, 0, 1, 1,62,1, 1, 0,960,0
gisquarepulse116  ftgen 0, 0, 1024, 7, 0, 1, 0.8, 1, 1,60,1, 1, 0.8, 1, 0,960,0
gisquarepulse132  ftgen 0, 0, 2048, 7, 0, 1, 0.8, 1, 1,60,1, 1, 0.8, 1, 0,1984,0

;gipokeyft = gimsrdon1
gipokeyft = gimsrtub
gipokeydist15ft = gisquarepulse116
gipokeydist31ft = gisquarepulse132

opcode declick0, a, a

ain     xin
;aenv    linseg 0, 0.02, 1, p3 - 0.02, 1
aenv    linseg 1, p3 - 0.001, 1, 0.001, 1.5
xout ain * aenv
endop

opcode mydeclick, a, iiiiii
ip4,ip5,ip6,ip7,ip8,ip9  xin;
istartamp = (ip6 != 0) ? 0 : (ip8+ip5)/2/ip5
iendamp = (ip7 != 0) ? 0 : (ip9+p5)/2/ip5
adeclick linseg istartamp, .005, 1, p3-.010, 1, .005, iendamp
xout adeclick
endop

opcode smoothamp, k, iiii
idur,iprevamp,iamp,iendamp xin
kdeclick linseg iprevamp, idur/2, iamp, idur/2, iendamp
xout kdeclick
endop

opcode declickamp, k, iiii
idur,iprevamp,iamp,iendamp xin
kdeclick linseg iprevamp, .005, iamp, p3-.010, iamp, 0.005, iendamp
xout kdeclick
endop

opcode declickfreq, k, iii
idur,iprevfreq,ifreq xin
kdeclick linseg iprevfreq, .005, ifreq, p3-.005, ifreq
xout kdeclick
endop

opcode scorefreq, i, i
ifnum xin
xout ifnum
endop

opcode scoreamp, i, i
ianum xin
;xout ianum
xout ianum*$note_volume_csound_scale
endop

instr 10
idur = abs(p3)
ifreq scorefreq p4
iamp scoreamp p5
idist = p6
idistsize = p7
idistnum = p8
iskipinit = 1
tigoto skipinit
iskipinit = 0
iprevfreq = ifreq
iprevamp = 0
skipinit:
iendamp = (p3 > 0) ? 0 : iamp
kdeclickamp declickamp idur,iprevamp,iamp,iendamp
kdeclickfreq declickfreq idur,iprevfreq,ifreq
if (idist == 8) then
asound randh iamp, ifreq
elseif (idist == 1) then
;asound smoothamp idur,iprevamp,iamp,iendamp
asound linseg iamp,idur,iamp
else$distcsoundcode
asound oscilikt kdeclickamp, kdeclickfreq, gipokeyft, 0, 1
endif
out asound
iprevfreq = ifreq
iprevamp = iamp
endin

instr 1
asound subinstr 10, p4,p5,p6,p7,p8
out asound
endin

instr 2
asound subinstr 10, p4,p5,p6,p7,p8
out asound
endin

instr 3
asound subinstr 10, p4,p5,p6,p7,p8
out asound
endin

instr 4
asound subinstr 10, p4,p5,p6,p7,p8
out asound
endin\n\n";

print "</CsInstruments>\n<CsScore>\n";
}

# beats per minute
print "t 0 $bpm\n";

# get next note_break
foreach my $i ( keys %inst_score )
{
	my $nb = 1;
	foreach my $note (reverse @{$inst_score{$i}})
	{
		push(@{$note}, $nb);
		$nb = $note->[@{$note}-2];
	}
}

foreach my $i ( reverse sort { $b <=> $a } (keys %score))
{
	foreach my $note (@{$score{$i}})
	{
		my($inst, $start, $length, $f, $v, $dist, $distsize, $distnum, $note_break, $next_note_break) = @$note;
		$inst = 1 unless(defined($inst));
		my($V) = $note_volume_scale * $v;
		printf "i$inst $start %s$length $f $V $dist $distsize $distnum\n", $next_note_break ? "": "-";
	}
}
print "e\n";
print "\n</CsScore></CsoundSynthesizer>\n" unless($score_only);

# given a poly bit size, audf divider, audf, and audf M;
# find poly pattern by looping polysize iterations
# shift poly pattern to elimiate left zero bits.
# convert pattern bits to 32 bit integer number.
# return pattern size and pattern number.
sub poly_pattern
{
	my($sizebits, $cdiv, $audf, $M) = @_;
	$M = 1 unless(defined($M));
	my($polysize) = (1 << $sizebits) - 1;
	my @poly = mz_poly_init($sizebits);
	#my @poly = hard_poly_init($sizebits);
	#my @poly = mame_poly_init($sizebits);
	my(@pattern);
	my($c) = 0;
	my($pfirst);
	for(my $i = 0; $i < $polysize; $i++)
	{
		my $p = $c % $polysize;
		if(!defined($pfirst))
		{
			$pfirst = $p;
		}
		push(@pattern, $poly[$p]);
		$c+= (($audf+$M) * $cdiv);
	}
	my($pattern_num) = unpack("N", pack("B32", join('', @pattern)));
	$pattern_num >>= 32 - @pattern;
	while($pattern_num != 0 && ! ( $pattern_num & 0x1))
	{
		$pattern_num >>= 1;
	}
	return ($polysize,$pattern_num);
}

# TODO: find the "correct" and simplest algorithm for polys. All seem to give different
#       results

sub hard_poly_init
{
	my($size) = @_;
	if($size == 4)
	{
		#return (1, 1, 0, 1, 1, 1, 0, 0, 0, 0, 1, 0, 1, 0, 0);

		#backwards pokey23
		#return (0, 0, 1, 0, 1, 0, 0, 0, 0, 1, 1, 1, 0, 1, 1);

		#backwards pokey23 <<2
		# also captured(with atari800.sf.net) with audf+1==43
		return (1,1, 0, 0, 1, 0, 1, 0, 0, 0, 0, 1, 1, 1, 0 );
		#return (0, 0, 1, 0, 0, 0, 1, 1, 1, 1, 0, 1, 0, 1, 1);
	}
	elsif($size == 5)
	{
		return (0, 0, 1, 1, 0, 0, 0, 1, 1, 1, 1, 0, 0, 1, 0, 1, 0, 1, 1, 0, 1, 1, 1, 0, 1, 0, 0, 0, 0, 0, 1);
	}
	return undef;
}

# from mame poly generation
sub mame_poly_init
{
	my ($size) = @_;

	my %mame_poly_args = (
		4 => [ 3, 1, 0x00004],
		5 => [ 3, 2, 0x00008],
		9 => [ 8, 1, 0x00180],
		17 => [ 16, 1, 0x1c000]);
	my($left, $right, $add) = @{$mame_poly_args{$size}};

	my $mask  = (1 << $size) - 1;
	my $i = 0;
	my $x = 0;
	my @out;

	for( $i = 0; $i < $mask; $i++ )
	{
		push(@out, $x & 0x1);
		$x = (($x << $left) + ($x >> $right) + $add) & $mask;
	}
	return(@out);
}

# from atari800.sf.net "mz" poly calulation
sub mz_poly_init
{
	my($size) = @_;

	my %mz_poly_args = (
		4 => [ 2, 3],
		5 => [ 2, 4]);

	my($a, $b) = @{$mz_poly_args{$size}};

	my $mask  = (1 << $size) - 1;
	my $c;
	my $i;
	my $poly = 1;
	my @out;

	for($i=0; $i<$mask; $i++)
	{
		push(@out, (~$poly) & 0x1);
		$c = (($poly>>$a)&1) ^ (($poly>>$b)&1);
		$poly = (($poly<<1)&$mask) + $c;
	}
	return(@out);
}