[Date Prev][Date Next][Thread Prev][Thread Next]
[Search]
[Date Index]
[Thread Index]
Re: [MacPerl] Chaser
.<snip load of error messages>
> Ouch, ouch. The subs are sinking...
Ouch, ouch, ouch. That's what I get for not thoroughly testing it.
You can either install Arved's ColorGamma module, or run this fixed
version:
#!perl -w
# Chaser v1.0.1
# by Kevin Reid <kpreid@ibm.net>
#
# Use the mouse to drive around and catch the moving objects.
# Don't run into walls.
# Press a key to stop.
#
# Performance tips:
# 1. Get a faster Mac.
# 2. Reduce screen size and color depth.
#
# Revision history
# 1.0.1
# * Fixed handling of absence of ColorGamma module.
# 1.0
# * First release.
use strict;
use Mac::QuickDraw;
use Mac::Windows;
use Mac::Events;
{
local $/; eval <DATA>; die $@ if $@;
import Mac::KTools qw(/^FS_/ /^Gradient_/);
}
use vars qw(
$Done $Width $Height
$CenterX $CenterY $CenterPt
$Clicked $OldCStr $StartTime
$GameRect $GameRegion
@LevMRects
$LevRegion
$DrawRegion
@MulTab @InvMulTab
$PlayerX $PlayerY $PlayerAng
$PlayerVel $Health
@ObjMov $TRemain
);
$| = 1;
@LevMRects = (
[-500, -300, 500, 300],
[-400, -200, -100, 200],
[100, -200, 400, 200],
);
sub SetMouse {
use Mac::LowMem;
my ($pt) = @_;
LMSetMouseTemp($pt);
LMSetRawMouseLocation($pt);
LMSetCursorNew(1);
}
sub GetMouseOffset {
use Mac::LowMem;
my $pt = GetMouse;
LMSetMouseTemp($CenterPt);
LMSetRawMouseLocation($CenterPt);
LMSetCursorNew(1);
($pt->h - $CenterX, $pt->v - $CenterY);
}
sub MakePoint {
(($_[0] + -$PlayerX) * $MulTab[0] + ($_[1] + -$PlayerY) * $MulTab[1]) * .75 + $CenterX,
(($_[0] + -$PlayerX) * $MulTab[2] + ($_[1] + -$PlayerY) * $MulTab[3]) * .75 + $CenterY,
;
}
sub GetDrawRgn {
@MulTab = (-sin($PlayerAng), -cos($PlayerAng),
-cos($PlayerAng), sin($PlayerAng));
@InvMulTab = (sin(-$PlayerAng), cos(-$PlayerAng),
cos(-$PlayerAng), -sin(-$PlayerAng));
my @polys = map {
my $poly = OpenPoly;
my @p = @$_;
MoveTo MakePoint $p[0], $p[1];
LineTo MakePoint $p[2], $p[1];
LineTo MakePoint $p[2], $p[3];
LineTo MakePoint $p[0], $p[3];
LineTo MakePoint $p[0], $p[1];
ClosePoly;
$poly;
} @LevMRects;
OpenRgn;
foreach (@polys) {
FramePoly $_;
KillPoly $_;
}
return CloseRgn;
}
sub GetLevRgn {
my @polys = map {
my $poly = OpenPoly;
my @p = @$_;
MoveTo $p[0], $p[1];
LineTo $p[2], $p[1];
LineTo $p[2], $p[3];
LineTo $p[0], $p[3];
LineTo $p[0], $p[1];
ClosePoly;
$poly;
} @LevMRects;
OpenRgn;
foreach (@polys) {
FramePoly $_;
KillPoly $_;
}
return CloseRgn;
}
sub DrawHealthBar {
$Health = 0 if $Health < 0;
ClipRect(FS_Port()->portRect);
my $hv = $Health / 100 * $Width / 2 + (!!$Health and $Health < 50);
RGBForeColor(new RGBColor (16384, 16384, 65535));
PaintRect new Rect ($GameRect->left, $GameRect->bottom + 10, $GameRect->left + $hv, $GameRect->bottom + 24);
RGBForeColor(new RGBColor (5000, 0, 0));
PaintRect new Rect ($GameRect->left + $hv, $GameRect->bottom + 10, $GameRect->right, $GameRect->bottom + 24);
ClipRect($GameRect);
}
sub DrawTargetsBar {
RGBForeColor(new RGBColor((0)x3));
ClipRect(FS_Port()->portRect);
PaintRect new Rect ($GameRect->left, $GameRect->top - 20, $GameRect->right, $GameRect->top);
my $lco = $GameRect->left + 8;
my $tco = $GameRect->top - 8;
RGBForeColor(new RGBColor((65535)x3));
for (my $i = 0; $i < $TRemain; $i++) {
FrameOval new Rect($lco+$i*17-5, $tco-5, $lco+$i*17+5, $tco+5);
}
ClipRect($GameRect);
}
HideCursor;
($CenterX, $CenterY) = map $_ / 2, ($Width, $Height) = FS_Start();
$CenterPt = new Point ($CenterX, $CenterY);
FS_Hook(click => sub {$Clicked = 1});
FS_Hook(key => sub {$Done = 1});
SetPort FS_Port();
$GameRect = new Rect ($Width/4, $Height/4, $Width - $Width/4, $Height - $Height/4);
$LevRegion = GetLevRgn;
$GameRegion = NewRgn;
RectRgn $GameRegion, $GameRect;
NEWGAME:
$PlayerAng = 0;
$PlayerY = 250;
$PlayerX = 100;
$Health = 100;
SetMouse($CenterPt);
@ObjMov = (
{'y' => -250, 'x' => 450, yv => 3, xv => 2, draw => 1},
{'y' => 250, 'x' => 450, yv => 3, xv => 2, draw => 1},
{'y' => -250, 'x' => -450, yv => 3, xv => 2, draw => 1},
{'y' => 250, 'x' => -450, yv => 3, xv => 2, draw => 1},
{'y' => 0, 'x' => 0, yv => 3, xv => 2, draw => 1},
);
$TRemain = @ObjMov;
SetPort FS_Port();
RGBBackColor(new RGBColor(0, 0, 0));
EraseRect FS_Port()->portRect;
ClipRect $GameRect;
InvertRgn ($DrawRegion = GetDrawRgn);
DrawHealthBar();
DrawTargetsBar();
$StartTime = time;
my $cticks = 0;
my $t;
while ($t++, !$Done) {
next if TickCount() < $cticks;
$cticks = TickCount() + 2;
SetPort FS_Port();
$DrawRegion = GetDrawRgn;
RGBForeColor(new RGBColor((32768)x3));
{
my $r = XorRgn($GameRegion, $DrawRegion);
PaintRgn $r;
DisposeRgn $r;
}
RGBForeColor(new RGBColor(10000, 0, 0));
PaintRgn $DrawRegion;
DisposeRgn $DrawRegion;
RGBForeColor(new RGBColor((65535)x3));
MoveTo($CenterX, $CenterY-10);
LineTo($CenterX+5, $CenterY+10);
LineTo($CenterX-5, $CenterY+10);
LineTo($CenterX, $CenterY-10);
foreach (@ObjMov) {
next unless $$_{draw};
my @p = MakePoint $$_{'x'}, $$_{'y'};
FrameOval new Rect($p[0]-5, $p[1]-5, $p[0]+5, $p[1]+5);
}
WaitNextEvent unless $t % 5;
my ($dx, $dy) = GetMouseOffset;
$PlayerAng += $dx * .01;
$PlayerVel -= $dy / ($Height/30);
$PlayerVel = 0 if $PlayerVel < 0;
my ($opx, $opy) = ($PlayerX, $PlayerY);
$PlayerX -= ($PlayerVel * $MulTab[1]);
$PlayerY -= ($PlayerVel * $MulTab[3]);
if (!PtInRgn(new Point($PlayerX, $PlayerY), $LevRegion)) {
($PlayerX, $PlayerY) = ($opx, $opy);
InvertRect($GameRect);
for (1..30) {
$Health -= ($PlayerVel / 30);
DrawHealthBar();
}
$PlayerVel = 0;
my $cticks = TickCount() + 1;
1 while TickCount() < $cticks;
InvertRect($GameRect);
last unless $Health > 0;
}
foreach (@ObjMov) {
next unless $$_{draw};
my ($ox, $oy) = @$_{'x', 'y'};
$$_{'x'} += $$_{xv};
if (!PtInRgn(new Point($$_{'x'}, $$_{'y'}), $LevRegion)) {
@$_{'x', 'y'} = ($ox, $oy);
$$_{xv} *= -1;
}
$$_{'y'} += $$_{yv};
if (!PtInRgn(new Point($$_{'x'}, $$_{'y'}), $LevRegion)) {
@$_{'x', 'y'} = ($ox, $oy);
$$_{yv} *= -1;
}
$$_{yv} += (rand .5)-.25;
$$_{xv} += (rand .5)-.25;
if (PtInRect(new Point($$_{'x'}, $$_{'y'}), new Rect($PlayerX-6, $PlayerY-6, $PlayerX+6, $PlayerY+6))) {
$TRemain--; $$_{draw} = 0;
DrawTargetsBar();
Win() unless $TRemain;
}
}
}
sub CenterStr {
my ($str, $y, $fc) = @_;
MoveTo(my $px = $CenterX - StringWidth($str) / 2, my $py = $CenterY + $y);
if (!$OldCStr or $OldCStr ne $str) {
RGBForeColor(new RGBColor((32768)x3));
DrawString $str;
}
RGBForeColor($fc);
MoveTo($px - 1, $py - 1);
DrawString $str;
$OldCStr = $str;
}
sub Win {
my $g = Gradient_New(8000);
EraseRect(FS_Port()->portRect);
local $" = ':';
TextFont(0); TextSize(12);
CenterStr(
"Time: @{[reverse +(localtime(time - $StartTime))[0..2]]}",
30,
new RGBColor((65535)x3),
);
TextFont(0); TextSize(30);
$Clicked = 0;
my $cticks = 0;
while (!$Clicked and !$Done) {
WaitNextEvent;
Gradient_Iter($g);
CenterStr('You won!', 0, Gradient_Col($g));
}
exit;
}
exit if $Done;
EraseRect(FS_Port()->portRect);
TextFont(0); TextSize(30);
CenterStr('Click to try again.', 0, new RGBColor((65535)x3));
$Clicked = 0;
{
$Health = 100; my $cticks = 0;
while ($Health > 0 and !$Clicked and !$Done) {
next if TickCount() < $cticks;
$cticks = TickCount() + 3;
WaitNextEvent;
DrawHealthBar();
$Health -= .5;
};
}
goto NEWGAME if $Clicked;
END {ShowCursor}
#---------------------------------------------------------------------------------
__DATA__
package Mac::KTools;
require Exporter;
@Mac::KTools::ISA = qw(Exporter);
@Mac::KTools::EXPORT_OK = qw(
FS_Start
FS_Stop
FS_Port
FS_Hook
Gradient_New
Gradient_Iter
Gradient_Col
ClickRect
$GPort
);
use strict;
use Carp;
use Mac::QuickDraw;
use Mac::Windows;
use Mac::Menus;
use Mac::LowMem;
use Mac::Events;
use constant FILEMENU => GetMenu 129;
use constant EDITMENU => GetMenu 130;
use vars qw(
$FS_On
$FS_Win @FS_OSWins
$FS_Bounds
$FS_OldGrayRgn
$FS_OldMBH
$CGA $gnormal
$GPort
);
BEGIN {eval 'use ColorGamma'; $CGA = !$@}
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub FS_Start {
return if $FS_On;
$FS_On = 1;
if ($CGA) {
$gnormal = new_GIHdl();
StartFading($gnormal) and die "Bad start";
FadeToBlack(200, inverseQuadraticFade());
}
$FS_OldGrayRgn = CopyRgn(GetGrayRgn());
RectRgn(GetGrayRgn, GetWMgrPort->portRect);
$FS_OldMBH = LMGetMBarHeight;
LMSetMBarHeight(0);
DisableItem FILEMENU;
DisableItem EDITMENU;
$FS_Win = new MacColorWindow (
$FS_Bounds = GetMainDevice->gdRect,
'Fullscreen 0',
1,
dBoxProc,
1,
);
$FS_Win->sethook('drawgrowicon', sub {});
SetPort $FS_Win->window;
RGBBackColor(new RGBColor(0,0,0));
for (1..20) {WaitNextEvent}
FadeToGamma($gnormal, 1, inverseQuadraticFade()) if $gnormal;
return ($FS_Bounds->right - $FS_Bounds->left,
$FS_Bounds->bottom - $FS_Bounds->top);
}
sub FS_Stop {
return unless $FS_On;
if ($CGA) {
StartFading($gnormal = new_GIHdl()) and die "Bad start";
FadeToBlack(40, inverseQuadraticFade());
}
LMSetMBarHeight($FS_OldMBH) if $FS_OldMBH;
EnableItem GetMenu 129;
EnableItem GetMenu 130;
if ($FS_Win) {
SetPort $FS_Win->window;
RGBBackColor(new RGBColor(0,0,0));
EraseRect($FS_Bounds);
}
if ($FS_OldGrayRgn) {
CopyRgn($FS_OldGrayRgn, GetGrayRgn);
DisposeRgn $FS_OldGrayRgn;
}
$FS_Win->dispose if $FS_Win;
$FS_On = 0;
WaitNextEvent; WaitNextEvent; WaitNextEvent;
# let things redraw
if ($gnormal) {
FadeToGamma($gnormal, 90, inverseQuadraticFade());
StopFading($gnormal, 1);
}
}
sub FS_Port {$FS_Win->window}
sub FS_Hook {
my ($hook, $sub) = @_;
$FS_Win->sethook($hook => sub {shift; goto &$sub});
}
END {FS_Stop()}
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub Gradient_New {
my ($speed) = @_;
[map {val => rand 65535, vel => rand ($speed || 200)}, 1..3];
}
sub Gradient_Iter {
foreach my $c (@{$_[0]}) {
$c->{val} += $c->{vel};
if ($c->{val} > 65535 or $c->{val} < 0) {
$c->{vel} *= -1;
redo;
}
}
}
sub Gradient_Col {
return new RGBColor(map {$_->{val}} @{$_[0]})
}
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub ClickRect {
my ($r) = @_;
my ($in, $oin) = (1, 1);
InvertRect($r);
while (StillDown()) {
$in = PtInRect(GetMouse, $r);
if ($in != $oin) {
InvertRect($r);
}
$oin = $in;
}
$in;
}
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
{
package GrafPortVar;
use Carp;
use Mac::QuickDraw;
sub TIESCALAR {bless {}, $_[0]}
sub FETCH {GetPort()}
sub STORE {
my ($class, $port) = @_;
ref $port eq 'GrafPtr' or croak "Attempt to set \$GPort to a @{[ref $port]} instead of a GrafPtr";
my $oport = GetPort;
SetPort $port;
return $oport;
}
}
tie $GPort, 'GrafPortVar';
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
__END__
--
Kevin Reid: | Macintosh:
"I'm me." | Think different.
===== Want to unsubscribe from this list?
===== Send mail with body "unsubscribe" to macperl-request@macperl.org