[MacPerl] 3D Ball

[kpreid@ibm.net (Kevin Reid)]

#!perl -w

# 3D Ball v2.0
# by Kevin Reid
#
# W, A, S and D and/or click & drag to rotate.
# + and - or control-drag to change scale.
# Tab key toggles polygon borders. 
# Escape key quits.
#
# Version History
# 2.0
#   * Added perspective, rotation & scaling
#   * Window now covers screen
#   * Changed name
#   * Added frames-per-second counter
# 1.0
#   * Initial release as "Isometric Ball"

use strict;
use Mac::Windows;
use Mac::QuickDraw;
use Mac::Events;
use Mac::Fonts qw(systemFont);
use Math::Trig qw(deg2rad);

use vars qw(
  $ScrnRect
  $Mods
  $GWindow
  %pos %oldpos %vel
  $tick
  @Polygons
  $ObscureRgn
  $otime $otick $ptick
  %Multipliers
  $frame_size
  $rot $pitch
  $distort
  $mouse
  $oldmouse
  $downflag
  $scale
);

use constant GRAV => 0.8;
use constant LOSS => 0.99;
use constant BOOSTVEL => 23;
use constant DISTORT => 700;

use constant BOXSIZE => 100;
use constant SYSTIME => 100;

use constant ROTSTEP => 360 / 64;
use constant PITCHSTEP => 360 / 64;

use constant C_EMPTY => new RGBColor (50000, 50000, 65535);
use constant C_BACKL => new RGBColor ((47000)x3);
use constant C_BACKR => new RGBColor ((50000)x3);
use constant C_BACKB => new RGBColor ((49000)x3);
use constant C_LINES => new RGBColor ((40000)x3);

BEGIN {
  $ScrnRect = GetMainDevice()->gdRect;
  $ScrnRect->top($ScrnRect->top + 20);
}
use constant WINSIZEH => $ScrnRect->right - $ScrnRect->left; #BOXSIZE *
3.5 + 1;
use constant WINSIZEV => $ScrnRect->bottom - $ScrnRect->top; #BOXSIZE *
3.5 + 1;
use constant WINRECT => new Rect (0, 0, WINSIZEH, WINSIZEV);

sub CalcRot {
  my $rotr = deg2rad($rot);
  my $pitr = deg2rad($pitch);
  %Multipliers = (
    'x' => {'x' => sin($rotr), 'y' => 0, 'z' => cos($rotr)},
    'y' => {'x' => cos($pitr) * cos($rotr), 'y' => sin($pitr), 'z' =>
cos($pitr) * -sin($rotr)},
    'z' => {'x' => -sin($pitr) * cos($rotr), 'y' => cos($pitr), 'z' =>
-sin($pitr) * -sin($rotr)},
  );
  CalcPolys();
}

sub IsoFlatten {
  my ($x, $y, $z) = @_;

  my $rz = Rotate_Z(@_) + $distort;
 
  return (
    ($x * $Multipliers{'x'}{'x'} + $y * $Multipliers{'x'}{'y'} + $z *
$Multipliers{'x'}{'z'}) / $rz * $distort * $scale + WINSIZEH/2,
    ($x * $Multipliers{'y'}{'x'} + $y * $Multipliers{'y'}{'y'} + $z *
$Multipliers{'y'}{'z'}) / $rz * $distort * $scale + WINSIZEV/2,
  );
}

sub Rotate_Z {
  my ($x, $y, $z) = @_;

  return $x * $Multipliers{'z'}{'x'} + $y * $Multipliers{'z'}{'y'} + $z
* $Multipliers{'z'}{'z'};
}

sub DotAt {
  PenSize((2.5 * $scale) x 2);
  MoveTo(@_);
  LineTo(@_);
}

sub BallAt {
  my ($x, $y, $siz) = @_;

  $siz *= $scale;
  InvertOval(new Rect($x-$siz, $y-$siz, $x+$siz, $y+$siz));
}

sub DrawObject {
  my (%cd) = @_;
  SetClip($ObscureRgn);

  if ($cd{z} == 0) {
    BallAt(IsoFlatten(@cd{qw(x y z)}), 8);
  } else {
    BallAt(IsoFlatten(@cd{qw(x y z)}), 8 * $distort / (Rotate_Z(@cd{qw(x
y z)}) + $distort));
  }

  PenSize(2,2);
  DotAt(IsoFlatten(@cd{qw(x y)}, - BOXSIZE * .98));
  DotAt(IsoFlatten(- BOXSIZE * .98, (@cd{qw(y z)})));
  DotAt(IsoFlatten($cd{'x'}, - BOXSIZE * .98, $cd{z}));
  ClipRect(WINRECT);
}

sub GenPoly {
}

sub CalcPolys {

  my $poly;
  foreach (@Polygons) {
    KillPoly $_->{poly};
  }
  @Polygons = ();

  $poly = OpenPoly; # left poly
  MoveTo(IsoFlatten(- BOXSIZE, - BOXSIZE, - BOXSIZE));
  LineTo(IsoFlatten(- BOXSIZE, - BOXSIZE,   BOXSIZE));
  LineTo(IsoFlatten(- BOXSIZE,   BOXSIZE,   BOXSIZE));
  LineTo(IsoFlatten(- BOXSIZE,   BOXSIZE, - BOXSIZE));
  LineTo(IsoFlatten(- BOXSIZE, - BOXSIZE, - BOXSIZE));
  ClosePoly;
  push @Polygons, {poly => $poly, depth => Rotate_Z(- BOXSIZE, 0, 0),
color => C_BACKL};

  $poly = OpenPoly; # right poly
  MoveTo(IsoFlatten(- BOXSIZE, - BOXSIZE, - BOXSIZE));
  LineTo(IsoFlatten(- BOXSIZE,   BOXSIZE, - BOXSIZE));
  LineTo(IsoFlatten(  BOXSIZE,   BOXSIZE, - BOXSIZE));
  LineTo(IsoFlatten(  BOXSIZE, - BOXSIZE, - BOXSIZE));
  LineTo(IsoFlatten(- BOXSIZE, - BOXSIZE, - BOXSIZE));
  ClosePoly;
  push @Polygons, {poly => $poly, depth => Rotate_Z(0, 0, - BOXSIZE),
color => C_BACKR};

  $poly = OpenPoly; # bottom poly
  MoveTo(IsoFlatten(- BOXSIZE, - BOXSIZE, - BOXSIZE));
  LineTo(IsoFlatten(- BOXSIZE, - BOXSIZE,   BOXSIZE));
  LineTo(IsoFlatten(  BOXSIZE, - BOXSIZE,   BOXSIZE));
  LineTo(IsoFlatten(  BOXSIZE, - BOXSIZE, - BOXSIZE));
  LineTo(IsoFlatten(- BOXSIZE, - BOXSIZE, - BOXSIZE));
  ClosePoly;
  push @Polygons, {poly => $poly, depth => Rotate_Z(0, - BOXSIZE, 0),
color => C_BACKB};
  
  # use Data::Dumper; print Dumper \@Polygons;

  @Polygons = sort {$b->{depth} <=> $a->{depth}} @Polygons;
  DisposeRgn $ObscureRgn if $ObscureRgn;
  OpenRgn;
  FrameRect(WINRECT);
  foreach (@Polygons) {
    FramePoly($_->{poly}) if (!$_->{non}) and $_->{depth} < -15;
  }
  $ObscureRgn = CloseRgn;
  InsetRgn($ObscureRgn, 0, 0);

  InvalRect(WINRECT);
}

%pos    = ('x' => 0, 'y' => BOXSIZE - 10, 'z' => 0),
%oldpos = ('x' => 0, 'y' => BOXSIZE - 10, 'z' => 0),
%vel    = ('x' => rand 10, 'y' => 0, 'z' => rand 10),
$otime = 0; $otick = 0; $ptick = '';

$rot = 135;
$pitch = 225;
$frame_size = 1;
$distort = DISTORT;
$scale = 1;

CalcRot();
$mouse = GetMouse();

$GWindow = new MacColorWindow (
  $ScrnRect,
  'Ball',
  1, plainDBox, 1,
);
$GWindow->sethook(drawgrowicon => sub {});
$GWindow->sethook(click => sub {$Mods =
$Mac::Events::CurrentEvent->modifiers; $downflag = 1});
$GWindow->sethook(redraw => sub {
  PenMode(srcCopy);
  PenSize($frame_size,$frame_size);

  foreach (@Polygons) {
    RGBForeColor($_->{color});
    PaintPoly($_->{poly});
    RGBForeColor(C_LINES);
    FramePoly($_->{poly});
  }

  PenMode(srcXor);

  MoveTo(1, 10);
  DrawString($ptick);
  MoveTo(1, 22);
  DrawString("Rot: $rot");
  MoveTo(1, 34);
  DrawString("Tilt: $pitch");

  DrawObject(%pos);
});
$GWindow->sethook(key => sub {
  my ($win, $key) = @_;
  $key = lc chr $key;
  my $updt = 1;

  my $rs = ((abs $pitch % 360) > 180) ? ROTSTEP / $scale : - ROTSTEP /
$scale;
  &{{
    'a' => sub {$rot += $rs},
    'd' => sub {$rot -= $rs},
    'w' => sub {$pitch += PITCHSTEP / $scale},
    's' => sub {$pitch -= PITCHSTEP / $scale},
    "\t" => sub {$frame_size *= -1},
    "\c[" => sub {$GWindow->dispose},
    '+' => sub {$scale *= 1.1},
    '-' => sub {$scale /= 1.1},
  }->{$key} || sub {$updt = 0}};
  if ($updt) {
    CalcRot();
    $rot = $rot - 360 if $rot >= 360;
    $rot = $rot + 360 if $rot < 0;
    $pitch = $pitch - 360 if $pitch >= 360;
    $pitch = $pitch + 360 if $pitch < 0;
  }
});
SetPort $GWindow->window;
PenNormal;
RGBBackColor(C_EMPTY);
TextMode(srcXor);
TextFont(systemFont);

WaitNextEvent;
WaitNextEvent;
WaitNextEvent;

$tick = 0;
while ($tick++, $GWindow->window) {

  SetPort $GWindow->window;

  $oldmouse = $mouse;
  $mouse = GetMouse;
  if ($downflag) {
    if ($oldmouse->h != $mouse->h or $oldmouse->v != $mouse->v) {
      my $xdiff = $mouse->h - $oldmouse->h;
      my $ydiff = $mouse->v - $oldmouse->v;
      if ($Mods & controlKey) {
        $scale += $ydiff / 60;
        $scale = .1 if $scale < .1;
        $scale = 4 if $scale > 4;
      } else {
        if ((abs $pitch % 360) > 180) {$rot -= ($xdiff) * .5}
                                 else {$rot += ($xdiff) * .5}
        $pitch -= ($ydiff) * .5;
      }
      $rot = $rot - 360 if $rot >= 360;
      $rot = $rot + 360 if $rot < 0;
      $pitch = $pitch - 360 if $pitch >= 360;
      $pitch = $pitch + 360 if $pitch < 0;
      CalcRot();
    }
    $downflag = Button();
  }

  foreach (qw(x y z)) {
    my $did = 0;

    $oldpos{$_} = $pos{$_};
    $pos{$_} += $vel{$_};
    if ($pos{$_} < - BOXSIZE +9) {
      $vel{$_} *= - LOSS;
      $pos{$_} = - BOXSIZE +9;
      $did = 1;
    }
    if ($pos{$_} > BOXSIZE -9) {
      $vel{$_} *= - LOSS;
      $pos{$_} = BOXSIZE -9;
    #  $did = 1;
    }
    if ($did and abs($vel{$_}) < 1) {
      $vel{$_} = BOOSTVEL;
    } 
  }

  DrawObject(%oldpos);
  DrawObject(%pos);

  $vel{'y'} -= GRAV;

  if ($otime != time) {
    $otime = time;
    MoveTo(1, 10);
    DrawString($ptick);
    $ptick = 'FPS: ' . ($tick - $otick);
    MoveTo(1, 10);
    DrawString($ptick);
    $otick = $tick;
  }

  WaitNextEvent unless $tick % (101 - SYSTIME);
}

END {
  $GWindow->dispose if $GWindow;
}
__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