File Coverage

blib/lib/Data/Turtle.pm
Criterion Covered Total %
statement 65 65 100.0
branch n/a
condition 3 6 50.0
subroutine 19 19 100.0
pod 12 12 100.0
total 99 102 97.0


line stmt bran cond sub pod time code
1             package Data::Turtle;
2             our $AUTHORITY = 'cpan:GENE';
3              
4             # ABSTRACT: Turtle Movement and State Operations
5              
6 2     2   718721 use Moo;
  2         17558  
  2         11  
7 2     2   4423 use Math::Trig qw(:pi);
  2         30117  
  2         362  
8 2     2   1212 use POSIX qw(ceil);
  2         15479  
  2         11  
9              
10             our $VERSION = '0.0207';
11              
12 2     2   3367 use constant K => pi / 180;
  2         4  
  2         2011  
13              
14              
15             sub _init_x {
16 2     2   13 my $self = shift;
17 2         108 return $self->width / 2;
18             }
19              
20             sub _init_y {
21 2     2   39 my $self = shift;
22 2         56 return $self->height / 2;
23             }
24              
25             sub _init_heading {
26 2     2   3584 my $self = shift;
27 2         33 return -90 % 360;
28             }
29              
30              
31             has width => (
32             is => 'rw',
33             default => sub { 500 },
34             );
35              
36             has height => (
37             is => 'rw',
38             default => sub { 500 },
39             );
40              
41              
42             has x => (
43             is => 'rw',
44             lazy => 1,
45             builder => \&_init_x,
46             );
47              
48             has y => (
49             is => 'rw',
50             lazy => 1,
51             builder => \&_init_y,
52             );
53              
54             has heading => (
55             is => 'rw',
56             builder => \&_init_heading,
57             );
58              
59              
60             has pen_status => (
61             is => 'rw',
62             default => sub { 1 }, # Pen down
63             );
64              
65             has pen_color => (
66             is => 'rw',
67             default => sub { 'black' },
68             );
69              
70             has pen_size => (
71             is => 'rw',
72             default => sub { 1 },
73             );
74              
75              
76             sub home {
77 1     1 1 797 my $self = shift;
78 1         5 $self->x( $self->_init_x );
79 1         10 $self->y( $self->_init_y );
80 1         13 $self->heading( $self->_init_heading );
81             }
82              
83              
84             sub pen_up {
85 1     1 1 813 my $self = shift;
86 1         7 $self->pen_status(0);
87             }
88              
89              
90             sub pen_down {
91 1     1 1 883 my $self = shift;
92 1         6 $self->pen_status(1);
93             }
94              
95              
96             sub right {
97 2     2 1 1699 my $self = shift;
98 2   50     8 my $degrees = shift // 0;
99 2         13 $self->heading(($self->heading + $degrees) % 360);
100             }
101              
102              
103             sub left {
104 1     1 1 843 my $self = shift;
105 1   50     5 my $degrees = shift // 0;
106 1         8 $self->heading(($self->heading - $degrees) % 360);
107             }
108              
109              
110             sub position {
111 3     3 1 903 my $self = shift;
112 3         81 return ceil($self->x), ceil($self->y);
113             }
114              
115              
116             sub get_state {
117 3     3 1 582 my $self = shift;
118             return
119 3         86 ceil($self->x),
120             ceil($self->y),
121             $self->heading,
122             $self->pen_status,
123             $self->pen_color,
124             $self->pen_size;
125             }
126              
127              
128             sub set_state {
129 1     1 1 806 my $self = shift;
130 1         5 my ($x, $y, $heading, $pen_status, $pen_color, $pen_size) = @_;
131 1         35 $self->x($x);
132 1         30 $self->y($y);
133 1         9 $self->heading($heading);
134 1         4 $self->pen_status($pen_status);
135 1         4 $self->pen_color($pen_color);
136 1         5 $self->pen_size($pen_size);
137             }
138              
139              
140             sub forward {
141 2     2 1 845 my $self = shift;
142 2   50     11 my $step = shift // 1;
143              
144 2         38 my $x = $step * cos($self->heading * K);
145 2         17 my $y = $step * sin($self->heading * K);
146              
147 2         75 my $xo = $self->x;
148 2         99 my $yo = $self->y;
149              
150 2         60 $self->x($x + $xo);
151 2         92 $self->y($y + $yo);
152              
153 2         67 return ceil($xo), ceil($yo),
154             ceil($self->x), ceil($self->y),
155             $self->pen_color, $self->pen_size;
156             }
157              
158              
159             sub backward {
160 1     1 1 779 my $self = shift;
161 1         12 my $step = shift;
162 1         4 $self->forward(-$step)
163             }
164              
165              
166             sub mirror {
167 1     1 1 765 my $self = shift;
168 1         11 $self->heading($self->heading * -1);
169             }
170              
171              
172             sub goto {
173 1     1 1 748 my $self = shift;
174 1         3 my ($x, $y) = @_;
175              
176 1         36 my $xo = $self->x;
177 1         68 my $yo = $self->y;
178              
179 1         31 $self->x($x);
180 1         27 $self->y($y);
181              
182 1         31 return ceil($xo), ceil($yo),
183             ceil($self->x), ceil($self->y),
184             $self->pen_color, $self->pen_size;
185             }
186              
187             1;
188              
189             __END__