Re: [MacPerl] Under the microscope...

[kpreid@ibm.net (Kevin Reid)]

Alan Fry <ajf@afco.demon.co.uk>, 14 months and 9 days ago, wrote:

> Tha attached scipt Col_Z^3.pl draws some fairly alarming looking bugs
> which can be viewed at various magnifications in full frightening colour.
> It would be nicer (from the point of view of updating the window) to do
> the drawing off-screen.

Better late than never, right?

#!perl -w

# Col_Z^3 (GWorld version)
# by Kevin Reid <kpreid@ibm.net>
# Original by Alan Fry
# 
# Requires MacPerl 5.2.1a1 or later.

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

use vars qw(
  $Window
  $OrigP $OffP
  $OrigD $OffD
  $GWorld
  $PixMap

  $CurRow $Drawn
);

sub ltwh {new Rect ($_[0], $_[1], $_[0] + $_[2], $_[1] + $_[3])}

sub Width () {450}
sub Height () {450}

$Drawn = $CurRow = 0;

my $cr = 0.5;
my $ci = 0;
my $mag = 10;
$mag = 1 if $mag < 1;

$Window = new MacColorWindow (ltwh(100, 100, Width, Height),
  "GWorld", 1, noGrowDocProc, 1);
$Window->sethook(drawgrowicon => sub {});

($OrigP, $OrigD) = GetGWorld();
$GWorld = NewGWorld(0, $Window->window->portRect);
SetGWorld($GWorld);
($OffP, $OffD) = GetGWorld();
$PixMap = GetGWorldPixMap($GWorld);
LockPixels($PixMap);
RGBBackColor(new RGBColor(0,0,0));
EraseRect $GWorld->portRect;

$Window->sethook(redraw => sub {
  CopyBits($GWorld->portBits, $Window->window->portBits,
           $GWorld->portRect, $Window->window->portRect, 0);
});

while ($Window->window) {
  DrawSome() unless $Drawn;
  WaitNextEvent;
}

sub DrawSome {
  SetGWorld($OffP, $OffD);
  for (my $x = 0; $x < Width; $x++) {
    SetCPixel($x, $CurRow,
       CalcPt($x, $CurRow));
  }
  $CurRow++;
  $Drawn = 1 if $CurRow > Height;

  SetGWorld($OrigP, $OrigD);
  SetPort $Window->window;
  $Window->redraw;
}

sub CalcPt {
  my ($j, $k) = @_;
  my ($a, $b, $c, $d, $z);
  $a = (0.06*$j-13.5)/$mag;
  $b = (0.06*$k-13.5)/$mag;
  for (1..10) {
    $c = ($a*$a - 3*$b*$b)*$a+$cr;
    $d = (3*$a*$a - $b*$b)*$b+$ci;
    $a = $c;
    $b = $d;
    $z = $a*$a + $b*$b;
    last if $z > 100;
  }
  my $int = 1.45 - 0.09772*log($z);
  $int = 0 if $int < 0;
  if    (abs($a) < 10) {return RGBColor->new((1-abs($a)/10)*65335, 0, 0)}
  elsif (abs($b) < 10) {return RGBColor->new(0, (1-abs($b)/10)*65335, 0)}
  else                 {return RGBColor->new(0, 0, $int*65535)}
}

END {
   $Window->dispose       if defined $Window;
   UnlockPixels($PixMap)  if defined $PixMap;
   DisposeGWorld($GWorld) if defined $GWorld;
}

__END__


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

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