git @ Cat's Eye Technologies Dipple / master perl / mktone.pl
master

Tree @master (Download .tar.gz)

mktone.pl @masterraw · history · blame

#!/usr/bin/env perl

# SPDX-FileCopyrightText: Chris Pressey, the original author of this work, has dedicated it to the public domain.
# For more information, please refer to <https://unlicense.org/>
# SPDX-License-Identifier: Unlicense

# usage: mktone.pl | aplay

### GLOBALS ###

$samples_per_sec = 8000;
$pi = 3.14159;

### SUBS ###

sub setup_tables()
{
	my $i;

	$s[0]  = 1.0;
	$s[1]  = 135 / 128;
	$s[2]  = 9 / 8;
	$s[3]  = 6 / 5;
	$s[4]  = 5 / 4;
	$s[5]  = 4 / 3;
	$s[6]  = 45 / 32;
	$s[7]  = 3 / 2;
	$s[8]  = 8 / 5;
	$s[9]  = 27 / 16;
	$s[10] = 9 / 5;
	$s[11] = 15 / 8;

	for ($i = 12; $i <= 96; $i++)
	{
		$s[$i] = $s[$i - 12] * 2;
	}

	$major[0] = 0;
	$major[1] = 2;
	$major[2] = 4;
	$major[3] = 5;
	$major[4] = 7;
	$major[5] = 9;
	$major[6] = 11;

	for ($i = 7; $i <= 64; $i++)
	{
		$major[$i] = $major[$i - 7] + 12;
	}
}

sub play_sound($$$$$$)
{
	my $b_freq = shift;
	my $e_freq = shift;
	my $b_amp = shift;
	my $e_amp = shift;
	my $dur = shift;
	my $func = shift;
	my $sampno, $wavelength;
	my $freq, $amp;
	my $sample;

	$func = sub
	{
		my $sampno = shift;
		my $wavelength = shift;
		return sin($sampno / ($wavelength * $pi)) * 128 + 128;
	} if $func eq 'sine';

	$func = sub
	{
		my $sampno = shift;
		my $wavelength = shift;
		# print STDERR "i $sampno wl $wavelength\n";
		# real modulo.
		my $modulo = $sampno - (int($sampno / $wavelength) * $wavelength);
		return 255 if ($modulo < ($wavelength / 2));
		return 0;
	} if $func eq 'square';

	for ($sampno = 0; $sampno < $dur; $sampno++)
	{
		$freq = ($b_freq + ($e_freq - $b_freq) * ($sampno / $dur));	# XXX logarithms
		$amp = ($b_amp + ($e_amp - $b_amp) * ($sampno / $dur));		# XXX logarithms

		$wavelength = $samples_per_sec / $freq;
		$sample = &$func($sampno, $wavelength) * $amp;
		$sample = 0 if $sample < 0;
		$sample = 255 if $sample > 255;
		print chr(int($sample));
	}
}

sub play_rest($)
{
	my $dur = shift;
	
	for ($i = 0; $i < $dur; $i++)
	{
		print chr(0);
	}
}

sub play_tone($$)
{
	my $note = shift;
	my $dur = shift;

	my $freq1 = $s[$note] * 440;
	# my $freq2 = $s[$note + 1] * 440;
	play_sound($freq1, $freq1, 1.0, 1.0, $dur, 'square');
}

### MAIN ###

setup_tables();
for ($n = 7; $n <= 35; $n++)
{
	play_tone($major[$n], 2000);
	# play_rest(1000);
}