use warnings; use strict;    # Make sure we hear about problems
    my $sample_rate = 44100;     # CD Audio sample rate
    my $bits_sample =    16;     # CD Audio bit depth
    my $channels    =     2;     # Stereo = 2 channels
    my $outfile = 'testout.wav'; # file name to generate
    my $binaud = '';             # start with an empty sample string
    my $block_align = $channels * $bits_sample / 8; # how many bytes per block
    my $bytes_sec = $sample_rate * $block_align; # how many bytes per second
    my $fmt_length = 16;         # 16 bytes in format block
    my $encoding = 1;            # PCM encoding (uncompressed)
    # call the subroutine to add sine wave samples at specified frequency and duration
    &add_sine(261.626, 0.5 );                      # .5 second of middle C
    &add_sine(293.665, 0.5 );                      # .5 second of D
    &add_sine(329.628, 0.5 );                      # .5 second of E
    &add_sine(349.228, 0.5 );                      # .5 second of F
    &add_sine(391.995, 0.5 );                      # .5 second of G
    &add_sine(440.000, 0.5 );                      # .5 second of A
    &add_sine(493.883, 0.5 );                      # .5 second of B
    &add_sine(523.251, 0.5 );                      # .5 second of C
    &add_sine( 15    , 5.0 );                      #  5 seconds of 15Hz = 65 cycles
    &add_sine( 20    , 1.0 );                      #  1 second of 20Hz
    &add_sine( 30    , 1.0 );                      #  1 second of 30Hz
    &add_sine( 40    , 1.0 );                      #  1 second of 40Hz
    &add_sine( 50    , 1.0 );                      #  1 second of 50Hz
    &add_sine( 60    , 1.0 );                      #  1 second of 60Hz
    &add_sine( 70    , 1.0 );                      #  1 second of 70Hz
    &add_sine( 80    , 1.0 );                      #  1 second of 80Hz
    &add_sine( 90    , 1.0 );                      #  1 second of 90Hz
    &add_sine(100    , 1.0 );                      #  1 second of 100Hz

    &add_spiro(0.75,0.25,0.24,30,100);
	# "outer ring size", "inner ring size", "pen offset", "Speed", "Duration" 
    # create the WAV file according to the settings
    &write_file();


    # subroutines to do the work
    sub write_file {   	open FILE, ">", $outfile or die $!;
	binmode FILE;                            # tell perl not to worry about unicode
	my $binlength = length($binaud);         # size of the samples block
	print FILE "RIFF"                     ;  # 52 49 46 46 RIFF file header
	# pack() uses the local machine endian order for l(ong, 32) and s(hort,16) 
	print FILE pack("l",($binlength + 36));  # xx xx xx xx Remaining file size
	print FILE "WAVE"                     ;  # 57 41 56 45 Content Flag
	print FILE "fmt "                     ;  # 66 6D 74 20 begin Format chunk
	print FILE pack("l",$fmt_length)      ;  # 10 00 00 00    always 16 bytes
	print FILE pack("s",$encoding)        ;  # 01 00          1 = PCM
	print FILE pack("s",$channels)        ;  # 02 00          2 = Stereo
	print FILE pack("l",$sample_rate)     ;  # 44 AC 00 00    44100 (CD)
	print FILE pack("l",$bytes_sec)       ;  # 10 B1 02 00    44100 * 4 bytes
	print FILE pack("s",$block_align)     ;  # 04 00          4 bytes for two 16 bit samples
	print FILE pack("s",$bits_sample)     ;  # 10 00          16 bits/sample
	print FILE "data"                     ;  # 64 61 74 61 begin Data chunk
	print FILE pack("l",$binlength)       ;  # xx xx xx xx    length of sample data
	print FILE $binaud                    ;  # xx xx xx xx    sample data...
	close FILE;
       }

    sub add_sine {
        my $hz = shift;
        my $length = shift;
        my $pi = ( 22 / 7 ) * 2;
        $length *= $sample_rate;
        my $max_no =  (( 2 ** $bits_sample ) / 2) - 1;
	my $time = 0;
        for my $pos ( 0 .. $length ) {
            $time = $pos / $sample_rate;
            $time *= $hz;
            my $valx = sin $pi * $time;
            my $sampx = $valx * $max_no;
	    my $valy = cos $pi * $time;
            my $sampy = $valy * $max_no;
            $binaud .= pack("s2",$sampx,$sampy);
        }
    }
    
    sub add_spiro { # "outer ring size", "inner ring size", "pen offset", "Speed", "Duration" 
        my $outerR = shift; # primary gear
	my $innerR = shift; # secondary or roller gear
        my $rmax =  ((( 2 ** $bits_sample ) / 2) - 1);
	my $r1 = $outerR * $rmax; # keep outerR between 0 and +- 1
	my $r2 = $innerR * $rmax; # keep innerR between 0 and +-(1-outerR)
	my $penhole = shift;      # keep penhole less than innerR for best results,
	my $rp = $penhole * $rmax;# penhole + outerR <= 1 to avoid clipping
	my $hz = shift;
        my $length = shift;
        my $pi = ( 22 / 7 ) * 2;
        $length *= $sample_rate;

	my $time = 0;
        for my $pos ( 0 .. $length ) {
            $time = $pos / $sample_rate * $hz;
            my $sampx =  $r1 * sin ($pi * $time) + $rp * sin($pi * $time * ($r1/$r2));
            my $sampy =  $r1 * cos ($pi * $time) + $rp * cos($pi * $time * ($r1/$r2));
            $binaud .= pack("s2",$sampx,$sampy);
        }
    }