[MacPerl] Blockhead speaks out

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

#!perl

# "Blockhead" v1.0
#  by David Seay <g-s@navix.net>
#
# November 1999
#


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

$white  = "65535, 65535, 65535";
$yellow = "65535, 65535, 0";
$violet = "65535, 0, 65535";
$red    = "65535,0,0";
$cyan   = "0, 65535, 65535";
$green  = "0,65535,0";
$blue   = "0,0,65535";
$black  = "0,0,0";

	$voice = $Voice{"Zarvox"};

	$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);

	$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;
	$mouthLoc[1] = new Rect $mouthLeft, $mouthTop,
		$mouthLeft + $mouthWidth, $mouthTop + $mouthHeight + 10;



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

&DrawBlockhead;
sleep 1;

$channel = NewSpeechChannel($voice) or die $^E;
@speech = split(/ /,"I can't help it if I'm a square. I was born this way.");

for $s (0..$#speech) {
	&openMouth;
	$pitch = rand (4) + 44;
	SetSpeechPitch $channel, $pitch;
	SpeakText($channel, $speech[$s]) || die $^E;
	$delay = .3;
	if (length($speech[$s]) > 4) { $delay = $delay * 2.5 }
	select(undef, undef, undef, $delay);
	&closeMouth;
	select(undef, undef, undef, .1);
	if ($speech[$s] =~ /[,.!?]/) {
		select(undef, undef, undef, .5);
	}
}
sleep 1;
while (SpeechBusy()) {}
DisposeSpeechChannel($channel);

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

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

dispose $win;

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

	RGBForeColor(new RGBColor(split(",",$eyeColor)));
	PaintOval($leftEyeLoc);
	PaintOval($rightEyeLoc);

	RGBForeColor(new RGBColor(split(",",$noseColor)));
	PaintOval($noseLoc);

	RGBForeColor(new RGBColor(split(",",$mouthColor)));
	PaintOval($mouthLoc[0]);
}

sub openMouth {
	&DrawBlockhead;
	RGBForeColor(new RGBColor(split(",",$faceColor)));
	PaintOval($mouthLoc[0]);
	RGBForeColor(new RGBColor(split(",",$mouthColor)));
	PaintOval($mouthLoc[1]);
}

sub closeMouth {
	&DrawBlockhead;
}



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