#!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