[MacPerl] Volve

[kpreid@ibm.net (Kevin Reid)]

#!perl -w

# Volve v1.0
# by Kevin Reid <kpreid@ibm.net>
#
# Slowly changing colors.
#
# This program may be freely distributed, and you may
# use code from it, as long as my name stays on it.

# Revision history
# 
# 1.0
#   First release.

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

# Try changing these: 
  sub Width () {100}  # width of window
  sub Height () {200} # height of window
  sub WobbleAmp () {2}   # horizontal wobble parameters
  sub WobbleFreq () {1}
  sub Scroll () {-1} # scroll speed and direction

sub CThird () {65535 / 3}
sub DrawPos () {Scroll < 0 ? Height - 1 : 0} # where in window to draw new iterations

sub ltwh {new Rect ($_[0], $_[1], $_[0] + $_[2], $_[1] + $_[3])}
  # for specifying rectangles as left, top, width, height

$win = new MacColorWindow (ltwh(200, 150, Width, Height), "Volve",
  1, noGrowDocProc, 1);
$win->sethook(drawgrowicon => sub {}); # eliminate fake grow box
SetPort $win->window;
RGBBackColor(new RGBColor(0,0,0)); # set black background

# initialization
@set = (0) x Width;
$wrect = new Rect (0, 0, Width, Height); # rectangle to scroll
$junkrgn = NewRgn; # dummy for ScrollRect

for ($time = 0; $win->window; $time++, WaitNextEvent) {
  for ($d = 1; $d < Width - 1; $d++) {
    my $avg = ($set[$d-1] + $set[$d] + $set[$d+1]) / 3;
      # average of nearby values
    my $diff = $avg - $set[$d];
      # difference between average and current value
    my $change = $diff * .4 + (rand > .995 ? (rand() - .5) * 40 : 0);
      # amount to change value by
    $set[$d] += $change;
  }
  SetPort $win->window;
  ScrollRect($wrect, sin($time / WobbleFreq) * WobbleAmp, Scroll, $junkrgn);
    # scroll display up

  for ($d = 0; $d < Width; $d++) {
    # anyone know a better-looking color mapping function?
    my $cv = $set[$d] * 6553;
    SetCPixel $d, DrawPos, new RGBColor (
      ($cv) % 65535,
      ($cv + CThird) % 65535,
      ($cv + CThird*2) % 65535,
    );
  }
}

END {$win->dispose}

__END__

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

***** Want to unsubscribe from this list?
***** Send mail with body "unsubscribe" to mac-perl-request@iis.ee.ethz.ch