[MacPerl] CDP: Gradient

[kpreid@ibm.net (Kevin Reid)]

#!perl -w

# Gradient v1.0
# by Kevin Reid <kpreid@ibm.net>
#
# Run this in the highest color depth you can.
# To stop, click or press a key.
# 
# Version History
# 1.0
#   * Initial release

use strict;

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

use vars qw(
  $rScreen $rWindow
  $TheWindow
  $MBOldRgn $MBOldHeight
 
  $Done $Hog

  $Width $Height $CPMax
  $CurPos $Loop
  @Colors @Dirs

);

use constant COLOR_VEL_MAX => 600; # Maximum color-change speed.

use constant SPACING => 2; # Spacing of lines in one gradient.

use constant SYSTEM_FREQ => 011;   # Higher values give less time to
other
                                   # applications; the value must NOT be
                                   # divisible by SPACING.

$rScreen = GetWMgrPort->portRect;
$rWindow = OffsetRect $rScreen, $rScreen->left, $rScreen->top;
$Width = $rWindow->right;
$Height = $rWindow->bottom;
$CPMax = $Width + $Height;

$MBOldRgn = CopyRgn(GetGrayRgn());
RectRgn(GetGrayRgn, $rScreen);
#OpenRgn();
#FrameRoundRect($rScreen, 16, 16);
#CloseRgn GetGrayRgn;

$MBOldHeight = LMGetMBarHeight;
LMSetMBarHeight(0);
HideCursor();
DisableItem GetMenu 129;
DisableItem GetMenu 130;

$TheWindow = new MacColorWindow ($rScreen, 'Gradient', 1, dBoxProc, 1)
or die $^E;
$TheWindow->sethook(click => sub {$Done = 1});
$TheWindow->sethook(key   => sub {$Done = 1});
SetPort $TheWindow->window;
RGBBackColor(new RGBColor(0,0,0));
TextFont(0);

{my $i = 0; WaitNextEvent until $i++ > 10}


@Dirs = (
  sub {MoveTo(0, $CurPos);
       LineTo($CurPos, 0)},

  sub {MoveTo($Width - $CurPos, 0);
       LineTo($Width, $CurPos)},

  sub {MoveTo($Width, $Height - $CurPos);
       LineTo($Width - $CurPos, $Height)},

  sub {MoveTo(0, $Height - $CurPos);
       LineTo($CurPos, $Height)},
);

for ($Loop = 0; !$Done; $Loop++) {
  @Colors = map {{val => rand 65535, vel => rand COLOR_VEL_MAX}} qw(R G
B);

  for ($CurPos = $Loop % SPACING; $CurPos <= $CPMax and !$Done; $CurPos
+= SPACING) {
    unless ($CurPos % SYSTEM_FREQ) {
      WaitNextEvent;
      if (!EqualRgn($TheWindow->window->contRgn,
$TheWindow->window->visRgn)) {
        MoveTo(20, 30); RGBForeColor(new RGBColor((65535)x3));
        DrawString('Warning: Performance will be reduced because the
window is partially obscured');
      }
    }
    SetPort $TheWindow->window;

    RGBForeColor(new RGBColor(map {$_->{val}} @Colors));
    &{$Dirs[$Loop % 4]};

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

#WaitNextEvent until $Done;

END {
  LMSetMBarHeight($MBOldHeight);
  ShowCursor();
  EnableItem GetMenu 129;
  EnableItem GetMenu 130;

  if ($TheWindow) {
    SetPort $TheWindow->window;
    EraseRect($rWindow);
  }

  if ($MBOldRgn) {
    CopyRgn($MBOldRgn, GetGrayRgn);
    DisposeRgn $MBOldRgn;
  }

  $TheWindow->dispose if $TheWindow;
  # The window is disposed AFTER the GrayRgn is restored
  # so that the corners of the screen are frozen at black.
}

__END__

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