[MacPerl] Isometric Ball

[kpreid@ibm.net (Kevin Reid)]

.#!perl -w

# Isometric Ball v1.0
# by Kevin Reid
#
# Version History
# 1.0
#   * Initial release

use strict;
use Mac::Windows;
use Mac::QuickDraw;
use Mac::Events;

use constant GRAV => 0.8;
use constant LOSS => 0.99;
use constant BOOSTVEL => 23;
use constant STRETCH => 0.577350269189626;

use constant BOXSIZE => 100;
use constant FRAMESIZE => 0;
use constant BORDER => 5;
use constant SYSTIME => 100;

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 ((0)x3);

use constant WINSIZE => BOXSIZE * 4 + BORDER * 2 + 1;
use constant WINRECT => new Rect (0, 0, WINSIZE - BOXSIZE / STRETCH / 4,
WINSIZE);

use vars qw(
  $GWindow
  %pos %oldpos %vel
  $tick
  $LeftPoly
  $RightPoly
  $BotPoly
);

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

  return (
    ($x - $z) / (1+STRETCH/4) + BOXSIZE*2 - BOXSIZE / STRETCH / 8 +
BORDER,
    -$y - ($x + $z) * (-0.5) + BOXSIZE*2 + BORDER
  );
}

sub DotAt {
  MoveTo(@_);
  LineTo(@_);
}

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

  InvertOval(new Rect($x-8, $y-8, $x+8, $y+8));
  InvertOval(new Rect($x-8, $y-8, $x+8, $y+8));
  InvertOval(new Rect($x-8, $y-8, $x+8, $y+8));
}

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

  BallAt(IsoFlatten(@cd{qw(x y z)}));

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

sub CalcPolys {

  $LeftPoly = OpenPoly;
  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;

  $RightPoly = OpenPoly;
  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;

  $BotPoly = OpenPoly;
  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;

  InvalRect(WINRECT);
}

sub CenterRect {
  my ($wrect) = @_;
  
  my $drect = GetMainDevice()->gdRect;
  return OffsetRect($wrect, (
    ($drect->right - $drect->left) / 2 - WINRECT->right / 2 +
$drect->left, 
    ($drect->bottom - $drect->top) / 2 - WINRECT->bottom / 2 +
$drect->top
  ));
}

%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),

CalcPolys();

$GWindow = new MacColorWindow (
  CenterRect(WINRECT),
  'Ball',
  1, noGrowDocProc, 1,
);
$GWindow->sethook(drawgrowicon => sub {});
$GWindow->sethook(redraw => sub {
  PenMode(srcCopy);
  PenSize(FRAMESIZE,FRAMESIZE);

  RGBForeColor(C_BACKL);
  PaintPoly($LeftPoly);
  RGBForeColor(C_BACKR);
  PaintPoly($RightPoly);
  RGBForeColor(C_BACKB);
  PaintPoly($BotPoly);

  RGBForeColor(C_LINES);
  FramePoly($LeftPoly);
  FramePoly($RightPoly);
  FramePoly($BotPoly);

  MoveTo(IsoFlatten(BOXSIZE, BOXSIZE, - BOXSIZE   ));
  LineTo(IsoFlatten(BOXSIZE, BOXSIZE, - BOXSIZE+10));

  MoveTo(IsoFlatten(- BOXSIZE,    BOXSIZE, BOXSIZE));
  LineTo(IsoFlatten(- BOXSIZE+10, BOXSIZE, BOXSIZE));

  MoveTo(IsoFlatten(BOXSIZE, - BOXSIZE,    BOXSIZE));
  LineTo(IsoFlatten(BOXSIZE, - BOXSIZE+10, BOXSIZE));

  PenMode(srcXor);

  DrawObject(%pos);
});
SetPort $GWindow->window;
PenNormal;
RGBBackColor(C_EMPTY);

WaitNextEvent;
WaitNextEvent;
WaitNextEvent;

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

  SetPort $GWindow->window;
  foreach (qw(x y z)) {
    my $did = 0;

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

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

  $vel{'y'} -= GRAV;

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

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

-- 
 Kevin Reid: |    Macintosh:      
  "I'm me."  | Think different.
    

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