[Date Prev][Date Next][Thread Prev][Thread Next] [Search] [Date Index] [Thread Index]

[MacPerl] Presenting MPFE



#!perl -w

# MacPerl Fractal Explorer (MPFE) v1.0
# by Kevin Reid <kpreid@ibm.net>
# 
# Requires MacPerl 5.2.1a1 or later and "19-May-98
# versions of QuickDraw and QDOffscreen"
#
# Click on the "?" button for help.
#
# Suggestions for additional fractals to add are welcome.
#
# Version History
# 1.0
#   * Initial release, based on Col_Z^3 (GWorld) v1.1

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

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

  $CurRow $Drawn $ShowSteps
  $ViewX $ViewY $ViewMag

  $ImgWidth $ImgHeight
  $ImgRect

  @Calcs $CalcSub $CurCalc $CalcMenu

  $HelpMode @HelpText
);

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

sub Interlace () {10}
sub Background () {new RGBColor((0)x3)}
sub Foreground () {new RGBColor((65535)x3)}
sub InfoHeight () {16}
sub InfoButWidth () {16}
sub InfoButCount () {4}
sub InfoButTotal () {InfoButWidth * InfoButCount}
sub InfoButLabels () {"?RDE"}
sub InfoCLight () {new RGBColor((65535)x3)}
sub InfoCMed () {new RGBColor((56797)x3)}
sub InfoCDark () {new RGBColor((43690)x3)}
sub InfoCText () {new RGBColor((0)x3)}

@HelpText = split /\n/, <<'EOH';
MPFE - MacPerl Fractal Explorer

Click on the image to zoom in on a point. Option-click to zoom out.

The "R" button resets the view position and magnification.
The "D" button controls whether the image will be drawn while it is being generated.
Note: The info bar will not update when drawing is off.
The "E" button lets you look at a different fractal. If you hold down the Command
key, the position/magnification will not be reset.





(Oh, and yes, I know that Col_Z^3 isn't a true fractal.)
EOH

$ImgWidth = 400;
$ImgHeight = 300;
$ImgRect = ltwh(0, InfoHeight, $ImgWidth, $ImgHeight);

$Drawn = $CurRow = 0;
$ShowSteps = 1;
$HelpMode = 0;

@Calcs = (
  {
    'name' => 'Col_Z^3',
    'sub' => sub {
      my ($cr, $ci) = (0.5, 0);

      my ($j, $k) = @_;
      my ($a, $b, $c, $d, $z);
      $a = $j;
      $b = $k;
      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)}
    },
    'x' => 0,
    'y' => 0,
    'mag' => 50,
  },
  {
    'name' => 'Col_Z^3 Flat',
    'sub' => sub {
      my ($cr, $ci) = (0.5, 0);

      my ($j, $k) = @_;
      my ($a, $b, $c, $d, $z);
      $a = $j;
      $b = $k;
      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(65335, 0, 0)}
      elsif (abs($b) < 10) {return RGBColor->new(0, 65335, 0)}
      else                 {return RGBColor->new(0, 0, 65535)}
    },
    'x' => 0,
    'y' => 0,
    'mag' => 50,
  },
  {
    'name' => 'Col_Z^3 B&W',
    'sub' => sub {
      my ($cr, $ci) = (0.5, 0);

      my ($j, $k, $px, $py) = @_;
      my ($a, $b, $c, $d, $z);
      $a = $j;
      $b = $k;
      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((65335)x3)}
      elsif (abs($b) < 10) {return RGBColor->new(((($px + $py) % 2) ? 32768 : 0)x3)}
      else                 {return RGBColor->new((0)x3)}
    },
    'x' => 0,
    'y' => 0,
    'mag' => 50,
  },
  {'name' => '-('},
  {
    'name' => 'Mandelbrot B&W',
    'sub' => sub {
      my ($x, $y, $px, $py) = @_;
    
                my @value = (0.0, 0.0);
      my $ok = 1; 
                
                foreach my $i (1..20) {
                        @value = mset(@value, $x * .01, $y * .01); 
                        if (sqmag(@value) > 4.0) { $ok = 0; last; }
                }
                return new RGBColor ((65535*!$ok)x3); 
    },
    'x' => 0,
    'y' => 0,
    'mag' => 1,
  },
  {
    'name' => 'Mandelbrot Gray',
    'sub' => sub {
      my ($x, $y, $px, $py) = @_;
    
                my @value = (0.0, 0.0);
      my $time = 0; 
                
                foreach my $i (1..20) {
                        @value = mset(@value, $x * .01, $y * .01); 
                        if (sqmag(@value) > 4.0) { $time = $i; last; }
                }
                return new RGBColor (($time * (65535/20))x3); 
    },
    'x' => 0,
    'y' => 0,
    'mag' => 1,
  },
);

sub mset {
        my ($nr, $nc, $cr, $cc) = @_; 
        
        ($nr * $nr - $nc * $nc + $cr, 2.0 * $nr * $nc + $cc);  }

sub sqmag {
        my ($real, $cplx) = @_; 
        
        $real * $real + $cplx * $cplx;  }

$CalcMenu = new MacHierMenu 2000, '', (
  map {my $it = $_; [$Calcs[$it]{name} => sub {
    CheckItem($CalcMenu->{menu}, $CurCalc+1, 0);
    CheckItem($CalcMenu->{menu}, $it+1, 1);
    InitCalc($it, !($Mac::Events::CurrentEvent->modifiers & cmdKey));
  }]} 0..$#Calcs,
);
$CalcMenu->insert;

{
  my $srect = GetMainDevice()->gdRect;
  my $winrect = new Rect (0, 0, $ImgWidth, $ImgHeight + InfoHeight);
  $Window = new MacColorWindow (
    OffsetRect($winrect,
      $srect->left + ($srect->right - $srect->left - $winrect->right) / 2,
      $srect->top + ($srect->bottom - $srect->top - $winrect->bottom) / 2,
    ),
    '', 1, noGrowDocProc, 1);
  $Window->sethook(drawgrowicon => sub {});
}

($OrigP, $OrigD) = GetGWorld();
InitGWorld();
InitCalc(0, 1);
CheckItem($CalcMenu->{menu}, $CurCalc+1, 1);

$Window->sethook(redraw => sub {
  my ($win, $ibo) = @_;
  unless ($HelpMode) {
    LockPixels($PixMap) if $Drawn;
    CopyBits($GWorld->portBits, $Window->window->portBits,
             $GWorld->portRect, $Window->window->portRect, 0);
    UnlockPixels($PixMap) if $Drawn;
  } else {
    my $ibrect = new Rect (0, 0, $ImgWidth, InfoHeight);
    my $otrect = new Rect (0, InfoHeight, $ImgWidth, $ImgHeight + InfoHeight);
    TextFont(geneva); TextSize(9);
    my $v = InfoHeight;
    LockPixels($PixMap) if $Drawn;
    CopyBits($GWorld->portBits, $Window->window->portBits,
             $ibrect, $ibrect, 0);
    UnlockPixels($PixMap) if $Drawn;
    return if $ibo;
    RGBForeColor(Background);
    PaintRect($otrect);
    RGBForeColor(Foreground);
    foreach (@HelpText) {
      MoveTo 3, ($v += 11);
      DrawString $_;
    }
    RGBForeColor(Background);
  }
});
$Window->sethook(click => sub {
  my $pt = $_[1];
  if ($pt->v < InfoHeight) {
    InfoClick($pt);
    return 1;
  }
  return if $HelpMode;
  $ViewX = $ViewX + ($pt->h - $ImgWidth/2) / $ViewMag;
  $ViewY = $ViewY + ($pt->v - InfoHeight - $ImgHeight/2) / $ViewMag;
  $ViewMag = $ViewMag * (($Mac::Events::CurrentEvent->modifiers & optionKey) ? 1/3 : 3);
  ResetGWorld();
  1;
});
$Window->sethook(cursor => sub {
  SetCursor(($_[1]->v < InfoHeight or $HelpMode) ? 0 : crossCursor);
});

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

sub InitGWorld {
  UnlockPixels($PixMap)  if defined $PixMap;
  DisposeGWorld($GWorld) if defined $GWorld;

  $GWorld = NewGWorld(0, $Window->window->portRect);
  SetGWorld($GWorld);
  ($OffP, $OffD) = GetGWorld();
  $PixMap = GetGWorldPixMap($GWorld);
  LockPixels($PixMap);
  RGBBackColor(Background);
  EraseRect $GWorld->portRect;
}

sub DrawSome {
  SetGWorld($OffP, $OffD);
  my $y = ($CurRow*Interlace % $ImgHeight) + int($CurRow / ($ImgHeight/Interlace));
  for (my $x = 0; $x < $ImgWidth; $x++) {
    RGBForeColor CalcPt($x, $y);
    MoveTo $x, $y + InfoHeight;
    LineTo $x, $y + (Interlace - int($CurRow / ($ImgHeight/Interlace))) - 1 + InfoHeight;
  }
  UpdateInfoBar();
  $CurRow++; 

  SetGWorld($OrigP, $OrigD);
  SetPort $Window->window;
  #my $rect = new Rect (0, $y, $ImgWidth, $y+Interlace);
  #CopyBits($GWorld->portBits, $Window->window->portBits,
  #         $rect, $rect, 0);
  $Window->redraw(1) if $ShowSteps;

  if ($CurRow >= $ImgHeight) {
    $Drawn = 1;
    SetGWorld($OffP, $OffD);
    UpdateInfoBar();
    SetGWorld($OrigP, $OrigD);
    UnlockPixels($PixMap);
    SetPort $Window->window;
    $Window->redraw(1);
  }
}

sub CalcPt {
  my ($x, $y) = @_;
  return &$CalcSub(($x - $ImgWidth/2) / $ViewMag + $ViewX, ($y - $ImgHeight/2) / $ViewMag + $ViewY, $x, $y);
}

sub UpdateInfoBar {
  TextFont(systemFont); TextSize(0);
  RGBForeColor InfoCMed;
  PaintRect new Rect 1, 1, $ImgWidth - 1 - InfoButTotal, InfoHeight - 2;
  MoveTo (3, InfoHeight - 4);
  RGBForeColor InfoCText;
  DrawString
    sprintf ("X: %g, Y: %g, Mag: %d", $ViewX, $ViewY, $ViewMag)
     . ($Drawn ? '' : ", @{[sprintf '%3.1f', $CurRow/$ImgHeight*100]}%");
}

sub ResetGWorld {
  LockPixels($PixMap) if $Drawn;
  $CurRow = $Drawn = 0;
  SetGWorld($OffP, $OffD);
  EraseRect $GWorld->portRect;

  RGBForeColor InfoCMed;
  PaintRect new Rect 0, 0, $ImgWidth, InfoHeight - 1;
  RGBForeColor InfoCLight;
  MoveTo 0, InfoHeight - 2;
  LineTo 0, 0;
  LineTo $ImgWidth - 2 - InfoButTotal, 0;
  RGBForeColor InfoCDark;
  MoveTo 1, InfoHeight - 2;
  LineTo $ImgWidth - 1 - InfoButTotal, InfoHeight - 2;
  LineTo $ImgWidth - 1 - InfoButTotal, 1;

  TextFont(systemFont); TextSize(0);
  for (0..InfoButCount - 1) {
    my $ibleft = ($ImgWidth - InfoButTotal) + $_ * InfoButWidth;
    bevel($ibleft, 0, $ibleft + InfoButWidth, InfoHeight - 1);
    RGBForeColor InfoCText;
    my $label = substr(InfoButLabels, $_, 1);
    MoveTo ($ibleft + (InfoButWidth - StringWidth($label)) / 2, InfoHeight - 4);
    DrawString $label;
  }
  InvertRect(btnrect(0)) if $HelpMode;
  InvertRect(btnrect(2)) if $ShowSteps;
  
  SetGWorld($OrigP, $OrigD);
  SetPort $Window->window;
  $Window->redraw(1);
}

sub InfoClick {
  my ($pt) = @_;
  return if $pt->h < $ImgWidth - InfoButTotal;
  my $btn = int(($pt->h - ($ImgWidth - InfoButTotal)) / InfoButWidth);
  my $rect = btnrect($btn);
  if ($btn == 0) {
    return unless TrackRect($rect);
    $HelpMode = !$HelpMode;
    SetGWorld($OffP, $OffD);
    InvertRect($rect);
    SetGWorld($OrigP, $OrigD);
    SetPort $Window->window;
    $Window->redraw;
  } elsif ($btn == 1) {
    return unless TrackRect($rect);
    InitCalc(undef, 1);
  } elsif ($btn == 2) {
    return unless TrackRect($rect);
    $ShowSteps = !$ShowSteps;
    SetGWorld($OffP, $OffD);
    InvertRect($rect);
    SetGWorld($OrigP, $OrigD);
  } elsif ($btn == 3) {
    my $mp = LocalToGlobal(new Point ($rect->right - 8, $rect->top));
    InvertRect($rect);
    PopUpMenuSelect $CalcMenu->{menu}, $mp->v, $mp->h, $CurCalc + 1;
    InvertRect($rect);
  }
}

sub btnrect {
  my $ibleft = ($ImgWidth - InfoButTotal) + $_[0] * InfoButWidth;
  return new Rect($ibleft, 0, $ibleft + InfoButWidth, InfoHeight - 1);
}

sub TrackRect {
  my ($r) = @_;

  my ($in, $oin) = (1, 1);
  InvertRect($r);
  while (StillDown()) {
    $in = PtInRect(GetMouse, $r);
    if ($in != $oin) {
      InvertRect($r);
    } 
    $oin = $in;
  }
  $in;
}

sub bevel {
  my ($left, $top, $right, $bot) = @_;
  RGBForeColor InfoCLight;
  MoveTo $left, $bot - 2;
  LineTo $left, 0;
  LineTo $right - 2, 0;
  RGBForeColor InfoCDark;
  MoveTo $left + 1, $bot - 1;
  LineTo $right - 1, $bot - 1;
  LineTo $right - 1, $top + 1;
}

sub InitCalc {
  my ($num, $moveit) = @_;
  if (defined $num) {
    $CurCalc = $num;
    $CalcSub = $Calcs[$CurCalc]{'sub'};
    SetWTitle $Window->window, "MPFE: $Calcs[$CurCalc]{name}";
  }
  if ($moveit) {
    $ViewX = $Calcs[$CurCalc]{'x'};
    $ViewY = $Calcs[$CurCalc]{'y'};
    $ViewMag = $Calcs[$CurCalc]{mag};
  }
  ResetGWorld();
}

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

__END__

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