1#!/usr/bin/perl 2 3# Written by jreed@itis.com, adapted by Cristy. 4 5use Image::Magick; 6use Turtle; 7 8sub 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 19sub 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 64sub 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 831; 84