File Coverage

blib/lib/Rinchi/CIGIPP/ArticulatedPartControl.pm
Criterion Covered Total %
statement 102 149 68.4
branch 26 62 41.9
condition 11 33 33.3
subroutine 23 25 92.0
pod 21 21 100.0
total 183 290 63.1


line stmt bran cond sub pod time code
1             #
2             # Rinchi Common Image Generator Interface for Perl
3             # Class Identifier: f78ac266-200e-11de-bda6-001c25551abc
4             # Author: Brian M. Ames
5             #
6              
7             package Rinchi::CIGIPP::ArticulatedPartControl;
8              
9 1     1   1211 use 5.006;
  1         5  
  1         46  
10 1     1   6 use strict;
  1         2  
  1         42  
11 1     1   7 use warnings;
  1         2  
  1         32  
12 1     1   6 use Carp;
  1         3  
  1         5319  
13              
14             require Exporter;
15              
16             our @ISA = qw(Exporter);
17              
18             # Items to export into callers namespace by default. Note: do not export
19             # names by default without a very good reason. Use EXPORT_OK instead.
20             # Do not simply export all your public functions/methods/constants.
21              
22             # This allows declaration use Rinchi::CIGI::AtmosphereControl ':all';
23             # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
24             # will save memory.
25             our %EXPORT_TAGS = ( 'all' => [ qw(
26            
27             ) ] );
28              
29             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
30              
31             our @EXPORT = qw(
32            
33             );
34              
35             our $VERSION = '0.02';
36              
37             # Preloaded methods go here.
38              
39             =head1 NAME
40              
41             Rinchi::CIGIPP::ArticulatedPartControl - Perl extension for the Common Image
42             Generator Interface - Articulated Part Control data packet.
43             data packet.
44             =head1 SYNOPSIS
45              
46             use Rinchi::CIGIPP::ArticulatedPartControl;
47             my $ap_ctl = Rinchi::CIGIPP::ArticulatedPartControl->new();
48              
49             $packet_type = $ap_ctl->packet_type();
50             $packet_size = $ap_ctl->packet_size();
51             $entity_ident = $ap_ctl->entity_ident(63243);
52             $articulated_part_ident = $ap_ctl->articulated_part_ident(6);
53             $yaw_enable = $ap_ctl->yaw_enable(Rinchi::CIGIPP->Disable);
54             $pitch_enable = $ap_ctl->pitch_enable(Rinchi::CIGIPP->Enable);
55             $roll_enable = $ap_ctl->roll_enable(Rinchi::CIGIPP->Enable);
56             $z_offset_enable = $ap_ctl->z_offset_enable(Rinchi::CIGIPP->Disable);
57             $y_offset_enable = $ap_ctl->y_offset_enable(Rinchi::CIGIPP->Enable);
58             $x_offset_enable = $ap_ctl->x_offset_enable(Rinchi::CIGIPP->Disable);
59             $articulated_part_enable = $ap_ctl->articulated_part_enable(Rinchi::CIGIPP->Enable);
60             $x_offset = $ap_ctl->x_offset(3.419);
61             $y_offset = $ap_ctl->y_offset(55.33);
62             $z_offset = $ap_ctl->z_offset(80.089);
63             $roll = $ap_ctl->roll(2.203);
64             $pitch = $ap_ctl->pitch(81.151);
65             $yaw = $ap_ctl->yaw(61.683);
66              
67             =head1 DESCRIPTION
68              
69             Articulated parts are entity features that can be rotated and/or translated
70             with respect to the entity. These features are submodels of the entity model
71             and possess their own coordinate systems. Examples include wing flaps, landing
72             gear, and tank turrets.
73              
74             Articulated parts may be manipulated in up to six degrees of freedom.
75             Translation is defined as X, Y, and Z offsets relative to the submodel's
76             reference point. Rotation is defined relative to the submodel coordinate
77             system.
78             Positional and rotational values are not cumulative. They are absolute values
79             relative to the coordinate system defined within the model.
80              
81             =head2 EXPORT
82              
83             None by default.
84              
85             #==============================================================================
86              
87             =item new $ap_ctl = Rinchi::CIGIPP::ArticulatedPartControl->new()
88              
89             Constructor for Rinchi::ArticulatedPartControl.
90              
91             =cut
92              
93             sub new {
94 1     1 1 178 my $class = shift;
95 1   33     7 $class = ref($class) || $class;
96              
97 1         19 my $self = {
98             '_Buffer' => '',
99             '_ClassIdent' => 'f78ac266-200e-11de-bda6-001c25551abc',
100             '_Pack' => 'CCSCCSffffff',
101             '_Swap1' => 'CCvCCSVVVVVV',
102             '_Swap2' => 'CCnCCSNNNNNN',
103             'packetType' => 6,
104             'packetSize' => 32,
105             'entityIdent' => 0,
106             'articulatedPartIdent' => 0,
107             '_bitfields1' => 0, # Includes bitfields yawEnable, pitchEnable, rollEnable, zOffsetEnable, yOffsetEnable, xOffsetEnable, and articulatedPartEnable.
108             'yawEnable' => 0,
109             'pitchEnable' => 0,
110             'rollEnable' => 0,
111             'zOffsetEnable' => 0,
112             'yOffsetEnable' => 0,
113             'xOffsetEnable' => 0,
114             'articulatedPartEnable' => 0,
115             '_unused8' => 0,
116             'xOffset' => 0,
117             'yOffset' => 0,
118             'zOffset' => 0,
119             'roll' => 0,
120             'pitch' => 0,
121             'yaw' => 0,
122             };
123              
124 1 50       4 if (@_) {
125 0 0       0 if (ref($_[0]) eq 'ARRAY') {
    0          
126 0         0 $self->{'_Buffer'} = $_[0][0];
127             } elsif (ref($_[0]) eq 'HASH') {
128 0         0 foreach my $attr (keys %{$_[0]}) {
  0         0  
129 0 0       0 $self->{"_$attr"} = $_[0]->{$attr} unless ($attr =~ /^_/);
130             }
131             }
132             }
133              
134 1         3 bless($self,$class);
135 1         3 return $self;
136             }
137              
138             #==============================================================================
139              
140             =item sub packet_type()
141              
142             $value = $ap_ctl->packet_type();
143              
144             Data Packet Identifier.
145              
146             This attribute identifies this data packet as the Articulated Part Control
147             packet. The value of this attribute must be 6.
148              
149             =cut
150              
151             sub packet_type() {
152 1     1 1 6 my ($self) = @_;
153 1         79 return $self->{'packetType'};
154             }
155              
156             #==============================================================================
157              
158             =item sub packet_size()
159              
160             $value = $ap_ctl->packet_size();
161              
162             Data Packet Size.
163              
164             This attribute indicates the number of bytes in this data packet. The value of
165             this attribute must be 32.
166              
167             =cut
168              
169             sub packet_size() {
170 1     1 1 5 my ($self) = @_;
171 1         4 return $self->{'packetSize'};
172             }
173              
174             #==============================================================================
175              
176             =item sub entity_ident([$newValue])
177              
178             $value = $ap_ctl->entity_ident($newValue);
179              
180             Entity ID.
181              
182             This attribute specifies the entity to which the articulated part belongs.
183              
184             =cut
185              
186             sub entity_ident() {
187 1     1 1 5 my ($self,$nv) = @_;
188 1 50       3 if (defined($nv)) {
189 1         2 $self->{'entityIdent'} = $nv;
190             }
191 1         3 return $self->{'entityIdent'};
192             }
193              
194             #==============================================================================
195              
196             =item sub articulated_part_ident([$newValue])
197              
198             $value = $ap_ctl->articulated_part_ident($newValue);
199              
200             Articulated Part ID.
201              
202             This attribute specifies the articulated part to which the data in this packet
203             should be applied. When used with the Entity ID attribute, this attribute
204             uniquely identifies a particular articulated part within the simulation.
205              
206             =cut
207              
208             sub articulated_part_ident() {
209 1     1 1 5 my ($self,$nv) = @_;
210 1 50       4 if (defined($nv)) {
211 1         2 $self->{'articulatedPartIdent'} = $nv;
212             }
213 1         3 return $self->{'articulatedPartIdent'};
214             }
215              
216             #==============================================================================
217              
218             =item sub yaw_enable([$newValue])
219              
220             $value = $ap_ctl->yaw_enable($newValue);
221              
222             Yaw Enable.
223              
224             This attribute determines whether the Yaw attribute of the current packet
225             should be applied to the articulated part. If this attribute is set to Disable
226             (0), Yaw is ignored and the articulated part retains its current yaw angle.
227              
228             Disable 0
229             Enable 1
230              
231             =cut
232              
233             sub yaw_enable() {
234 1     1 1 2 my ($self,$nv) = @_;
235 1 50       11 if (defined($nv)) {
236 1 50 33     5 if (($nv==0) or ($nv==1)) {
237 1         3 $self->{'yawEnable'} = $nv;
238 1         3 $self->{'_bitfields1'} |= ($nv << 6) &0x40;
239             } else {
240 0         0 carp "yaw_enable must be 0 (Disable), or 1 (Enable).";
241             }
242             }
243 1         3 return (($self->{'_bitfields1'} & 0x40) >> 6);
244             }
245              
246             #==============================================================================
247              
248             =item sub pitch_enable([$newValue])
249              
250             $value = $ap_ctl->pitch_enable($newValue);
251              
252             Pitch Enable.
253              
254             This attribute determines whether the Pitch attribute of the current packet
255             should be applied to the articulated part. If this attribute is set to Disable
256             (0), Pitch is ignored and the articulated part retains its current pitch angle.
257              
258             Disable 0
259             Enable 1
260              
261             =cut
262              
263             sub pitch_enable() {
264 1     1 1 2 my ($self,$nv) = @_;
265 1 50       5 if (defined($nv)) {
266 1 50 33     8 if (($nv==0) or ($nv==1)) {
267 1         2 $self->{'pitchEnable'} = $nv;
268 1         3 $self->{'_bitfields1'} |= ($nv << 5) &0x20;
269             } else {
270 0         0 carp "pitch_enable must be 0 (Disable), or 1 (Enable).";
271             }
272             }
273 1         5 return (($self->{'_bitfields1'} & 0x20) >> 5);
274             }
275              
276             #==============================================================================
277              
278             =item sub roll_enable([$newValue])
279              
280             $value = $ap_ctl->roll_enable($newValue);
281              
282             Roll Enable.
283              
284             This attribute determines whether the Roll attribute of the current packet
285             should be applied to the articulated part. If this attribute is set to Disable
286             (0), Roll is ignored and the articulated part retains its current roll angle.
287              
288             Disable 0
289             Enable 1
290              
291             =cut
292              
293             sub roll_enable() {
294 1     1 1 2 my ($self,$nv) = @_;
295 1 50       4 if (defined($nv)) {
296 1 50 33     7 if (($nv==0) or ($nv==1)) {
297 1         2 $self->{'rollEnable'} = $nv;
298 1         2 $self->{'_bitfields1'} |= ($nv << 4) &0x10;
299             } else {
300 0         0 carp "roll_enable must be 0 (Disable), or 1 (Enable).";
301             }
302             }
303 1         4 return (($self->{'_bitfields1'} & 0x10) >> 4);
304             }
305              
306             #==============================================================================
307              
308             =item sub z_offset_enable([$newValue])
309              
310             $value = $ap_ctl->z_offset_enable($newValue);
311              
312             Z Offset Enable.
313              
314             This attribute determines whether the Z Offset attribute of the current packet
315             should be applied to the articulated part. If this attribute is set to Disable
316             (0), Z Offset is ignored and the articulated part remains at its current
317             location along the submodel's Z axis.
318              
319             Disable 0
320             Enable 1
321              
322             =cut
323              
324             sub z_offset_enable() {
325 1     1 1 2 my ($self,$nv) = @_;
326 1 50       4 if (defined($nv)) {
327 1 50 33     5 if (($nv==0) or ($nv==1)) {
328 1         2 $self->{'zOffsetEnable'} = $nv;
329 1         3 $self->{'_bitfields1'} |= ($nv << 3) &0x08;
330             } else {
331 0         0 carp "z_offset_enable must be 0 (Disable), or 1 (Enable).";
332             }
333             }
334 1         3 return (($self->{'_bitfields1'} & 0x08) >> 3);
335             }
336              
337             #==============================================================================
338              
339             =item sub y_offset_enable([$newValue])
340              
341             $value = $ap_ctl->y_offset_enable($newValue);
342              
343             Y Offset Enable.
344              
345             This attribute determines whether the Y Offset attribute of the current packet
346             should be applied to the articulated part. If this attribute is set to Disable
347             (0), Y Offset is ignored and the articulated part remains at its current
348             location along the submodel's Y axis.
349              
350             Disable 0
351             Enable 1
352              
353             =cut
354              
355             sub y_offset_enable() {
356 1     1 1 2 my ($self,$nv) = @_;
357 1 50       4 if (defined($nv)) {
358 1 50 33     15 if (($nv==0) or ($nv==1)) {
359 1         2 $self->{'yOffsetEnable'} = $nv;
360 1         3 $self->{'_bitfields1'} |= ($nv << 2) &0x04;
361             } else {
362 0         0 carp "y_offset_enable must be 0 (Disable), or 1 (Enable).";
363             }
364             }
365 1         4 return (($self->{'_bitfields1'} & 0x04) >> 2);
366             }
367              
368             #==============================================================================
369              
370             =item sub x_offset_enable([$newValue])
371              
372             $value = $ap_ctl->x_offset_enable($newValue);
373              
374             X Offset Enable.
375              
376             This attribute determines whether the X Offset attribute of the current packet
377             should be applied to the articulated part. If this attribute is set to Disable
378             (0), X Offset is ignored and the articulated part remains at its current
379             location along the submodel's X axis.
380              
381             Disable 0
382             Enable 1
383              
384             =cut
385              
386             sub x_offset_enable() {
387 1     1 1 4 my ($self,$nv) = @_;
388 1 50       3 if (defined($nv)) {
389 1 50 33     4 if (($nv==0) or ($nv==1)) {
390 1         4 $self->{'xOffsetEnable'} = $nv;
391 1         2 $self->{'_bitfields1'} |= ($nv << 1) &0x02;
392             } else {
393 0         0 carp "x_offset_enable must be 0 (Disable), or 1 (Enable).";
394             }
395             }
396 1         4 return (($self->{'_bitfields1'} & 0x02) >> 1);
397             }
398              
399             #==============================================================================
400              
401             =item sub articulated_part_enable([$newValue])
402              
403             $value = $ap_ctl->articulated_part_enable($newValue);
404              
405             Articulated Part Enable.
406              
407             This attribute determines whether the articulated part submodel should be
408             enabled or disabled within the scene graph. If this attribute is set to Disable
409             (0), the part is removed from the scene; if the attribute is set to Enable (1),
410             the part is included in the scene.
411              
412             Disable 0
413             Enable 1
414              
415             =cut
416              
417             sub articulated_part_enable() {
418 1     1 1 3 my ($self,$nv) = @_;
419 1 50       3 if (defined($nv)) {
420 1 50 33     9 if (($nv==0) or ($nv==1)) {
421 1         3 $self->{'articulatedPartEnable'} = $nv;
422 1         2 $self->{'_bitfields1'} |= $nv &0x01;
423             } else {
424 0         0 carp "articulated_part_enable must be 0 (Disable), or 1 (Enable).";
425             }
426             }
427 1         4 return ($self->{'_bitfields1'} & 0x01);
428             }
429              
430             #==============================================================================
431              
432             =item sub x_offset([$newValue])
433              
434             $value = $ap_ctl->x_offset($newValue);
435              
436             X Offset.
437              
438             This attribute represents the distance in meters from the submodel reference
439             point to the articulated part along its X axis.
440              
441             =cut
442              
443             sub x_offset() {
444 1     1 1 5 my ($self,$nv) = @_;
445 1 50       3 if (defined($nv)) {
446 1         3 $self->{'xOffset'} = $nv;
447             }
448 1         3 return $self->{'xOffset'};
449             }
450              
451             #==============================================================================
452              
453             =item sub y_offset([$newValue])
454              
455             $value = $ap_ctl->y_offset($newValue);
456              
457             Y Offset.
458              
459             This attribute represents the distance in meters from the submodel reference
460             point to the articulated part along its Y axis.
461              
462             =cut
463              
464             sub y_offset() {
465 1     1 1 6 my ($self,$nv) = @_;
466 1 50       4 if (defined($nv)) {
467 1         3 $self->{'yOffset'} = $nv;
468             }
469 1         3 return $self->{'yOffset'};
470             }
471              
472             #==============================================================================
473              
474             =item sub z_offset([$newValue])
475              
476             $value = $ap_ctl->z_offset($newValue);
477              
478             Z Offset.
479              
480             This attribute represents the distance in meters from the submodel reference
481             point to the articulated part along its Z axis.
482              
483             =cut
484              
485             sub z_offset() {
486 1     1 1 5 my ($self,$nv) = @_;
487 1 50       3 if (defined($nv)) {
488 1         3 $self->{'zOffset'} = $nv;
489             }
490 1         3 return $self->{'zOffset'};
491             }
492              
493             #==============================================================================
494              
495             =item sub roll([$newValue])
496              
497             $value = $ap_ctl->roll($newValue);
498              
499             Roll.
500              
501             This attribute specifies the angle of rotation measured in degrees relative to
502             the submodel coordinate system of the articulated part submodel about its X
503             axis after yaw and pitch have been applied.
504              
505             =cut
506              
507             sub roll() {
508 1     1 1 10 my ($self,$nv) = @_;
509 1 50       3 if (defined($nv)) {
510 1 50 33     8 if (($nv>=-180.0) and ($nv<=180.0)) {
511 1         3 $self->{'roll'} = $nv;
512             } else {
513 0         0 carp "roll must be from -180.0 to +180.0.";
514             }
515             }
516 1         4 return $self->{'roll'};
517             }
518              
519             #==============================================================================
520              
521             =item sub pitch([$newValue])
522              
523             $value = $ap_ctl->pitch($newValue);
524              
525             Pitch.
526              
527             This attribute specifies the angle of rotation measured in degrees relative to
528             the submodel coordinate system of the articulated part submodel about its Y
529             axis after yaw has been applied.
530              
531             =cut
532              
533             sub pitch() {
534 1     1 1 5 my ($self,$nv) = @_;
535 1 50       4 if (defined($nv)) {
536 1 50 33     7 if (($nv>=-90) and ($nv<=90.0)) {
537 1         2 $self->{'pitch'} = $nv;
538             } else {
539 0         0 carp "pitch must be from -90.0 to +90.0.";
540             }
541             }
542 1         3 return $self->{'pitch'};
543             }
544              
545             #==============================================================================
546              
547             =item sub yaw([$newValue])
548              
549             $value = $ap_ctl->yaw($newValue);
550              
551             Yaw.
552              
553             This attribute specifies the angle of rotation measured in degrees relative to
554             the submodel coordinate system of the articulated part about its Z axis.
555              
556             =cut
557              
558             sub yaw() {
559 1     1 1 5 my ($self,$nv) = @_;
560 1 50       4 if (defined($nv)) {
561 1 50 33     7 if (($nv>=0) and ($nv<=360.0)) {
562 1         3 $self->{'yaw'} = $nv;
563             } else {
564 0         0 carp "yaw must be from 0.0 to +360.0.";
565             }
566             }
567 1         3 return $self->{'yaw'};
568             }
569              
570             #==========================================================================
571              
572             =item sub pack()
573              
574             $value = $ap_ctl->pack();
575              
576             Returns the packed data packet.
577              
578             =cut
579              
580             sub pack($) {
581 1     1 1 4 my $self = shift;
582            
583 1         9 $self->{'_Buffer'} = CORE::pack($self->{'_Pack'},
584             $self->{'packetType'},
585             $self->{'packetSize'},
586             $self->{'entityIdent'},
587             $self->{'articulatedPartIdent'},
588             $self->{'_bitfields1'}, # Includes bitfields unused8, yawEnable, pitchEnable, rollEnable, zOffsetEnable, yOffsetEnable, xOffsetEnable, and articulatedPartEnable.
589             $self->{'_unused8'},
590             $self->{'xOffset'},
591             $self->{'yOffset'},
592             $self->{'zOffset'},
593             $self->{'roll'},
594             $self->{'pitch'},
595             $self->{'yaw'},
596             );
597              
598 1         3 return $self->{'_Buffer'};
599             }
600              
601             #==========================================================================
602              
603             =item sub unpack()
604              
605             $value = $ap_ctl->unpack();
606              
607             Unpacks the packed data packet.
608              
609             =cut
610              
611             sub unpack($) {
612 0     0 1   my $self = shift @_;
613            
614 0 0         if (@_) {
615 0           $self->{'_Buffer'} = shift @_;
616             }
617              
618 0           my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l) = CORE::unpack($self->{'_Pack'},$self->{'_Buffer'});
619 0           $self->{'packetType'} = $a;
620 0           $self->{'packetSize'} = $b;
621 0           $self->{'entityIdent'} = $c;
622 0           $self->{'articulatedPartIdent'} = $d;
623 0           $self->{'_bitfields1'} = $e; # Includes bitfields unused8, yawEnable, pitchEnable, rollEnable, zOffsetEnable, yOffsetEnable, xOffsetEnable, and articulatedPartEnable.
624 0           $self->{'_unused8'} = $f;
625 0           $self->{'xOffset'} = $g;
626 0           $self->{'yOffset'} = $h;
627 0           $self->{'zOffset'} = $i;
628 0           $self->{'roll'} = $j;
629 0           $self->{'pitch'} = $k;
630 0           $self->{'yaw'} = $l;
631              
632 0           $self->{'yawEnable'} = $self->yaw_enable();
633 0           $self->{'pitchEnable'} = $self->pitch_enable();
634 0           $self->{'rollEnable'} = $self->roll_enable();
635 0           $self->{'zOffsetEnable'} = $self->z_offset_enable();
636 0           $self->{'yOffsetEnable'} = $self->y_offset_enable();
637 0           $self->{'xOffsetEnable'} = $self->x_offset_enable();
638 0           $self->{'articulatedPartEnable'} = $self->articulated_part_enable();
639              
640 0           return $self->{'_Buffer'};
641             }
642              
643             #==========================================================================
644              
645             =item sub byte_swap()
646              
647             $obj_name->byte_swap();
648              
649             Byte swaps the packed data packet.
650              
651             =cut
652              
653             sub byte_swap($) {
654 0     0 1   my $self = shift @_;
655            
656 0 0         if (@_) {
657 0           $self->{'_Buffer'} = shift @_;
658             } else {
659 0           $self->pack();
660             }
661 0           my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k) = CORE::unpack($self->{'_Swap1'},$self->{'_Buffer'});
662              
663 0           $self->{'_Buffer'} = CORE::pack($self->{'_Swap2'},$a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k);
664 0           $self->unpack();
665              
666 0           return $self->{'_Buffer'};
667             }
668              
669             1;
670             __END__