[Date Prev][Date Next][Thread Prev][Thread Next] [Search] [Date Index] [Thread Index]
[MacPerl] 3D Ball 2.1

To: macperl@macperl.org (MacPerl List)
Subject: [MacPerl] 3D Ball 2.1
From: kpreid@ibm.net (Kevin Reid)
Date: Sat, 22 May 1999 08:28:05 -0400
Organization: Reid & Hoffman
#!perl -w

# 3D Ball v2.1
# 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.
# Tilde key freezes ball.
# Spacebar toggles automatic rotation.
# Escape key quits.
#
# Best viewed in thousands of colors or 256 grays.
#
# Version History
# 2.1
#   * Added flicker-free drawing
#   * Added auto-rotate
#   * Added ball freezing
#   * Fixed passing of -1 to PenSize() which may have caused freeze under 8.6
#   * Added complete wireframe
#   * Added current scale to upper-left corner
#   * Changed keyboard rotation increments to avoid "312.4573984..."
#   * No longer ignores menu keyboard equivalents
# 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 $noball
  $tick
  @Polygons
  $ObscureRgn
  $otime $otick $ptick
  %Multipliers
  $frame_size $autospin $frozen
  $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 ROTSTEP => 5;
use constant PITCHSTEP => 5;

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;
use constant WINSIZEV => $ScrnRect->bottom - $ScrnRect->top;
use constant WINRECT => new Rect (0, 0, WINSIZEH, WINSIZEV);

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

  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 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; # left-ow 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 => undef};

  $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; # right-ow 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 => undef};

  $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 ($_->{color}) and $_->{depth} < -15;
  }
  $ObscureRgn = CloseRgn;

  OpenRgn;
  FrameRect(WINRECT);
  my $allRgn = CloseRgn;
  foreach (@Polygons) {
    OpenRgn;
    FramePoly($_->{poly}) if ($_->{color});
    my $polyRgn = CloseRgn;
    my $newRgn = DiffRgn $allRgn, $polyRgn;
    DisposeRgn $allRgn;
    DisposeRgn $polyRgn;
    $allRgn = $newRgn;
  }

  if ($GWindow and $GWindow->window) {
    SetPort $GWindow->window;
    SetClip $allRgn;
    EraseRect(WINRECT);
    ClipRect(WINRECT);
    $GWindow->redraw;
  }
  DisposeRgn $allRgn;
}

%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 = 235;
$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);

  if ($frame_size) {
    foreach (@Polygons) {
      if ($_->{color}) {
        RGBForeColor($_->{color});
        PaintPoly($_->{poly});
      }
      RGBForeColor(C_LINES);
      FramePoly($_->{poly});
    }
  } else {
    OpenRgn;
    FrameRect(WINRECT);
    my $allRgn = CloseRgn;

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

      OpenRgn;
      FramePoly($_->{poly}) if ($_->{color});
      my $polyRgn = CloseRgn;
      my $newRgn = DiffRgn $allRgn, $polyRgn;
      DisposeRgn $allRgn;
      DisposeRgn $polyRgn;
      $allRgn = $newRgn;

      SetClip $allRgn;
    }
    ClipRect(WINRECT);
    DisposeRgn $allRgn;
  }

  PenMode(srcXor);

  MoveTo(1, 10);
  DrawString($ptick);
  MoveTo(1, 22); DrawString(sprintf("Rot: %-.1f", $rot));
  MoveTo(1, 34); DrawString(sprintf("Tilt: %-.1f", $pitch));
  MoveTo(1, 46); DrawString(sprintf("Scale: %-.2f", $scale));

  if ($frozen) {
    DrawObject(%pos);
  } else {
    $noball = 1;
  }
});
$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 = $frame_size ? 0 : 1},
    ' ' => sub {$autospin = !$autospin; $updt = 0},
    '`' => sub {$frozen = !$frozen; $updt = 0},
    "\c[" => sub {$GWindow->dispose},
    '+' => sub {($scale *= 1.1) += .001},
    '-' => 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;
  }
  $updt;
});
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();
  }

  if (!$frozen) {
    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;
      }
      if ($did and abs($vel{$_}) < 1) {
        $vel{$_} = BOOSTVEL;
      }
    } 
    
    if ($noball) {$noball = 0}
            else {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;
  }

  unless (!$autospin) {
    $rot += 2;
    $pitch += .5;
    CalcRot();
  }

  WaitNextEvent;
}

END {
  $GWindow->dispose if $GWindow;
}

__END__

===== Want to unsubscribe from this list?
===== Send mail with body "unsubscribe" to macperl-request@macperl.org
Follow-Ups:
- Re: [MacPerl] 3D Ball 2.1
  - From: "Axel M. Roest" <axel@simplex.nl>
Prev by Date: Re: [MacPerl] Sorting Arrays
Next by Date: [MacPerl] Mac::Glue 19990522 Available
Prev by thread: [MacPerl] Mac::Glue 19990522 Available
Next by thread: Re: [MacPerl] 3D Ball 2.1
Navigation: Date Index | Thread Index | Search | Other lists at bumppo.net