[MacPerl] CDP: Orbit Scribbler

[kpreid@attglobal.net (Kevin Reid)]

#!perl -w

# Orbit Scribbler v1.0
# by Kevin Reid <kpreid@ibm.net>
#
# Draws random colorful shapes in a window.
# Click for another one.
# 
# Version History
# 1.0
#   * Initial release

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

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

$color_vel_max = 100;
$shapes = 4;
$system_time = 40;

$win = new MacColorWindow (
  new Rect (50, 50, 450, 450),
  'Orbit Scribbles',
  1,
  documentProc,
  1,
);
$win->sethook('drawgrowicon', sub {});
$win->sethook(click => sub {
  newshapes();
});
$win->sethook(layout => sub {
  $bw = $win->window->portRect->right;
  $bh = $win->window->portRect->bottom;
  EraseRect $win->window->portRect;
});
SetPort $win->window;
PenSize(1, 1);
RGBBackColor(new RGBColor(0,0,0));
$win->layout();
newshapes();

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

sub newshapes {
  @shapes = ();
  for (1..(rand($shapes) + 1)) {
    push @shapes, {
      xp => $bw/2,
      yp => $bh/2,
      xv => int rand ($bw/20),
      yv => int rand ($bw/20),
      col => getcolor(),
      style => int rand 2,
    };
  }
  EraseRect $win->window->portRect;
}

for (1..20) {WaitNextEvent;}

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

  foreach $s (@shapes) {
    RGBForeColor(new RGBColor( map {$_->{val}} @{$s->{col}} ));
    FrameOval(ltwh($s->{xp} - 10, $s->{yp} - 10, 20, 20)) if $s->{style} == 0;
    MoveTo($s->{xp}, $s->{yp}) if $s->{style} == 1;

    $s->{xp} += $s->{xv};
    $s->{xv} += $s->{xp} != int($bw/2) ? ($s->{xp} > $bw/2 ? -1 : 1) : 0;
    $s->{yp} += $s->{yv};
    $s->{yv} += $s->{yp} != int($bw/2) ? ($s->{yp} > $bh/2 ? -1 : 1) : 0;

    LineTo($s->{xp}, $s->{yp}) if $s->{style} == 1;

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

  unless ($tick % $system_time) {
    WaitNextEvent(0);
  }
}

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

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