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;
