[MacPerl] Tuning Torture

[Greenblatt & Seay <g-s@navix.net>]

#!perl

# "Tuning Torture" v1.0
#  by David Seay <g-s@navix.net>
#
# The object is to make 'PITCH 2' match 'PITCH 1'.
#
#   'PITCH 1' is randomly picked by MacPerl.
#   'PITCH 2' can be adjusted by the user.
#
#   Hold down the '1' key to hear 'PITCH 1'.
#   Hold down the '2' key to hear 'PITCH 2'.
#
#   Press the '@' key (shift  '2') to make 'PITCH 2' sound higher.
#   Press the '�' key (option '2') to make 'PITCH 2' sound lower.
#
#   Press the 'return' key when you think the two pitches match.
#
#   Keep trying till you get it right.
#

use Mac::Events;
use Mac::Events qw(@Event $CurrentEvent);
use Mac::Speech;
use Mac::Windows;
use Mac::QuickDraw;
use Mac::LowMem;

$Event[keyDown] = \&keyDown_handler;
$Event[keyUp] = \&keyUp_handler;
LMSetSysEvtMask(LMGetSysEvtMask() | keyUpMask);

my($style, $title, $win, $winr, $flag);
$style = rDocProc();
$title = 'Tuning Torture';
$winr = Rect->new(200, 100, 330, 160);
$win = MacColorWindow->new(NewCWindow($winr, $title, 1, $style, 1));
$win->sethook('redraw' => \&print_pitches);

DisposeSpeechChannel $channel if $channel;
$voice = $Voice{'Zarvox'};
$channel = NewSpeechChannel($voice) or die $^E;
SpeakText $channel, $title or die $^E;

@pitch1TextPosition = split(/,/,"40,23");
@pitch2TextPosition = split(/,/,"40,45");

$eraseRect   = new Rect   0,  0, 130, 60;
$erasePitch1 = new Rect   0,  7, 130, 27;
$erasePitch2 = new Rect   0, 30, 130, 50;

@white   = split(/,/,"65535, 65535, 65535");
@yellow  = split(/,/,"65535, 65535, 0");
@red     = split(/,/,"65535,0,0");
@cyan    = split(/,/,"0, 65535, 65535");
@blue    = split(/,/,"0,0,65535");

TextFont(22); # Courier
TextSize(14);

$speech1 = 'e e e';
$speech2 = $speech1 x 200;

$highPitch = 58;
$lowPitch  = 46;

srand;
&newPitches;
while (SpeechBusy()) {}


# - - -

while ($win->window()) {
	WaitNextEvent();
	if($pitchDirection) { &change_pitch_2 }
	elsif ($newPitches) { &draw_new_pitches }
}

END { $win->dispose() if (defined($win)) }

# - - -

sub keyDown_handler {
	my($ev) = @_;
	$k = $ev->character;
	$pitchDirection = 0;

	if($k == 49 || $k == 193) {  # '1' -- PLAY PITCH 1
		SetSpeechPitch $channel, $pitch1;
 		SpeakText $channel, $speech1;
		&print_pitch_1(@cyan);
	} elsif($k ==  50) {         # '2' -- PLAY PITCH 2
		SetSpeechPitch $channel, $pitch2;
		&print_pitch_2(@yellow);
		SpeakText $channel, $speech2;
	} elsif($k ==  64) {         # '@' -- RAISE PITCH 2
		$pitchDirection =  .01;
		&pitch_2
	} elsif($k == 170) {         # '�' -- LOWER PITCH 2
		$pitchDirection = -.01;
		&pitch_2
	}

	if ($k == 13) { &checkGuess } # Return Key
}

sub keyUp_handler {
	$pitchDirection = 0;
	StopSpeech $channel or die $^E;
	&print_pitches;
}

sub print_pitches {
	&print_pitch_1(@white);
	&print_pitch_2(@white);
}

sub print_pitch_1 {
	@boxColor = @_;
	RGBForeColor(new RGBColor(@boxColor));
	PaintRect($erasePitch1);

 	RGBForeColor(new RGBColor(@red));
 	MoveTo(@pitch1TextPosition);
 	DrawString "PITCH 1";
}

sub pitch_2 {
	&change_pitch_2;
 	SpeakText $channel, $speech2  or die $^E;
}

sub change_pitch_2 {
	$pitch2 = $pitch2 + $pitchDirection;
	$pitch2 = substr($pitch2,0,5);
	if ($pitch2 > $highPitch) { $pitch2 = $highPitch }
	if ($pitch2 < $lowPitch)  { $pitch2 = $lowPitch  }
	SetSpeechPitch $channel, $pitch2;

	&print_pitch_2(@yellow);
}

sub print_pitch_2 {
	@boxColor = @_;
	RGBForeColor(new RGBColor(@boxColor));
	PaintRect($erasePitch2);

 	RGBForeColor(new RGBColor(@blue));
 	MoveTo(@pitch2TextPosition);
 	DrawString "PITCH 2";
}

sub checkGuess {
	SetSpeechPitch $channel, $pitch2;
	if($pitch1 > ($pitch2 - .26) && $pitch1 < ($pitch2 + .26)) {
		if($pitch1 == $pitch2) { SpeakText $channel, "Perfect pitch!" }
		else { SpeakText $channel, "Close enough!" }
		&flash;
		&newPitches;
	} elsif($pitch1 < $pitch2) {
		SpeakText $channel, "Too high!" or die $^E;
	} elsif($pitch1 > $pitch2) {
		SpeakText $channel, "Too low!" or die $^E;
	}
	while (SpeechBusy()) {}
}

sub newPitches {
	my($rnd);
	$highest = $highPitch - $lowPitch + 1;
	for(;;) {
		$rnd = int(rand ($highest)) + $lowPitch;
		if($rnd != $pitch1Hold) { last }
	}
	$pitch1Hold = $pitch1;
	$pitch1 = $rnd;

	$highest++;
	for(;;) {
		$pitch2 = int(rand ($highest)) + $lowPitch - 1;
		if($pitch2 != $pitch1) { last }
	}
	$pitchDirection = 0;
	$newPitches = 1;
}

sub draw_new_pitches {
	SetSpeechPitch $channel, $pitch1;
	SpeakText $channel, "Pitch one,,,,,, $speech1";
	&print_pitch_1(@cyan);
	while (SpeechBusy()) {}
	&print_pitch_1(@white);
	sleep 1;

	SetSpeechPitch $channel, $pitch2;
	SpeakText $channel, "Pitch two,,,,,, $speech1";
	&print_pitch_2(@yellow);
	while (SpeechBusy()) {}
	&print_pitch_2(@white);
	$newPitches = 0;
}

sub flash {
	$flash[0] = 0;
	$flash[1] = 65535;

	for $ii (1..25) {
		RGBForeColor(new RGBColor
		  ($flash[int(rand (2))],
		   $flash[int(rand (2))],
		   $flash[int(rand (2))]));
		PaintRect($eraseRect);
		select(undef, undef, undef, .08);
	}
 	RGBForeColor(new RGBColor(@white));
 	PaintRect($eraseRect);
	sleep(1);
}



===== Want to unsubscribe from this list?
===== Send mail with body "unsubscribe" to macperl-request@macperl.org