[MacPerl] Chaser 1.1

[kpreid@ibm.net (Kevin Reid)]

#!perl -w

# Chaser v1.1
# by Kevin Reid <kpreid@ibm.net>
#
# Use the mouse to drive around and catch the moving objects.
# Click to fire iceballs that turn them into non-moving objects (temporarily).
# Don't run into walls.
# Press a key to stop.
#
# If you see a bright red square in the upper-left
# corner, then the game is running slower than it should.
#
# Performance tips:
#  1. Quit some applications.
#  2. Reduce color depth.
#  3. Get a faster Mac.
# 
# Revision history
# 1.1
#   * Added win animation.
#   * Added random background color.
#   * Minor efficency improvements.
#   * You no longer get damaged for hitting a wall with a velocity under 2.
#   * Damage flash now varies with intensity of damage.
#   * Shot firing added.
# 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;
use MacPerl;
{
  local $/; eval <DATA>; die $@ if $@;
  import Mac::KTools qw(/^FS_/ /^Gradient_/);
}

use constant VWIDTH => 200;
use constant VHEIGHT => 150;

use constant COL_BACKGROUND => new RGBColor((0)x3);

use constant COL_FLOOR => new RGBColor( @{([10100,0,0], [0,5000,0], [0,0,8000])[rand 3]} );
use constant COL_WALL => new RGBColor((32768)x3);
use constant COL_PLAYER => new RGBColor((65535)x3);
use constant COL_TARGET => new RGBColor((65535)x3);

use constant COL_HEALTHFG => new RGBColor (16384, 16384, 65535);
use constant COL_HEALTHBG => new RGBColor (5000, 0, 0);
use constant COL_TEXT => new RGBColor((65535)x3);
use constant COL_TEXTSHAD => new RGBColor((20000)x3);
use constant COL_SPEEDBLIP => new RGBColor (65535, 0, 0);

use vars qw(
  $Done $Width $Height
        $CenterX $CenterY $CenterPt
  $Clicked $OldCStr $StartTime
  $BlipRect

  $GameRect $GameRegion
  @LevMRects
  $LevRegion
  $DrawRegion
  @MulTab @InvMulTab

  $PlayerX $PlayerY $PlayerAng
  $PlayerVel $Health
  
  @ObjMov $TRemain
  @Shots $GunCharge

  $Won $WScale
);

$| = 1;
@LevMRects = (
  [-500, -300, 500, 600],
  [-400, -200, -100, 200],
  [100, -200, 400, 200],
  [-50, 300, 50, 597],
);
MacPerl::Quit(kMacPerlQuitIfRuntime);

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 my @s = MakePoint $p[0], $p[1];
    LineTo MakePoint $p[2], $p[1];
    LineTo MakePoint $p[2], $p[3];
    LineTo MakePoint $p[0], $p[3];
    LineTo @s;
    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(COL_HEALTHFG);
  PaintRect new Rect ($GameRect->left, $GameRect->bottom + 10, $GameRect->left + $hv, $GameRect->bottom + 24);
  RGBForeColor(COL_HEALTHBG);
  PaintRect new Rect ($GameRect->left + $hv, $GameRect->bottom + 10, $GameRect->right, $GameRect->bottom + 24);
  ClipRect($GameRect);
}

sub DrawTargetsBar {
  RGBForeColor(COL_BACKGROUND);
  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;
  for (my $i = 0; $i < @ObjMov; $i++) {
    RGBForeColor($i < (@ObjMov-$TRemain) ? COL_TEXT : COL_TEXTSHAD);
    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);
#$BlipRect = new Rect ($Width/4, $Height/4, $Width/4 + 5, $Height/4 + 5);
$GameRect = new Rect ($CenterX - VWIDTH, $CenterY - VHEIGHT, $CenterX + VWIDTH, $CenterY + VHEIGHT);
$BlipRect = new Rect ($CenterX - VWIDTH, $CenterY - VHEIGHT, $CenterX - VWIDTH + 5, $CenterY - VHEIGHT + 5);
$LevRegion = GetLevRgn;
$GameRegion = NewRgn;
RectRgn $GameRegion, $GameRect;

NEWGAME:

$PlayerAng = 0;
$PlayerY = 250;
$PlayerX = 100;
$Health = 100;
$GunCharge = 0;
@Shots = ();
SetMouse($CenterPt);
$Won = 0; $WScale = 1;

@ObjMov = (
  {'y' => -250, 'x' => 450, yv => 3, xv => 2, draw => 1, frozen => 0},
  {'y' => 250, 'x' => 450, yv => 3, xv => 2, draw => 1, frozen => 0},
  {'y' => -250, 'x' => -450, yv => 3, xv => 2, draw => 1, frozen => 0},
  {'y' => 250, 'x' => -450, yv => 3, xv => 2, draw => 1, frozen => 0},
  {'y' => 0, 'x' => 0, yv => 3, xv => 2, draw => 1, frozen => 0},

  {'y' => 550, 'x' => 450, yv => 3, xv => 2, draw => 1, frozen => 0},
  {'y' => 550, 'x' => -450, yv => 3, xv => 2, draw => 1, frozen => 0},
);
$TRemain = @ObjMov;

SetPort FS_Port();
RGBBackColor(COL_BACKGROUND);
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;
  if (TickCount() > $cticks) {
    RGBForeColor(COL_SPEEDBLIP);
    PaintRect $BlipRect;
  }
  $cticks = TickCount() + 2; # limit speed to 30fps
  SetPort FS_Port();
  $DrawRegion = GetDrawRgn;
  RGBForeColor(COL_WALL);
  {
    my $r = XorRgn($DrawRegion, $GameRegion);
    PaintRgn $r;
    DisposeRgn $r;
  }
  RGBForeColor(COL_FLOOR);
  PaintRgn $DrawRegion;
  RGBForeColor(COL_PLAYER);
  MoveTo($CenterX +  0*$WScale, $CenterY + -10*$WScale);
  LineTo($CenterX +  5*$WScale, $CenterY +  10*$WScale);
  LineTo($CenterX + -5*$WScale, $CenterY +  10*$WScale);
  LineTo($CenterX +  0*$WScale, $CenterY + -10*$WScale);
  foreach (@ObjMov) {
    next unless $$_{draw};
    my $f = (65535 - $$_{frozen} * 500);
    $f = 0 if $f < 0;
    RGBForeColor(new RGBColor(($f)x2, 65535));
    my @p = MakePoint $$_{'x'}, $$_{'y'};
    FrameOval new Rect($p[0]-5, $p[1]-5, $p[0]+5, $p[1]+5);
  }
  foreach (@Shots) {
    RGBForeColor($$_{color});
    my @p = MakePoint $$_{'x'}, $$_{'y'};
    PaintOval new Rect($p[0]-2, $p[1]-2, $p[0]+2, $p[1]+2);
  }
  if ($Won) {
    WinMsg() if $Won > 100;
    $Won++; $WScale = (($Won/60)**10) + 1;
    $PlayerAng += $Won / 100;
    for (1..3*$WScale) {
      RGBForeColor(new RGBColor(rand 65535, rand 65535, rand 65535));
      my @p = ($CenterX + rand(10 * $WScale) - 5 * $WScale, $CenterY + rand (10 * $WScale) - 5 * $WScale);
      PaintOval new Rect($p[0]-2, $p[1]-2, $p[0]+2, $p[1]+2);
    }
  }

  WaitNextEvent unless $t % 5;

  if (!$Won) {
    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);
      if ($PlayerVel > 2) {
        my $cticks = TickCount() + 1;
        RGBForeColor(new RGBColor($PlayerVel * 2000 + 10000, 0, 0));
        PaintRgn($DrawRegion);
        #InvertRect($GameRect);
        $Health -= $PlayerVel * 1.5;
        DrawHealthBar();
        $PlayerVel = 0;
        #InvertRect($GameRect);
        1 while TickCount() < $cticks;
        last unless $Health > 0;
      }
    }
  }
  DisposeRgn $DrawRegion;

  foreach (@ObjMov) {
    next unless $$_{draw};
    if (PtInRect(new Point($$_{'x'}, $$_{'y'}), new Rect($PlayerX-6, $PlayerY-6, $PlayerX+6, $PlayerY+6))) {
      $TRemain--; $$_{draw} = 0;
      DrawTargetsBar();
      $Won = 1 unless $TRemain;
    }
    for (my $s = 0; $s < @Shots; $s++) {
      my $shot = $Shots[$s];
      if ( PtInRect(new Point($$_{'x'}, $$_{'y'}), new Rect($$shot{'x'}-6, $$shot{'y'}-6, $$shot{'x'}+6, $$shot{'y'}+6))) {
        $$_{frozen} += $$shot{charge};
        splice @Shots, $s--, 1;
      }
    }

    if ($$_{frozen}) {
      $$_{frozen}--;
      next;
    }

    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;
  }

  $GunCharge += 5 if $GunCharge < 100;
  if (Button() and $GunCharge > 50) {
    my $f = (($GunCharge-50) / 50 * 65535);
    $f = 65535 if $f > 65535;
    push @Shots, {'y' => $PlayerY, 'x' => $PlayerX,
      xv => ($PlayerVel + 12) * cos($PlayerAng),
      yv => ($PlayerVel + 12) * -sin($PlayerAng),
      life => 100, charge => $GunCharge, color => new RGBColor(($f)x2, 65535),
    };
    $GunCharge = 0;
  }
  for (my $s = 0; $s < @Shots; $s++) {
    my $shot = $Shots[$s];
    $$shot{'x'} += $$shot{xv};
    $$shot{'y'} += $$shot{yv};
    if (!(--$$shot{life}) or !PtInRgn(new Point($$shot{'x'}, $$shot{'y'}), $LevRegion)) {
      splice @Shots, $s--, 1;
    }
  }
}

sub CenterStr {
  my ($str, $y, $fc) = @_;

  MoveTo(my $px = $CenterX - StringWidth($str) / 2, my $py = $CenterY + $y);
  if (!$OldCStr or $OldCStr ne $str) {
    RGBForeColor(COL_TEXTSHAD);
    DrawString $str;
  } 
  RGBForeColor($fc);
  MoveTo($px - 1, $py - 1);
  DrawString $str;
  $OldCStr = $str;
}

sub WinMsg {
  my $g = Gradient_New(8000);
  EraseRect(FS_Port()->portRect);
  local $" = ':';
  TextFont(0); TextSize(12);
  CenterStr(
    "Time: @{[reverse +(localtime(time - $StartTime))[0..2]]}",
    30,
    COL_TEXT,
  );
  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, COL_TEXT);
$Clicked = 0;
{
  $Health = 100; my $cticks = 0;
  while ($Health > 0 and !$Clicked and !$Done) {
    next if TickCount() < $cticks;
    $cticks = TickCount() + 3;
    WaitNextEvent;
    $Health -= .5;
    DrawHealthBar();
  };
}

goto NEWGAME if $Clicked;

END {
  ShowCursor;
  DisposeRgn $DrawRegion if $DrawRegion;
  DisposeRgn $LevRegion if $LevRegion;
}

#---------------------------------------------------------------------------------
__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