pastebin - collaborative debugging

pastebin is a collaborative debugging tool allowing you to share and modify code snippets while chatting on IRC, IM or a message board.

This site is developed to XHTML and CSS2 W3C standards. If you see this paragraph, your browser does not support those standards and you need to upgrade. Visit WaSP for a variety of options.

Perl pastebin - collaborative debugging tool View Help


Posted by SiD on Mon 24 Nov 16:56
report abuse | download | new post

  1. #!/usr/bin/perl
  2.  
  3. # Mandelbrot Set
  4. # Language: Perl
  5. # Author: SiD
  6.  
  7. use Math::Complex;
  8. use Tk;
  9.  
  10. $mx = -2; $my = -2;
  11. $nx = 2; $ny = 2;
  12.  
  13. $mw = MainWindow -> new(-background => "Black");
  14. $mw -> title("Mandelbrot Set Fractal ~ Author: SiD");
  15. $mw -> minsize(215, 195);
  16. $mw -> Label(
  17.                 -background   => "Black",
  18.                 -foreground   => "#00bfff",
  19.                 -text         => "Output image (name.ppm):"
  20.         ) -> pack(-anchor => "n");
  21. $mw -> Entry(
  22.                 -background   => "Black",
  23.                 -foreground   => "White",
  24.                 -textvariable => \$out
  25.         ) -> pack(-anchor => "n");
  26. $mw -> Label(
  27.                 -background   => "Black",
  28.                 -foreground   => "#00bfff",
  29.                 -text         => "Height:"
  30.         ) -> pack(-anchor => "n");
  31. $mw -> Entry(
  32.                 -background   => "Black",
  33.                 -foreground   => "White",
  34.                 -textvariable => \$alt
  35.         ) -> pack(-anchor =>"n");
  36. $mw -> Label(
  37.                 -background   => "Black",
  38.                 -foreground   => "#00bfff",
  39.                 -text         => "Width:"
  40.         ) -> pack(-anchor => "n");
  41. $mw -> Entry(
  42.                 -background   => "Black",
  43.                 -foreground   => "White",
  44.                 -textvariable => \$lar
  45.         ) -> pack(-anchor =>"n");
  46. $mw -> Label(
  47.                 -background   => "Black",
  48.                 -foreground   => "#00bfff",
  49.                 -text         => "Precision (ex -> 150):"
  50.         ) -> pack(-anchor => "n");
  51. $mw -> Entry(
  52.                 -background   => "Black",
  53.                 -foreground   => "White",
  54.                 -textvariable => \$precision
  55.         ) -> pack(-anchor => "n");
  56. $mw -> Label(
  57.                 -background   => "Black",
  58.                 -foreground   => "#00bfff",
  59.                 -text         => "Number of set (2-12):"
  60.         ) -> pack(-anchor => "n");
  61. $mw -> Entry(
  62.                 -background   => "Black",
  63.                 -foreground   => "White",
  64.                 -textvariable => \$sets
  65.         ) -> pack(-anchor => "n");
  66.  
  67. $mw -> Label(
  68.                 -background   => "Black",
  69.                 -foreground   => "White",
  70.                 -text         => "\nMandelbrot Set Fractal ~ Options\n"
  71.         ) -> pack(-anchor => "n");
  72. $vert = $mw -> Checkbutton(
  73.                 -text             => "Vertical Fractal?",
  74.                 -onvalue          => "Yes",
  75.                 -offvalue         => "No",
  76.                 -activebackground => "Black",
  77.             -activeforeground => "Orange",
  78.                 -background       => "Black",
  79.                 -foreground       => "Orange",
  80.         -variable         => \$how
  81.         ) -> pack(-anchor     => "sw");
  82. $mw -> Radiobutton(
  83.                 -text             => "Red Background",
  84.                 -value            => "Red",
  85.                 -activebackground => "Black",
  86.             -activeforeground => "Orange",
  87.                 -background       => "Black",
  88.                 -foreground       => "Orange",
  89.         -variable         => \$background
  90.         ) -> pack(-anchor => "sw");
  91. $mw -> Radiobutton(
  92.                 -text             => "Black Background",
  93.                 -value            => "Black",
  94.                 -activebackground => "Black",
  95.             -activeforeground => "Orange",
  96.                 -background       => "Black",
  97.                 -foreground       => "Orange",
  98.         -variable         => \$background
  99.         ) -> pack(-anchor => "sw");
  100.  
  101. $mw -> Button(
  102.                 -text             => "Generate Mandelbrot Set!",
  103.                 -font             => "Arial 8",
  104.                 -activebackground => "Black",
  105.                 -activeforeground => "Green",
  106.                 -background       => "Black",
  107.                 -foreground       => "Green",
  108.                 -command          =>
  109.  
  110. sub {
  111.  
  112.         if($out !~ /.ppm/) {
  113.                 $out = "mandelbrot.ppm";
  114.         }
  115.         if(!$background) {
  116.                 $background = "Black";
  117.         }
  118.         if(!$sets) {
  119.                 $sets = 2;
  120.         }
  121.         if($sets < 2 or $sets > 12) {
  122.                 $sets = 2;
  123.         }
  124.  
  125.         open(IMG, ">", $out) or $mw -> destroy;
  126.         print IMG "P3\n# Mandelbrot Set Fractal (Generator) ~ By SiD\n$alt $lar\n255\n";
  127.  
  128.         for($y=0; $y<$lar; $y++) {
  129.                 for($x=0; $x<$alt; $x++) {
  130.                         if($how) {
  131.                                 $a = $mx+($y*($ny-$my)/$alt);
  132.                                 $b = $my+($x*($nx-$mx)/$lar);
  133.                         }
  134.                         else {
  135.                                 $a = $mx+($x*($ny-$my)/$alt);
  136.                                 $b = $my+($y*($nx-$mx)/$lar);
  137.                         }
  138.  
  139.                         $comp = Math::Complex -> make($a, $b);
  140.                         $comp1 = $comp;
  141.  
  142.                         for($p=0; $p<$precision; $p++) {
  143.                                 $comp1 = $comp1**$sets+$comp;
  144.                                 if(abs($comp1) > 2) {
  145.                                         last;
  146.                                 }
  147.                         }
  148.                         _color($p);
  149.                 }
  150.                 if($^O =~ /MSWin32/) {
  151.                         system("cls");
  152.                         print $y+1 ." -> $lar";
  153.                 }
  154.                 else {
  155.                         system("clear");
  156.                         print $y+1 ." -> $lar";
  157.                 }
  158.         }
  159.  
  160.         sub _color() {
  161.                 my $element = shift;
  162.        
  163.                 if(abs($comp1) <= 2) {
  164.                         print IMG "0 0 0\n";
  165.                 }
  166.                 else {
  167.                         if($background eq "Black") {
  168.                                 $c1 = int((100+$p/4)/3);
  169.                         }
  170.                         else {
  171.                                 $c1 = int(100+$p/4);
  172.                         }
  173.                         $c2 = int($p/2)*8;
  174.                         $c3 = int(4*$p)*6;
  175.                         if ($c1 > 116) {
  176.                                 $c1 = 116;
  177.                         }
  178.                         if ($c2 > 205) {
  179.                                 $c2 = 205;
  180.                         }
  181.                         if ($c3 > 255) {
  182.                                 $c3 = 255;
  183.                         }
  184.                         print IMG "$c1 $c2 $c3\n";
  185.                 }
  186.         }
  187.  
  188.         sleep(1);
  189.         $mw -> messageBox(
  190.                         -message => "Done. \"$out\" created successfully!",
  191.                         -type    => "Ok"
  192.                 );
  193.         $mw -> destroy();
  194.  
  195. }) -> pack(-side => "bottom");
  196.        
  197. MainLoop;

Submit a correction or amendment below (click here to make a fresh posting)
After submitting an amendment, you'll be able to view the differences between the old and new posts easily.

Syntax highlighting:

To highlight particular lines, prefix each line with @@


Remember me so that I can delete my post