[MacPerl] Chaser

[kpreid@ibm.net (Kevin Reid)]

#!perl -w

# Chaser v1.0
# 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
#   First release.

use strict;
use Mac::QuickDraw;
use Mac::Windows;
use Mac::Events;
{
  local $/; eval <DATA>;
  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__

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