Re: [MacPerl] CDP: Gradient

[kpreid@ibm.net (Kevin Reid)]

> Another wowser!
> 
> Anyone else get this:
> # Jeff-HD:*Jeff:MacPerl Ÿ:gradient.pl syntax OK
> # Use of uninitialized value.
> File 'Jeff-HD:*Jeff:MacPerl Ÿ:lib:Mac:LowMem.pm'; Line 533

Well, I never syntax-checked it. This bug will also cause your
MacPerl menu bar to become un-clickable.

Here is a fixed version that also has a few improvements:

#!perl -w

# Gradient v1.1
# 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.1
#   * Fixed bug in menu bar hiding code
#   * Minor tweak to @Dirs
#   * Now provides chance to cancel mouse click
# 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 {
  my ($w, $pt) = @_;
  my $r = new Rect ($pt->h - 20, $pt->v - 20, $pt->h + 20, $pt->v + 20);
  my ($in, $oin) = (1, 1);
  InvertOval($r);
  ShowCursor();
  while (StillDown()) {
    $in = PtInRect(GetMouse, $r);
    if ($in != $oin) {
      InvertOval($r);
    } 
    $oin = $in;
    WaitNextEvent;
  }
  HideCursor();
  return unless $in;
  $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 % @Dirs]};

    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) if $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