Готовая программа

package Turtle;
use warnings;

use Math::Trig;
use POSIX;
use File::Temp;
use RGBColor;

sub new()
{
	my $class=shift;
	my $self
		={
			savestack=>[
					{
						x=>0,
						y=>0,
						direction=>0,
						linewitdh=>1,
						color=>RGBColor->new([0, 0, 0]),
						scale=>1,
					}
				],
			bbox=>{llx=>0, lly=>0, urx=>0, ury=>0},
			tmpfile=>File::Temp->new(template=>'Turtle-XXXXXXXX'),
		};
	bless $self, $class;
	return $self;
}

sub save()
{
	my $self=shift;
	push @{$self->{savestack}}, {};
	$self->writePostScript('gsave');
}

sub restore()
{
	my $self=shift;
	die "$0: Стек состояний пуст\n" if @{$self->{savestack}}==1;
	pop @{$self->{savestack}};
	$self->writePostScript('grestore');
}

sub setProperty($$)
{
	my $self=shift;
	my $property=shift;
	$self->{savestack}[-1]{$property}=shift;
}

sub getProperty($)
{
	my $self=shift;
	my $property=shift;
	my $savestack=$self->{savestack};
	for(my $i=$#$savestack; $i>=0; $i--)
	{
		return $savestack->[$i]{$property}
			if exists $savestack->[$i]{$property};
	}
}

sub setXY($$)
{
	my $self=shift;
	$self->setProperty('x', shift);
	$self->setProperty('y', shift);
}

sub getXY()
{
	my $self=shift;
	return ($self->getProperty('x'), $self->getProperty('y'));
}

sub setScale($)	{ shift->setProperty('scale', shift); }

sub getScale()	{ return shift->getProperty('scale'); }

sub setDirection($)	{ shift->setProperty('direction', shift); }

sub getDirection()	{ return shift->getProperty('direction'); }

sub setLineWidth($)
{
	my $self=shift;
	my $linewitdh=shift;
	$self->setProperty('linewitdh', $linewitdh);
	$self->writePostScript($linewitdh, 'setlinewidth');
}

sub getLineWidth()	{ return shift->getProperty('linewitdh'); }

sub setColor($)
{
	my $self=shift;
	my $color=RGBColor->new(shift);
	$self->setProperty('color', $color);
	$self->writePostScript(@$color, 'setrgbcolor');
}

sub getColor()	{ return shift->getProperty('color'); }

sub rotate($)
{
	my $self=shift;
	$self->setDirection($self->getDirection+shift);
}

sub jump($)
{
	my $self=shift;
	my $step=shift;
	$step*=$self->getScale;
	my ($x, $y)=$self->getXY;
	my $angleRad=deg2rad($self->getDirection);
	$self->setXY($x+$step*cos($angleRad), $y+$step*sin($angleRad));
}

sub forward($)
{
	my $self=shift;
	my $step=shift;
	my ($x, $y)=$self->getXY;
	$self->modifyBBox;
	$self->jump($step);
	$self->modifyBBox;
	$self->writePostScript
		(
			'newpath',
			$x, $y, 'moveto',
			$self->getXY, 'lineto',
			'stroke'
		);
}

sub modifyBBox()
{
	my $self=shift;
	my $lineWidthHalf=$self->getLineWidth/2;
	my ($x, $y)=$self->getXY;
	$self->{bbox}{llx}=min($self->{bbox}{llx}, $x-$lineWidthHalf);
	$self->{bbox}{lly}=min($self->{bbox}{lly}, $y-$lineWidthHalf);
	$self->{bbox}{urx}=max($self->{bbox}{urx}, $x+$lineWidthHalf);
	$self->{bbox}{ury}=max($self->{bbox}{ury}, $y+$lineWidthHalf);
}

sub min($$)	{ return $_[$_[0]<$_[1]? 0: 1];	}

sub max($$)	{ return $_[$_[0]>$_[1]? 0: 1]; }

sub writePostScript(@)
{
	shift->{tmpfile}->print("@_\n");
}

sub writePicture(;$$$)
{
	my $self=shift;

	my $outputFileName=shift//'TurtleOut.eps';
	my $device=shift//'epswrite';
	my $resolution=shift//72;

	my %bbox=%{$self->{bbox}};
	my @hiResBoundingBox=@bbox{sort keys %bbox};
	my $width=ceil(($bbox{urx}-$bbox{llx})*$resolution/72);
	my $height=ceil(($bbox{ury}-$bbox{lly})*$resolution/72);
	my @boundingBox
		=(
			floor($hiResBoundingBox[0]), floor($hiResBoundingBox[1]),
			ceil($hiResBoundingBox[2]), ceil($hiResBoundingBox[3])
		);

	open my $gsPipe, '|-',
		sprintf("gs -q -dNOPAUSE -dEPSCrop -sDEVICE=\"\%s\" -r\%s -o\"\%s\" -",
			$device, $resolution, $outputFileName);

	$gsPipe->print(<<__POSTSCRIPT__);
\%!PS-Adobe-3.0 EPSF-3.0;
\%\%BoundingBox: @boundingBox
\%\%HiResBoundingBox: @hiResBoundingBox
\%\%EndComments
1 setlinecap
__POSTSCRIPT__

	$self->{tmpfile}->flush;
	open my $tmpReader, '<', $self->{tmpfile}->filename;
	$gsPipe->print(<$tmpReader>);
	$tmpReader->close;

	$gsPipe->print("showpage\n");
	$gsPipe->print("\%\%EOF\n");
	$gsPipe->close
		or die "$0: Продолжать невозможно: GhostScript завершился с ошибкой\n";

	my $outputFileSize=-s $outputFileName;

	print(<<__REPORT__);
* Записан файл: «$outputFileName»
* Размер файла: $outputFileSize
* Устройство: $device
* Размер: ${width}×$height
* Разрешение: $resolution dpi
**
__REPORT__
}

return 1;
package RGBColor;
use warnings;

my %colorByName
	=(
		aliceblue=>'#F0F8FF',
		antiquewhite=>'#FAEBD7',
		aqua=>'#00FFFF',
		aquamarine=>'#7FFFD4',
		azure=>'#F0FFFF',
		beige=>'#F5F5DC',
		bisque=>'#FFE4C4',
		black=>'#000000',
		blanchedalmond=>'#FFEBCD',
		blue=>'#0000FF',
		blueviolet=>'#8A2BE2',
		brown=>'#A52A2A',
		burlywood=>'#DEB887',
		cadetblue=>'#5F9EA0',
		chartreuse=>'#7FFF00',
		chocolate=>'#D2691E',
		coral=>'#FF7F50',
		cornflowerblue=>'#6495ED',
		cornsilk=>'#FFF8DC',
		crimson=>'#DC143C',
		cyan=>'#00FFFF',
		darkblue=>'#00008B',
		darkcyan=>'#008B8B',
		darkgoldenrod=>'#B8860B',
		darkgray=>'#A9A9A9',
		darkgreen=>'#006400',
		darkgrey=>'#A9A9A9',
		darkkhaki=>'#BDB76B',
		darkmagenta=>'#8B008B',
		darkolivegreen=>'#556B2F',
		darkorange=>'#FF8C00',
		darkorchid=>'#9932CC',
		darkred=>'#8B0000',
		darksalmon=>'#E9967A',
		darkseagreen=>'#8FBC8F',
		darkslateblue=>'#483D8B',
		darkslategray=>'#2F4F4F',
		darkslategrey=>'#2F4F4F',
		darkturquoise=>'#00CED1',
		darkviolet=>'#9400D3',
		deeppink=>'#FF1493',
		deepskyblue=>'#00BFFF',
		dimgray=>'#696969',
		dimgrey=>'#696969',
		dodgerblue=>'#1E90FF',
		firebrick=>'#B22222',
		floralwhite=>'#FFFAF0',
		forestgreen=>'#228B22',
		fuchsia=>'#FF00FF',
		gainsboro=>'#DCDCDC',
		ghostwhite=>'#F8F8FF',
		gold=>'#FFD700',
		goldenrod=>'#DAA520',
		gray=>'#808080',
		green=>'#008000',
		greenyellow=>'#ADFF2F',
		grey=>'#808080',
		honeydew=>'#F0FFF0',
		hotpink=>'#FF69B4',
		indianred=>'#CD5C5C',
		indigo=>'#4B0082',
		ivory=>'#FFFFF0',
		khaki=>'#F0E68C',
		lavender=>'#E6E6FA',
		lavenderblush=>'#FFF0F5',
		lawngreen=>'#7CFC00',
		lemonchiffon=>'#FFFACD',
		lightblue=>'#ADD8E6',
		lightcoral=>'#F08080',
		lightcyan=>'#E0FFFF',
		lightgoldenrodyellow=>'#FAFAD2',
		lightgray=>'#D3D3D3',
		lightgreen=>'#90EE90',
		lightgrey=>'#D3D3D3',
		lightpink=>'#FFB6C1',
		lightsalmon=>'#FFA07A',
		lightseagreen=>'#20B2AA',
		lightskyblue=>'#87CEFA',
		lightslategray=>'#778899',
		lightslategrey=>'#778899',
		lightsteelblue=>'#B0C4DE',
		lightyellow=>'#FFFFE0',
		lime=>'#00FF00',
		limegreen=>'#32CD32',
		linen=>'#FAF0E6',
		magenta=>'#FF00FF',
		maroon=>'#800000',
		mediumaquamarine=>'#66CDAA',
		mediumblue=>'#0000CD',
		mediumorchid=>'#BA55D3',
		mediumpurple=>'#9370DB',
		mediumseagreen=>'#3CB371',
		mediumslateblue=>'#7B68EE',
		mediumspringgreen=>'#00FA9A',
		mediumturquoise=>'#48D1CC',
		mediumvioletred=>'#C71585',
		midnightblue=>'#191970',
		mintcream=>'#F5FFFA',
		mistyrose=>'#FFE4E1',
		moccasin=>'#FFE4B5',
		navajowhite=>'#FFDEAD',
		navy=>'#000080',
		oldlace=>'#FDF5E6',
		olive=>'#808000',
		olivedrab=>'#6B8E23',
		orange=>'#FFA500',
		orangered=>'#FF4500',
		orchid=>'#DA70D6',
		palegoldenrod=>'#EEE8AA',
		palegreen=>'#98FB98',
		paleturquoise=>'#AFEEEE',
		palevioletred=>'#DB7093',
		papayawhip=>'#FFEFD5',
		peachpuff=>'#FFDAB9',
		peru=>'#CD853F',
		pink=>'#FFC0CB',
		plum=>'#DDA0DD',
		powderblue=>'#B0E0E6',
		purple=>'#800080',
		red=>'#FF0000',
		rosybrown=>'#BC8F8F',
		royalblue=>'#4169E1',
		saddlebrown=>'#8B4513',
		salmon=>'#FA8072',
		sandybrown=>'#F4A460',
		seagreen=>'#2E8B57',
		seashell=>'#FFF5EE',
		sienna=>'#A0522D',
		silver=>'#C0C0C0',
		skyblue=>'#87CEEB',
		slateblue=>'#6A5ACD',
		slategray=>'#708090',
		slategrey=>'#708090',
		snow=>'#FFFAFA',
		springgreen=>'#00FF7F',
		steelblue=>'#4682B4',
		tan=>'#D2B48C',
		teal=>'#008080',
		thistle=>'#D8BFD8',
		tomato=>'#FF6347',
		turquoise=>'#40E0D0',
		violet=>'#EE82EE',
		wheat=>'#F5DEB3',
		white=>'#FFFFFF',
		whitesmoke=>'#F5F5F5',
		yellow=>'#FFFF00',
		yellowgreen=>'#9ACD32',
	);

sub new($);
sub new($)
{
	my $class=shift;
	my $color=shift;
	my $self;

	if(ref $color eq 'ARRAY')
	{
		$self=$color;
	}
	elsif(ref $color eq 'RGBColor')
	{
		$self=[@$color];
	}
	elsif($color=~m/^#([[:xdigit:]])([[:xdigit:]])([[:xdigit:]])$/)
	{
		$self=[hex($1)/15, hex($2)/15, hex($3)/15];
	}
	elsif($color=~m/^#([[:xdigit:]]{2})([[:xdigit:]]{2})([[:xdigit:]]{2})$/)
	{
		$self=[hex($1)/255, hex($2)/255, hex($3)/255];
	}
	elsif(exists $colorByName{$color})
	{
		$self=RGBColor->new($colorByName{$color});
	}
	else
	{
		warn "$0: Неизвестный цвет «$color», используется чёрный\n";
		$self=[0, 0, 0];
	}
	return bless $self, $class;
}

sub interpolate($$)
{
	my $self=shift;
	my $color=shift;
	my $t=shift;
	my $result=[];
	$result->[$_]=(1-$t)*$self->[$_]+$t*$color->[$_] for 0 .. 2;
	return RGBColor->new($result);
}

return 1;
Информатика-54© А. Н. Швец