granicus.if.org Git - imagemagick/blob - PerlMagick/demo/lsys.pl

   1 #!/usr/bin/perl
   2
   3 # Written by jreed@itis.com, adapted by John Cristy.
   4
   5 use Image::Magick;
   6 use Turtle;
   7
   8 sub flower
   9 {
  10   my $flower = shift;
  11   my ($width, $height) = $flower->Get('width', 'height');
  12   my ($x, $y) = $turtle->state();
  13   my ($geometry);
  14
  15   $geometry = '+' . int($x-$width/2) . '+' . int($y-$height/2);
  16   $im->Composite(image=>$flower, compose=>'over', geometry=>$geometry);
  17 }
  18
  19 sub lsys_init
  20 {
  21   my ($imagesize) = @_;
  22
  23   %translate =
  24   (
  25     'S' => sub{ # Step forward
  26                 $turtle->forward($changes->{"distance"},
  27                 $changes->{"motionsub"});
  28               },
  29     '-' => sub{ $turtle->turn(-$changes->{"dtheta"}); },  # counter-clockwise
  30     '+' => sub{ $turtle->turn($changes->{"dtheta"}); },  # Turn clockwise
  31     'M' => sub{ $turtle->mirror(); },  # Mirror
  32     '[' => sub{ push(@statestack, [$turtle->state()]); },  # Begin branch
  33     ']' => sub{ $turtle->setstate(@{pop(@statestack)}); },  # End branch
  34     '{' => sub{ @poly = (); $changes=\%polychanges; },  # Begin polygon
  35     '}' => sub{ # End polygon
  36                 $im->Draw (primitive=>'Polygon', points=>join(' ',@poly),
  37                            fill=>'light green');
  38                 $changes = \%stemchanges;
  39               },
  40     'f' => sub{ flower($pink_flower); },  # Flower
  41     'g' => sub{ flower($red_flower); },  # Flower
  42     'h' => sub{ flower($yellow_flower); }  # Flower
  43   );
  44
  45   # Create the main image
  46   $im = new Image::Magick;
  47   $im->Set(size=>$imagesize . 'x' . $imagesize);
  48   $im->Read('xc:white');
  49
  50   # Create the flower images
  51   $pink_flower = new Image::Magick;
  52   $pink_flower->Read('pink_flower.gif');
  53
  54   $red_flower = new Image::Magick;
  55   $red_flower->Read('red_flower.gif');
  56
  57   $yellow_flower = new Image::Magick;
  58   $yellow_flower->Read('yellow_flower.gif');
  59
  60   # Turtle:  the midpoint of the bottom edge of the image, pointing up.
  61   $turtle=new Turtle($imagesize/2, $imagesize, 0, 1);
  62 }
  63
  64 sub lsys_execute
  65 {
  66   my ($string, $repetitions, $filename, %rule) = @_;
  67
  68   my ($command);
  69
  70   # Apply the %rule to $string, $repetitions times.
  71   for (1..$repetitions)
  72   {
  73     $string =~ s/./defined ($rule{$&}) ? $rule{$&} : $&/eg;
  74   }
  75   foreach $command (split(//, $string))
  76   {
  77     if ($translate{$command}) { &{$translate{$command}}(); }
  78   }
  79   $im->Write($filename);
  80   $im->Write('win:');
  81 }
  82
  83 1;