[MacPerl] Cannon

[kpreid@ibm.net (Kevin Reid)]

#!perl -w

# Cannon v1.0
# by Kevin Reid
#
# I recommend running this with a resolution of 800x600.
#
# Click to fire a shot.
# The mouse position controls the velocity and angle of the shot.
#
# To stop, press a key.
# 
# Version History
# 1.0
#   * Initial release


use Mac::QuickDraw;
use Mac::Windows;
use Mac::Events;
use Mac::Menus;
use Mac::LowMem;

### \/ \/ Change these two parameters to affect how fast the game runs.

$system_time = 20;
  # Other applications will be given time
  # every $system_time frames.
$vel_mult = 2;
  # Increasing this value will increase the speed of all
  # objects; however, making it too high will result
  # in objects passing through each other.

$color_vel_max = 5000;
  # Maximum color-change speed for the shots.
$linewid = 2;
  # Width of the shot lines.
$grav = 0.04;
  # Gravity.
$loss = 0.89;
  # Velocity lost with each bounce.
$num_targets = 10;
  # Number of targets created.
$maxshots = 7;
  # Maximum number of shots you can have on the
  # screen at once.
$cansiz = 70;
  # Size of your cannon.
$shotlife = 500;
  # Shots last this long before disappearing.

$sid = 0;
$OScore = $Score = 0;
$cwhite = new RGBColor((65535) x 3);

sub ltwh ($$$$) {
  my ($left, $top, $width, $height) = @_;
  new Rect ($left, $top, $left+$width, $top+$height);
}

$origrgn = CopyRgn(GetGrayRgn());
RectRgn(GetGrayRgn, GetMainDevice()->gdRect);

BEGIN {
  $oheight = LMGetMBarHeight;
  LMSetMBarHeight(0);
  DisableItem GetMenu 129;
  DisableItem GetMenu 130;
}

END {
  LMSetMBarHeight($oheight);
  EnableItem GetMenu 129;
  EnableItem GetMenu 130;

  if ($win) {
    SetPort $win->window;
    EraseRect($bbx);
  }

  if ($origrgn) {
    CopyRgn($origrgn, GetGrayRgn);
    DisposeRgn $origrgn;
  }
  $win->dispose if $win;
}


$bbx = InsetRect(GetWMgrPort->portRect, 0, 0);
$bw = $bbx->right - $bbx->left;
$bh = $bbx->bottom - $bbx->top;
$canrect = new Rect(-$cansiz, $bh - $cansiz, $cansiz, $bh + $cansiz);

$win = new MacColorWindow (
  $bbx,
  'Bouncer',
  1,
  plainDBox,
  1,
);
$win->sethook('drawgrowicon', sub {});
$win->sethook(key => sub {EndGame()});
$win->sethook(cursor => sub {SetCursor(crossCursor)});
SetPort $win->window;
PenSize($linewid, $linewid);
RGBBackColor(new RGBColor(0,0,0));

$spacing = (($bh - 150) / $num_targets);
for (1..$num_targets) {
  $targets{$_} = {
    rect => ltwh(rand($bw - 100), $_ * $spacing, 10 + rand 90, 10 + rand
($spacing - 10)),
    xv => (rand 3 * $vel_mult) + 1,
    yv => 0,
  };
}

sub getcolor {
  my @colors = ();
  for (qw(R G B)) {
    push @colors, {
      val => rand 65535,
      vel => rand $color_vel_max,
    };
  }
  return \@colors;
}

sub fire {
  my ($xv, $yv) = @_;
  
  $shots{$sid++} = {
    begin => {
      xp => 0,
      yp => $bh,
      xv => $xv,
      yv => -$yv,
      'time' => $shotlife,
      exist => 0,
      col => getcolor(),
      bounces => 0,
    },
    end => {
      xp => 0,
      yp => $bh,
      xv => $xv,
      yv => -$yv,
      'time' => $shotlife,
      start => 30/($xv+$yv),
      col => [{val => 0, vel => 0}, {val => 0, vel => 0}, {val => 0, vel
=> 0}],
      bounces => 0,
    },
  };
  # $fired++;
  $Score -= 20 / $num_targets;
}

sub Won {EndGame('YOU WIN')}
sub Lost {EndGame('YOU LOSE')}

sub EndGame {
  my ($Msg) = @_;

  $win->sethook(key => sub {});
  HideCursor();
  TextMode(srcXor);
  TextFont(0);
  TextSize(100);

  ShowText($Msg) if $Msg;
  ShowText('Score:');
  # $score = eval {($destroyed / $num_targets * 100) - (($fired -
$destroyed) / $fired) * 20} || 0;
  ShowText(sprintf '%.0f', $Score);

  ShowCursor();
  exit;
}

sub ShowText {
  my ($Msg) = @_;

  my ($ascent, $descend) = GetFontInfo();
  my $height = $ascent + $descend;
  my $TextY = $bh/2 + $height/2 - ($height - $ascent) - .5;
  my $TextX = $bw/2 - StringWidth($Msg)/2;

  MoveTo($TextX, $TextY); DrawString($Msg);
  ScreenStripes();
  sleep 2;
  ScreenStripes();
  MoveTo($TextX, $TextY); DrawString($Msg);

  EraseRect(new Rect(0, 0, $bw, $bh));
}  

sub ScreenStripes {
  my $max = $bh/2 - 130; my $inc = 18;
  for (my $i = 0; $i < $max; $i += $inc) {
    InvertRoundRect(new Rect($i, $i, $bw-$i, $bh-$i), 100, 100);
    WaitNextEvent;
  }
}

sub ExplodePoint {
  my ($x, $y, $speed, $size) = @_;

  for (1..(20 / $vel_mult)) {
    for (my $i = 0; $i < $size; $i+= 2) {
      InvertOval(new Rect($x-$i, $y-$i, $x+$i, $y+$i));
      for (my $i = 0; $i < (1000/$speed); $i++) {}
    }
  }
}  

sub Run_Shots {
  SHOT: foreach $k (keys %shots) {
    my $head = $shots{$k}{begin};
    if ($head) {
      $head->{exist}++;
      my $hpt = new Point($head->{xp}, $head->{yp});
      foreach (keys %targets) {
        my $t = $targets{$_};
        if (PtInRect($hpt, $t->{rect})) {
          my $bigrect = InsetRect($t->{rect}, -20, -20);
          for (1..50) {
            InvertRoundRect($bigrect, 10, 10);
          }
          ExplodePoint($head->{xp}, $head->{yp}, 50, 30);
          EraseRoundRect($bigrect, 10, 10);
          delete $targets{$_};
          # $destroyed++;
          $Score += 120 / $num_targets;
          if (not keys %targets) {Won()}
          delete $shots{$k};
          last SHOT;
        }
      }

      if ($head->{exist} > $cansiz+10 and PtInRect($hpt, $canrect)) {
        ExplodePoint($head->{xp}, $head->{yp}, 1, 30);
        $Score -= 20;
        Lost();
      }
    }

    PT: foreach $pk (keys %{$shots{$k}}) {
      $s = $shots{$k}{$pk};

      if ($s->{start} and $s->{start} > 0) {
        $s->{start}--;
        next PT;
      }

      $s->{'time'}--;
      if ($s->{'time'} <= 0) {
        delete $shots{$k}{$pk};
        if (keys %{$shots{$k}} < 1) {
          delete $shots{$k};
        }
        next SHOT;
      }

      RGBForeColor(new RGBColor(map {$_->{val}} @{$s->{col}}));
      MoveTo($s->{xp}, $s->{yp});

      $s->{xp} += $s->{xv};
      $s->{yp} += $s->{yv};
      if ($s->{xp} > $bw) {
        $s->{xv} *= -$loss;
        $s->{xp} = $bw;
      }
      if ($s->{xp} < 0) {
        $s->{xv} *= -$loss;
        $s->{xp} = 0;
      }
      if ($s->{yp} > $bh) {
        $s->{yv} *= -$loss;
        $s->{yp} = $bh;
      }
      if ($s->{yp} < 0) {
        $s->{yv} *= -$loss;
        $s->{yp} = 0;
      }
      $s->{yv} += $grav * $vel_mult**2;
      LineTo($s->{xp}, $s->{yp});

      foreach $c (@{$s->{col}}) {
        $c->{val} += $c->{vel};
        if ($c->{val} > 65535 or $c->{val} < 0) {
          $c->{vel} *= -1;
          redo;
        }
      }

    }
  }
}

sub Run_Targets {
  RGBForeColor($cwhite);
  foreach my $k (keys %targets) {
    my $t = $targets{$k};

    #$twid = $t->{rect}->right - $t->{rect}->left;
    $trect = $t->{rect};
    PaintRoundRect($trect, 10, 10);
    #EraseRoundRect(OffsetRect($trect, $t->{xv} > 0 ? -$twid : $twid,
0), 10, 10);
    EraseRoundRect(Rect->new($t->{xv} > 0 ? (
      $trect->left - (9 + $t->{xv}), $trect->top,
      $trect->left, $trect->bottom,
    ) : (
      $trect->right, $trect->top,
      $trect->right + (9 + -$t->{xv}), $trect->bottom,
    )), 10, 10);

    $t->{rect} = OffsetRect($trect, $t->{xv}, $t->{yv});
 
    if ($t->{rect}->right > $bw or $t->{rect}->left < 0) {
      $t->{xv} *= -1;
    }
  }
}

for (1..10) {WaitNextEvent}

$tick = 0;
$done = 0;
while (!$done) {
  ++$tick;
  SetPort $win->window;

  if ($Mouse xor (my $b = Button())) {
    $Mouse = $b;
    if ($b and not keys %shots >= $maxshots) {
      my $pt = GetMouse();
      my ($mx, $my) = ($pt->h, $pt->v);

      fire($mx / $bw * 5 * $vel_mult, ($bh-$my) / $bh * 8 * $vel_mult);
    }
  }

  Run_Shots();
  Run_Targets();
  RGBForeColor($cwhite);
  PaintOval($canrect);
  if ($OScore != $Score) {
    $OScore = $Score;
    EraseRect(new Rect(0, 0, 50, 15));
    MoveTo(1, 12);
    DrawString sprintf '%.0f', $Score;
  }
 
  FlushEvents(mouseDown + mouseUp, keyDown);
  WaitNextEvent unless $tick % $system_time;
}

__END__

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