[Date Prev][Date Next][Thread Prev][Thread Next] [Search] [Date Index] [Thread Index]
[MacPerl] Blockhead in Love

To: MacPerl list <macperl@macperl.org>
Subject: [MacPerl] Blockhead in Love
From: Greenblatt & Seay <g-s@navix.net>
Date: Thu, 23 Sep 1999 08:09:31 -0500
#!perl

# "Blockhead in Love" v1.0
#  by David Seay <g-s@navix.net>
#
# October 1999
#
# To exit press cmd '.' repeatedly until the song stops.
#

use Mac::Events;
use Mac::Windows;
use Mac::QuickDraw;
use Mac::Fonts;
use Mac::Speech;


&set_up_graphics;
&set_up_music;
&set_up_song;


$voice   = $Voice{"Princess"};
$channel = NewSpeechChannel($voice) or die $^E;
SpeakText $channel, "Presenting $song[0], sung by Blockhead." or die $^E;
while (SpeechBusy()) {}

$voice = $Voice{"Zarvox"};
$channel = NewSpeechChannel($voice) or die $^E;

for $n (1..$#song) {
	if ($song[$n] eq "") { next }
	($word,$note,$dur) = split("\t",$song[$n]);
	&openMouth;
	SetSpeechPitch $channel, $pitch{$note};
	SpeakText $channel, $word or die $^E;
	select(undef, undef, undef, $dur{$dur} - .1);
	&closeMouth;
	select(undef, undef, undef, .1);
	WaitNextEvent();
}

sleep 1;
while (SpeechBusy()) {}
SetSpeechPitch $channel, 61;
SpeakText $channel, "Thank you." or die $^E;
while (SpeechBusy()) {}
SetSpeechPitch $channel, 60;
SpeakText $channel, "You've been a wonderful audience." or die $^E;
while (SpeechBusy()) {}

DisposeSpeechChannel($channel);

RGBForeColor(new RGBColor(@faceColor));
PaintOval($leftEyeLoc);
RGBForeColor(new RGBColor(@eyeColor));
PaintOval($leftWinkLoc);
sleep 1;
&DrawBlockhead;

WaitNextEvent while $win->window; # until close box is clicked

dispose $win;

exit(0);


sub DrawBlockhead {
	SetPort($win->window);
	PenPat($pat1);
	RGBForeColor(new RGBColor(@faceColor));
	PaintRect($faceSize);

	RGBForeColor(new RGBColor(@eyeColor));
	PaintOval($leftEyeLoc);
	PaintOval($rightEyeLoc);

	RGBForeColor(new RGBColor(@noseColor));
	PaintOval($noseLoc);

	RGBForeColor(new RGBColor(@mouthColor));
	PaintOval($mouthLoc[0]);
}

sub openMouth {
#	&DrawBlockhead;
	RGBForeColor(new RGBColor(@faceColor));
	PaintOval($mouthLoc[0]);
	RGBForeColor(new RGBColor(@mouthColor));
	if ($word =~ /o/) { PaintOval($mouthLoc[2]) }
	else { PaintOval($mouthLoc[1]) }
	if ($word =~ /\./) { &blink }
}

sub closeMouth {
	&DrawBlockhead;
	RGBForeColor(new RGBColor(@mouthColor));
	PaintOval($mouthLoc[0]);
}

sub blink {
	RGBForeColor(new RGBColor(@faceColor));
	PaintOval($leftEyeLoc);
	PaintOval($rightEyeLoc);
	RGBForeColor(new RGBColor(@eyeColor));
	PaintOval($leftWinkLoc);
	PaintOval($rightWinkLoc);
}

sub set_up_graphics {
	@white  = split(",","65535, 65535, 65535");
	@yellow = split(",","65535, 65535, 0");
	@violet = split(",","65535, 0, 65535");
	@red    = split(",","65535,0,0");
	@cyan   = split(",","0, 65535, 65535");
	@green  = split(",","0,65535,0");
	@blue   = split(",","0,0,65535");
	@black  = split(",","0,0,0");

	$winLeft    = 100;
	$winTop     = 100;
	$winWidth   = 150;
	$winHeight  = 140;

	@faceColor  = @yellow;
	$faceWidth  = 100;
	$faceHeight = 100;

	@eyeColor   = @blue;
	$eyeWidth   = 20;
	$eyeHeight  = 16;

	@noseColor  = @red;
	$noseWidth  = 14;
	$noseHeight = 30;

	@mouthColor  = @black;
	$mouthWidth  = 40;
	$mouthHeight = 4;

	$pat1 = new Pattern q{
			        XXXXXXXX
			        XXXXXXXX
			        XXXXXXXX
			        XXXXXXXX
			        XXXXXXXX
			        XXXXXXXX
			        XXXXXXXX
			        XXXXXXXX
};

	$winRight    = $winLeft + $winWidth;
	$winBottom   = $winTop + $winHeight;
	$winHorizMid = $winLeft + int($winWidth / 2);
	$winVertMid  = $winTop + int($winHeight / 2);

	$faceLeft     = int(($winWidth - $faceWidth)/2);
	$faceTop      = int(($winHeight - $faceHeight)/2);

	$faceRight    = $faceLeft + $faceWidth;
	$faceBottom   = $faceTop + $faceHeight;
	$faceHorizMid = $faceLeft  + int($faceWidth / 2);
	$faceHeight   = $faceBottom - $faceTop;
	$faceVertMid  = $faceTop  + int($faceHeight / 2);

	$faceSize     = new Rect $faceLeft, $faceTop, $faceRight, $faceBottom;

	$eyeLeft     = $faceHorizMid - $eyeWidth - 5;
	$eyeTop      = $faceTop + $eyeWidth;
	$eyeRight    = $faceHorizMid + 5;
	$eyeBottom   = $eyesTop + $eyeHeight;
	$eyeVertMid  = $eyeTop + int($eyeHeight / 2);
	$leftEyeLoc  = new Rect $eyeLeft, $eyeTop,
		$eyeLeft + $eyeWidth, $eyeTop + $eyeHeight;
	$rightEyeLoc = new Rect $eyeRight, $eyeTop,
		$eyeRight + $eyeWidth, $eyeTop + $eyeHeight;
	$leftWinkLoc = new Rect $eyeLeft, $eyeVertMid,
		$eyeLeft + $eyeWidth, $eyeTop + $eyeHeight - int($eyeHeight
/ 4);
	$rightWinkLoc = new Rect $eyeRight, $eyeVertMid,
		$eyeRight + $eyeWidth, $eyeTop + $eyeHeight -
int($eyeHeight / 4);

	$noseLeft   = $faceHorizMid - int($noseWidth / 2);
	$noseTop    = $eyeTop + $eyeHeight + 2;
	$noseLoc    = new Rect $noseLeft, $noseTop,
		$noseLeft + $noseWidth, $noseTop + $noseHeight;

	$mouthLeft   = $faceHorizMid - int($mouthWidth / 2);
	$mouthTop    = $noseTop + $noseHeight + 8;

	$mouthLoc[0] = new Rect $mouthLeft, $mouthTop,
		$mouthLeft + $mouthWidth, $mouthTop + $mouthHeight; # mouth
closed
	$mouthLoc[1] = new Rect $mouthLeft + 3, $mouthTop,
		$mouthLeft + $mouthWidth - 3, $mouthTop + $mouthHeight +
10; # mouth open wide
	$mouthLoc[2] = new Rect $mouthLeft + 7, $mouthTop,
		$mouthLeft + $mouthWidth - 7, $mouthTop + $mouthHeight + 7;
# mouth open some

	$bounds = new Rect $winLeft, $winTop, $winRight, $winBottom;
	$win = new MacColorWindow $bounds, "Blockhead", 1, floatProc(), 1;
	$win->sethook("redraw", \&DrawBlockhead);

	&DrawBlockhead;
	sleep 1;
}

sub set_up_music {
	@noteNames = split("  ",  "c  d  e  f  g  a  b  C  D  E  F  G  A  B
C1");
	@scalePitches =
split(",","48,50,52,53,55,57,59,60,62,64,65,67,69,71,72");
	for $p (0..$#scalePitches) { $pitch{$noteNames[$p]} =
$scalePitches[$p] }

	$tempo_factor = .28; # Increase if ends of words are clipped

	# NOTE DURATIONS
	$dur{e}   = .50 * $tempo_factor;  # eighth note
	$dur{de}  = .75 * $tempo_factor;  # dotted eighth note
	$dur{'q'} = 1.0 * $tempo_factor;  # quarter note
	$dur{dq}  = 1.5 * $tempo_factor;  # dotted quarter note
	$dur{h}   = 2.0 * $tempo_factor;  # half note
	$dur{he}  = 2.5 * $tempo_factor;  # half note + an eighth
	$dur{dh}  = 3.0 * $tempo_factor;  # dotted half note
	$dur{dhe} = 3.5 * $tempo_factor;  # dotted half note + an eighth
	$dur{w}   = 4.0 * $tempo_factor;  # whole note
}

sub set_up_song {
 # SONG FORMAT - items must be delimited by tabs
 #  1) word or syllable to be sung
 #  2) pitch (how high or low)
 #  3) duration (how long)
 #
 # Put a period after a word to make Blockhead blink.
 #
 # Hint: You can use a spreadsheet program to enter a new song.
 #       1) Put each note's info on a separate row.
 #       2) Select all of the spreadsheet cells.
 #       3) Paste into the '$song' variable below.
 #

# "True Love", Copyright 1988 by David D. Seay
$song = <<'EOF';
True Love, words and music copy write 1988 by David D C
do	g	q
do	a	q
do	C	q
do	C	q
I've	E	q
got	E	q
a	E	q
pim.	E	q
pull	C	q
on	C	q
the	a	q
end	C	q
of	a	q
my	C	q
nose	E	h
do	g	q
do	a	q
do	C	q
do.	C	q
and	E	q
I've	E	q
got	E	q
poise	E	q
son	C	q
oak	C	q
be	a	q
tween	C	q
all	C	q
my	E	q
toes	C	h
do.	C	q
do	b	q
do	a	q
do	g	q
I	F	q
all	F	q
ways	F	q
had	F	q
a	D	q
pair	D	q
of	b	q
not	D	q
tee	D	q
knees	F	h
do	g	q
do	a	q
do	C	q
do.	C	q
I	E	q
real	E	q
ee	E	q
make	E	q
a	E	q
mess	E	q
when	E	q
ev	G	q
er	G	q
I	E	q
sneeze	C	h
do	g	q
do	a	q
do	C	q
do.	C	q
I've	E	q
got	E	q
a	E	q
pair	E	q
of	C	q
feet	C	q
that	a	q
real	C	q
lee	a	q
do	C	q
stink	E	h
do	g	q
do	a	q
do	C	q
do	C	q
I've	E	q
got	E	q
a	E	q
point	E	q
mints	C	q
ev	C	q
ree	a	q
week	C	q
with	C	q
my	E	q
shrink.	C	h
do	C	q
do	b	q
do	a	q
do	g	q
There	F	q
is	F	q
still	F	q
one	D	q
thing	D	q
that	b	q
keeps	D	q
me	D	q
hap	D	q
pee	F	h
do	g	q
do	a	q
do	C	q
do.	C	q
I	E	q
know	E	q
my	E	q
bay	E	q
be	E	h
she's	E	q
still	G	q
hen	G	q
love	E	q
with	E	q
me	C	q
I	g	q
call	a	q
that	C	q
True	E	w
love	C	h
do	g	q
do	a	q
do.	C	q
do	E	w
do	C	h
do	g	q
do	C	q
do	E	q
do	F	w
do	D	h
do	g	q
do	a	q
do	C	q
do.	E	w
do	C	h
do	g	q
do	a	q
do	C	q
do	E	w
do	C	h
do	g	q
do	a	q
do	C	q
do	E	w
do	C	h
do.	g	q
do	C	q
do	E	q
do	F	w
do	D	h
do	g	q
do	a	q
do	C	q
do	E	w
do.	C	w
EOF

	@song = split("\n",$song);
}


sub key_down {
	my($ev) = @_;
	$k = chr($ev->character);
	if (($CurrentEvent->modifiers & 256) == 256 && $k eq ".") {
		StopSpeech $channel or die $^E;
		DisposeSpeechChannel $channel;
		dispose $win;
		exit(0);
	}
}



===== Want to unsubscribe from this list?
===== Send mail with body "unsubscribe" to macperl-request@macperl.org
Prev by Date: Re: [MacPerl] chineese scroll
Next by Date: [MacPerl] How Cross Platform is Perl
Prev by thread: Re: [MacPerl] How Cross Platform is Perl
Next by thread: [MacPerl] set a startup directory under MacPerl
Navigation: Date Index | Thread Index | Search | Other lists at bumppo.net