File Coverage

blib/lib/VRML/VRML2/Standard.pm
Criterion Covered Total %
statement 158 1007 15.6
branch 31 442 7.0
condition 0 18 0.0
subroutine 12 60 20.0
pod 56 57 98.2
total 257 1584 16.2


line stmt bran cond sub pod time code
1             package VRML::VRML2::Standard;
2              
3             ############################## Copyright ##############################
4             # #
5             # This program is Copyright 1996,1998 by Hartmut Palm. #
6             # This program is free software; you can redistribute it and/or #
7             # modify it under the terms of the GNU General Public License #
8             # as published by the Free Software Foundation; either version 2 #
9             # of the License, or (at your option) any later version. #
10             # #
11             # This program is distributed in the hope that it will be useful, #
12             # but WITHOUT ANY WARRANTY; without even the implied warranty of #
13             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
14             # GNU General Public License for more details. #
15             # #
16             # If you do not have a copy of the GNU General Public License write #
17             # to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, #
18             # MA 02139, USA. #
19             # #
20             #######################################################################
21              
22             require 5.000;
23             require VRML::Base;
24 1     1   6 use strict;
  1         3  
  1         39  
25 1     1   7 use vars qw(@ISA $VERSION $AUTOLOAD);
  1         1  
  1         14495  
26             @ISA = qw(VRML::Base);
27             $VERSION = "1.07";
28              
29             =head1 NAME
30              
31             VRML::VRML2::Standard.pm - implements VRML 2.0/97 standard nodes
32              
33             =head1 SYNOPSIS
34              
35             use VRML::VRML2::Standard;
36              
37             =head1 DESCRIPTION
38              
39             Following nodes are currently implemented.
40              
41             [C]
42             [C]
43             [C]
44              
45             [C]
46             [C]
47             [C]
48              
49             [C]
50             [C]
51             [C]
52              
53             =cut
54              
55             sub new {
56 6     6 1 7 my $class = shift;
57 6         15 my $self = new VRML::Base;
58 6         15 $self->{'Content-type'} = "model/vrml";
59 6         12 $self->{'VRML'} = ["#VRML V2.0 utf8\n"];
60 6         15 return bless $self, $class;
61             }
62              
63             #####################################################################
64             # VRML Implementation #
65             #####################################################################
66              
67             =head2 Grouping Nodes
68              
69             These nodes B B if the $children parameter is empty !
70              
71             =over 4
72              
73             =cut
74              
75             #--------------------------------------------------------------------
76              
77             =item Anchor
78              
79             C
80              
81             Currently only the first part of I<$parameter> is supported.
82              
83             =cut
84              
85             sub Anchor {
86 0     0 1 0 my $self = shift;
87 0         0 my ($url, $description, $parameter, $bboxSize, $bboxCenter, $children) = @_;
88 0         0 my $vrml = "";
89 0         0 $vrml = $self->{'TAB'}."Anchor {\n";
90 0         0 $vrml .= $self->{'TAB'}." url \"".$self->escape($url)."\"\n";
91 0 0       0 $vrml .= $self->{'TAB'}." description \"".$self->utf8($description)."\"\n" if defined $description;
92 0 0       0 $vrml .= $self->{'TAB'}." parameter \"$parameter\"\n" if $parameter;
93 0 0       0 $vrml .= $self->{'TAB'}." bboxSize $bboxSize\n" if $bboxSize;
94 0 0       0 $vrml .= $self->{'TAB'}." bboxCenter $bboxCenter\n" if $bboxCenter;
95 0         0 $vrml .= $self->{'TAB'}." children [\n";
96 0         0 $self->{'TAB'} .= "\t";
97 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
98 0 0       0 if (defined $children) {
99 0         0 $vrml = "";
100 0 0       0 if (ref($children) eq "CODE") {
101 0         0 &$children;
102             } else {
103 0         0 $vrml .= $self->{'TAB'}."$children\n";
104             }
105 0         0 chop($self->{'TAB'});
106 0         0 $vrml .= $self->{'TAB'}." ]\n";
107 0         0 $vrml .= $self->{'TAB'}."}\n";
108 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
109             }
110 0         0 return $self;
111             }
112              
113             =item Billboard
114              
115             C
116              
117             =cut
118              
119             sub Billboard {
120 0     0 1 0 my $self = shift;
121 0         0 my ($axisOfRotation,$children) = @_;
122 0         0 my $vrml = "";
123 0         0 $vrml = $self->{'TAB'}."Billboard {\n";
124 0         0 $vrml .= $self->{'TAB'}." axisOfRotation $axisOfRotation\n";
125 0         0 $vrml .= $self->{'TAB'}." children [\n";
126 0         0 $self->{'TAB'} .= "\t";
127 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
128 0 0       0 if (defined $children) {
129 0         0 $vrml = "";
130 0 0       0 if (ref($children) eq "CODE") {
131 0         0 &$children;
132             } else {
133 0         0 $vrml .= $self->{'TAB'}."$children\n";
134             }
135 0         0 chop($self->{'TAB'});
136 0         0 $vrml .= $self->{'TAB'}." ]\n";
137 0         0 $vrml .= $self->{'TAB'}."}\n";
138 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
139             }
140 0         0 return $self;
141             }
142              
143             =item Collision
144              
145             C
146              
147             =cut
148              
149             sub Collision {
150 0     0 1 0 my $self = shift;
151 0         0 my ($collide, $proxy, $children) = @_;
152 0         0 my $vrml = "";
153 0         0 $vrml = $self->{'TAB'}."Collision {\n";
154 0         0 $vrml .= $self->{'TAB'}." collide $collide\n";
155 0 0       0 if (defined $proxy) {
156 0         0 $vrml .= $self->{'TAB'}." proxy \n";
157 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
158 0         0 $vrml = "";
159 0         0 $self->{'TAB'} .= "\t";
160 0 0       0 if (ref($proxy) eq "CODE") {
161 0         0 &$proxy;
162             } else {
163 0         0 $vrml .= $self->{'TAB'}."$proxy\n";
164             }
165 0         0 chop($self->{'TAB'});
166             }
167 0         0 $vrml .= $self->{'TAB'}." children [\n";
168 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
169 0         0 $self->{'TAB'} .= "\t";
170 0 0       0 if (defined $children) {
171 0         0 $vrml = "";
172 0 0       0 if (ref($children) eq "CODE") {
173 0         0 &$children;
174             } else {
175 0         0 $vrml .= $self->{'TAB'}."$children\n";
176             }
177 0         0 chop($self->{'TAB'});
178 0         0 $vrml .= $self->{'TAB'}." ]\n";
179 0         0 $vrml .= $self->{'TAB'}."}\n";
180 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
181             }
182 0         0 return $self;
183             }
184              
185             =item Group
186              
187             C
188              
189             =cut
190              
191             sub Group {
192 0     0 1 0 my $self = shift;
193 0         0 my ($bboxSize, $bboxCenter, $children) = @_;
194 0         0 my $vrml = "";
195 0         0 $vrml = $self->{'TAB'}."Group {\n";
196 0 0       0 $vrml .= $self->{'TAB'}." bboxSize $bboxSize\n" if $bboxSize;
197 0 0       0 $vrml .= $self->{'TAB'}." bboxCenter $bboxCenter\n" if $bboxCenter;
198 0         0 $vrml .= $self->{'TAB'}." children [\n";
199 0         0 $self->{'TAB'} .= "\t";
200 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
201 0 0       0 if (defined $children) {
202 0         0 $vrml = "";
203 0 0       0 if (ref($children) eq "CODE") {
204 0         0 &$children;
205             } else {
206 0         0 $vrml .= $self->{'TAB'}."$children\n";
207             }
208 0         0 chop($self->{'TAB'});
209 0         0 $vrml .= $self->{'TAB'}." ]\n";
210 0         0 $vrml .= $self->{'TAB'}."}\n";
211 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
212             }
213 0         0 return $self;
214             }
215              
216             =item Transform
217              
218             C
219              
220             $translation is a SFVec3f
221              
222             $rotation is a SFRotation
223              
224             $scale is a SFVec3f
225              
226             $scaleOrientation is a SFRotation
227              
228             $center is a SFVec3f
229              
230             =cut
231              
232             sub Transform {
233 0     0 1 0 my $self = shift;
234 0         0 my ($translation, $rotation, $scale, $scaleOrientation, $center, $bboxSize, $bboxCenter) = @_;
235 0 0       0 unless ($self->{'XYZ'}[0]) {
236 0         0 $self->_row("# To many end's !\n");
237             } else {
238 0         0 unshift @{$self->{'XYZ'}}, [@{$self->{'XYZ'}[0]}];
  0         0  
  0         0  
239 0 0       0 $self->xyz($self->string_to_array($translation)) if (defined $translation);
240             }
241 0         0 my $vrml = "";
242 0         0 $vrml = $self->{'TAB'}."Transform {\n";
243 0 0       0 $vrml .= $self->{'TAB'}." translation $translation\n" if $translation;
244 0 0       0 $vrml .= $self->{'TAB'}." rotation $rotation\n" if $rotation;
245 0 0       0 $vrml .= $self->{'TAB'}." scale $scale\n" if $scale;
246 0 0       0 $vrml .= $self->{'TAB'}." scaleOrientation $scaleOrientation\n" if $scaleOrientation;
247 0 0       0 $vrml .= $self->{'TAB'}." center $center\n" if $center;
248 0 0       0 $vrml .= $self->{'TAB'}." bboxSize $bboxSize\n" if $bboxSize;
249 0 0       0 $vrml .= $self->{'TAB'}." bboxCenter $bboxCenter\n" if $bboxCenter;
250 0         0 $vrml .= $self->{'TAB'}." children [\n";
251 0         0 $self->{'TAB'} .= "\t";
252 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
253 0         0 return $self;
254             }
255              
256             #--------------------------------------------------------------------
257              
258             =back
259              
260             =head2 Special Groups
261              
262             =over 4
263              
264             =cut
265              
266             #--------------------------------------------------------------------
267              
268             =item Inline
269              
270             C
271              
272             =cut
273              
274             sub Inline {
275 0     0 1 0 my $self = shift;
276 0         0 my $vrml = "";
277 0         0 my ($url, $bboxSize, $bboxCenter) = @_;
278 0         0 $vrml = $self->{'TAB'}."Inline {\n";
279 0         0 $vrml .= $self->{'TAB'}." url \"".$self->escape($url)."\"\n";
280 0 0       0 $vrml .= $self->{'TAB'}." bboxSize $bboxSize\n" if $bboxSize;
281 0 0       0 $vrml .= $self->{'TAB'}." bboxCenter $bboxCenter\n" if $bboxCenter;
282 0         0 $vrml .= $self->{'TAB'}."}\n";
283 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
284 0         0 return $self;
285             }
286              
287             =item LOD
288              
289             C
290              
291             $range is a MFFloat
292              
293             $center is a SFVec3f
294              
295             Example: C
296              
297             =cut
298              
299             sub LOD {
300 0     0 1 0 my $self = shift;
301 0         0 my ($range, $center) = @_;
302 0         0 my $vrml = "";
303 0         0 $vrml = $self->{'TAB'}."LOD {\n";
304 0 0       0 if ($range) {
305 0 0       0 if (ref($range) eq "ARRAY") {
306 0         0 $vrml .= $self->{'TAB'}." range [".join(',',@$range)."]\n";
307             } else {
308 0         0 $vrml .= $self->{'TAB'}." range [$range]\n";
309             }
310             }
311 0 0       0 $vrml .= $self->{'TAB'}." center $center\n" if $center;
312 0         0 $vrml .= $self->{'TAB'}." level [\n";
313 0         0 $self->{'TAB'} .= "\t";
314 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
315 0         0 return $self;
316             }
317              
318             =item Switch
319              
320             C
321              
322             =cut
323              
324             sub Switch {
325 0     0 1 0 my $self = shift;
326 0         0 my ($whichChoice) = @_;
327 0         0 my $vrml = "";
328 0         0 $vrml = $self->{'TAB'}."Switch {\n";
329 0 0       0 $vrml .= $self->{'TAB'}." whichChoice $whichChoice\n" if defined $whichChoice;
330 0         0 $vrml .= $self->{'TAB'}." choice [\n";
331 0         0 $self->{'TAB'} .= "\t";
332 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
333 0         0 return $self;
334             }
335              
336             #--------------------------------------------------------------------
337              
338             =back
339              
340             =head2 Common Nodes
341              
342             =over 4
343              
344             =cut
345              
346             #--------------------------------------------------------------------
347              
348             =item DirectionalLight
349              
350             C
351              
352             =cut
353              
354             sub DirectionalLight {
355 0     0 1 0 my $self = shift;
356 0         0 my ($direction, $intensity, $ambientIntensity, $color, $on) = @_;
357 0         0 my $vrml = "";
358 0         0 $vrml = $self->{'TAB'}."DirectionalLight {\n";
359 0 0       0 $vrml .= $self->{'TAB'}." direction $direction\n" if $direction;
360 0 0       0 $vrml .= $self->{'TAB'}." intensity $intensity\n" if $intensity;
361 0 0       0 $vrml .= $self->{'TAB'}." ambientIntensity $ambientIntensity\n" if $ambientIntensity;
362 0 0       0 $vrml .= $self->{'TAB'}." color $color\n" if $color;
363 0 0       0 $vrml .= $self->{'TAB'}." on $on\n" if $on;
364 0         0 $vrml .= $self->{'TAB'}."}\n";
365 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
366 0         0 return $self;
367             }
368              
369             =item PointLight
370              
371             C
372              
373             =cut
374              
375             sub PointLight {
376 0     0 1 0 my $self = shift;
377 0         0 my ($location, $intensity, $ambientIntensity, $color, $on) = @_;
378 0         0 my $vrml = "";
379 0         0 $vrml = $self->{'TAB'}."PointLight {\n";
380 0 0       0 $vrml .= $self->{'TAB'}." location $location\n" if $location;
381 0 0       0 $vrml .= $self->{'TAB'}." intensity $intensity\n" if $intensity;
382 0 0       0 $vrml .= $self->{'TAB'}." ambientIntensity $ambientIntensity\n" if $ambientIntensity;
383 0 0       0 $vrml .= $self->{'TAB'}." color $color\n" if $color;
384 0 0       0 $vrml .= $self->{'TAB'}." on $on\n" if $on;
385 0         0 $vrml .= $self->{'TAB'}."}\n";
386 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
387 0         0 return $self;
388             }
389              
390             =item SpotLight
391              
392             C
393              
394             =cut
395              
396             sub SpotLight {
397 0     0 1 0 my $self = shift;
398 0         0 my ($location, $direction, $intensity, $color, $on) = @_;
399 0         0 my $vrml = "";
400 0         0 $vrml = $self->{'TAB'}."SpotLight {\n";
401 0 0       0 $vrml .= $self->{'TAB'}." location $location\n" if $location;
402 0 0       0 $vrml .= $self->{'TAB'}." direction $direction\n" if $direction;
403 0 0       0 $vrml .= $self->{'TAB'}." intensity $intensity\n" if $intensity;
404 0 0       0 $vrml .= $self->{'TAB'}." color $color\n" if $color;
405 0 0       0 $vrml .= $self->{'TAB'}." on $on\n" if $on;
406 0         0 $vrml .= $self->{'TAB'}."}\n";
407 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
408 0         0 return $self;
409             }
410              
411             =item Sound
412              
413             C
414              
415             =cut
416              
417             sub Sound {
418 0     0 1 0 my $self = shift;
419 0         0 my ($source, $location, $direction, $intensity, $maxFront, $maxBack, $minFront, $minBack, $priority, $spatialize) = @_;
420 0         0 my $vrml = $self->{'TAB'}."Sound {\n";
421 0 0       0 $vrml .= $self->{'TAB'}." location $location\n" if $location;
422 0 0       0 $vrml .= $self->{'TAB'}." direction $direction\n" if $direction;
423 0 0       0 $vrml .= $self->{'TAB'}." intensity $intensity\n" if $intensity;
424 0 0       0 $vrml .= $self->{'TAB'}." maxFront $maxFront\n" if $maxFront;
425 0 0       0 $vrml .= $self->{'TAB'}." maxBack $maxBack\n" if $maxBack;
426 0 0       0 $vrml .= $self->{'TAB'}." minFront $minFront\n" if $minFront;
427 0 0       0 $vrml .= $self->{'TAB'}." minBack $minBack\n" if $minBack;
428 0 0       0 $vrml .= $self->{'TAB'}." priority $priority\n" if $priority;
429 0 0       0 $vrml .= $self->{'TAB'}." spatialize $spatialize\n" if $spatialize;
430 0 0       0 if (defined $source) {
431 0 0       0 if (ref($source) eq "CODE") {
432 0         0 $vrml .= $self->{'TAB'}." source ";
433 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
434 0         0 $self->{'TAB'} .= "\t";
435 0         0 my $pos = $#{$self->{'VRML'}}+1;
  0         0  
436 0         0 &$source;
437 0         0 $self->_trim($pos);
438 0         0 chop($self->{'TAB'});
439 0         0 $vrml = "";
440             } else {
441 0         0 $vrml .= $self->{'TAB'}." source $source\n";
442             }
443             }
444 0         0 $vrml .= $self->{'TAB'}."}\n";
445 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
446 0         0 return $self;
447             }
448              
449             =item AudioClip
450              
451             C
452              
453             =cut
454              
455             sub AudioClip {
456 0     0 1 0 my $self = shift;
457 0         0 my $vrml = "";
458 0         0 my ($url, $description, $loop, $pitch, $startTime, $stopTime) = @_;
459 0         0 $vrml = $self->{'TAB'}."AudioClip {\n";
460 0 0       0 $vrml .= $self->{'TAB'}." url \"".$self->escape($url)."\"\n" if $url;
461 0 0       0 $vrml .= $self->{'TAB'}." description \"".$self->utf8($description)."\"\n" if defined $description;
462 0 0       0 $vrml .= $self->{'TAB'}." loop $loop\n" if $loop;
463 0 0       0 $vrml .= $self->{'TAB'}." pitch $pitch\n" if $pitch;
464 0 0       0 $vrml .= $self->{'TAB'}." startTime $startTime\n" if defined $startTime;
465 0 0       0 $vrml .= $self->{'TAB'}." stopTime $stopTime\n" if defined $stopTime;
466 0         0 $vrml .= $self->{'TAB'}."}\n";
467 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
468 0         0 return $self;
469             }
470              
471             =item WorldInfo
472              
473             C
474              
475             =cut
476              
477             sub WorldInfo {
478 0     0 1 0 my $self = shift;
479 0         0 my ($title, $info) = @_;
480 0         0 my $vrml = "";
481 0         0 $vrml = $self->{'TAB'}."WorldInfo {\n";
482 0 0       0 $vrml .= $self->{'TAB'}." title \"".$self->utf8($title)."\"\n" if $title;
483 0 0       0 if (defined $info) {
484 0 0       0 if (ref($info) eq "ARRAY") {
485 0         0 $info = "[\"".join("\",\n$self->{'TAB'} \"",@$info)."\"]";
486             } else {
487 0         0 $info = qq{"$info"};
488             }
489 0         0 $vrml .= $self->{'TAB'}." info ".$self->utf8($info)."\n";
490             }
491 0         0 $vrml .= $self->{'TAB'}."}\n";
492 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
493 0         0 return $self;
494             }
495              
496             =item Shape
497              
498             C
499              
500             =cut
501              
502             sub Shape {
503 6     6 1 7 my $self = shift;
504 6         9 my ($geometry, $appearance) = @_;
505 6         8 my $vrml = "";
506 6         32 $vrml = $self->{'TAB'}."Shape {\n";
507 6 50       19 if (defined $appearance) {
508 6 50       16 if (ref($appearance) eq "CODE") {
509 6         11 $vrml .= $self->{'TAB'}." appearance ";
510 6         8 push @{$self->{'VRML'}}, $vrml;
  6         13  
511 6         15 $self->{'TAB'} .= "\t";
512 6         5 my $pos = $#{$self->{'VRML'}}+1;
  6         12  
513 6         14 &$appearance;
514 6         15 $self->_trim($pos);
515 6         10 chop($self->{'TAB'});
516 6         7 $vrml = "";
517             } else {
518 0         0 $vrml .= $self->{'TAB'}." appearance $appearance\n";
519             }
520             }
521 6 50       14 if (defined $geometry) {
522 6 50       16 if (ref($geometry) eq "CODE") {
523 6         12 $vrml .= $self->{'TAB'}." geometry ";
524 6         6 push @{$self->{'VRML'}}, $vrml;
  6         15  
525 6         8 $self->{'TAB'} .= "\t";
526 6         6 my $pos = $#{$self->{'VRML'}}+1;
  6         10  
527 6         16 &$geometry;
528 6         20 $self->_trim($pos);
529 6         7 chop($self->{'TAB'});
530 6         10 $vrml = "";
531             } else {
532 0         0 $vrml .= $self->{'TAB'}." geometry $geometry\n";
533             }
534             }
535 6         10 $vrml .= $self->{'TAB'}."}";
536 6 50       19 $vrml .= "# Shape" if $self->{'DEBUG'};
537 6         7 $vrml .= "\n";
538 6         5 push @{$self->{'VRML'}}, $vrml;
  6         11  
539 6         12 return $self;
540             }
541              
542             #--------------------------------------------------------------------
543              
544             =back
545              
546             =head2 Geometry
547              
548             =over 4
549              
550             =cut
551              
552             #--------------------------------------------------------------------
553              
554             =item Box
555              
556             C
557              
558             =cut
559              
560             sub Box {
561 2     2 1 2 my $self = shift;
562 2         4 my ($size) = @_;
563 2         3 my $vrml = "";
564 2         4 $vrml = $self->{'TAB'}."Box {\n";
565 2 50       17 $vrml .= $self->{'TAB'}." size $size\n" if $size;
566 2         4 $vrml .= $self->{'TAB'}."}\n";
567 2         2 push @{$self->{'VRML'}}, $vrml;
  2         5  
568 2         3 return $self;
569             }
570              
571             =item Cone
572              
573             C
574              
575             =cut
576              
577             sub Cone {
578 1     1 1 1 my $self = shift;
579 1         3 my ($radius, $height, $side, $bottom) = @_;
580 1         1 my $vrml = "";
581 1         3 $vrml = $self->{'TAB'}."Cone {\n";
582 1 50       6 $vrml .= $self->{'TAB'}." bottomRadius $radius\n" if $radius;
583 1 50       11 $vrml .= $self->{'TAB'}." height $height\n" if $height;
584 1 50       8 $vrml .= $self->{'TAB'}." side $side\n" if $side;
585 1 50       4 $vrml .= $self->{'TAB'}." bottom $bottom\n" if $bottom;
586 1         2 $vrml .= $self->{'TAB'}."}\n";
587 1         3 push @{$self->{'VRML'}}, $vrml;
  1         4  
588 1         2 return $self;
589             }
590              
591             =item Cylinder
592              
593             C
594              
595             =cut
596              
597             sub Cylinder {
598 1     1 1 2 my $self = shift;
599 1         3 my ($radius, $height, $top, $side, $bottom) = @_;
600 1         3 my $vrml = "";
601 1         3 $vrml = $self->{'TAB'}."Cylinder {\n";
602 1 50       7 $vrml .= $self->{'TAB'}." radius $radius\n" if defined $radius;
603 1 50       6 $vrml .= $self->{'TAB'}." height $height\n" if defined $height;
604 1 50       5 $vrml .= $self->{'TAB'}." top $top\n" if $top;
605 1 50       3 $vrml .= $self->{'TAB'}." side $side\n" if $side;
606 1 50       4 $vrml .= $self->{'TAB'}." bottom $bottom\n" if $bottom;
607 1         3 $vrml .= $self->{'TAB'}."}\n";
608 1         2 push @{$self->{'VRML'}}, $vrml;
  1         3  
609 1         3 return $self;
610             }
611              
612             =item ElevationGrid
613              
614             C
615              
616             $height should be a reference of a list of height values
617             like C<['0 1 3 2', '2 3 5 4', ...]>
618              
619             $color can be a reference to a subroutine or list of color values
620              
621             =cut
622              
623             sub ElevationGrid {
624 0     0 1 0 my $self = shift;
625 0         0 my ($xDimension, $zDimension, $xSpacing, $zSpacing, $height, $creaseAngle, $color, $colorPerVertex, $solid) = @_;
626 0         0 my $vrml = "";
627 0         0 $vrml = $self->{'TAB'}."ElevationGrid {\n";
628 0         0 $vrml .= $self->{'TAB'}." xDimension $xDimension\n";
629 0         0 $vrml .= $self->{'TAB'}." zDimension $zDimension\n";
630 0 0       0 $vrml .= $self->{'TAB'}." xSpacing $xSpacing\n" if defined $xSpacing;
631 0 0       0 $vrml .= $self->{'TAB'}." zSpacing $zSpacing\n" if defined $zSpacing;
632 0 0       0 $vrml .= $self->{'TAB'}." solid $solid\n" if defined $solid;
633 0 0       0 $vrml .= $self->{'TAB'}." creaseAngle $creaseAngle\n" if defined $creaseAngle;
634 0 0       0 if (ref($height) eq "ARRAY") {
635 0         0 $vrml .= $self->{'TAB'}." height [\n";
636 0         0 $vrml .= $self->{'TAB'}."\t\t";
637 0         0 $vrml .= join("$self->{'TAB'}\t\t",@$height);
638 0         0 $vrml .= $self->{'TAB'}." ]\n";
639             }
640 0 0       0 if (defined $color) {
641 0 0       0 if (ref($color) eq "ARRAY") {
642 0         0 $vrml .= $self->{'TAB'}." color Color { color [\n";
643 0         0 $vrml .= $self->{'TAB'}."\t\t";
644 0         0 $vrml .= join("$self->{'TAB'}\t\t",@$color);
645 0         0 $vrml .= $self->{'TAB'}." ] }\n";
646             } else {
647 0         0 $vrml .= $self->{'TAB'}." color $color\n";
648             }
649 0 0       0 $vrml .= $self->{'TAB'}." colorPerVertex $colorPerVertex\n" if $colorPerVertex;
650             }
651 0         0 $vrml .= $self->{'TAB'}."}\n";
652 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
653 0         0 return $self;
654             }
655              
656             =item Extrusion
657              
658             C
659              
660             $crossSection must be a reference of a list of XY values
661             like C<[ '1 1', '1 -1', '-1 -1', '-1 1', '1 1' ]>
662              
663             $spine must be a reference of a list of spine values
664             like C<['0 0 0', '0 1 0', ...]>
665              
666             =cut
667              
668             sub Extrusion {
669 0     0 1 0 my $self = shift;
670 0         0 my ($crossSection, $spine, $scale, $orientation, $beginCap, $endCap, $creaseAngle, $solid, $convex, $ccw) = @_;
671 0         0 my $vrml = "";
672 0         0 $vrml = $self->{'TAB'}."Extrusion {\n";
673 0 0       0 $vrml .= $self->{'TAB'}." beginCap $beginCap\n" if defined $beginCap;
674 0 0       0 $vrml .= $self->{'TAB'}." endCap $endCap\n" if defined $endCap;
675 0 0       0 $vrml .= $self->{'TAB'}." creaseAngle $creaseAngle\n" if defined $creaseAngle;
676 0 0       0 $vrml .= $self->{'TAB'}." solid $solid\n" if defined $solid;
677 0 0       0 $vrml .= $self->{'TAB'}." convex $convex\n" if defined $convex;
678 0 0       0 $vrml .= $self->{'TAB'}." ccw $ccw\n" if defined $ccw;
679 0 0       0 if ($crossSection) {
680 0         0 $vrml .= $self->{'TAB'}." crossSection [\n";
681 0         0 $vrml .= $self->{'TAB'}."\t\t";
682 0         0 $vrml .= join("\n$self->{'TAB'}\t\t",@$crossSection);
683 0         0 $vrml .= "\n".$self->{'TAB'}." ]\n";
684             }
685 0 0       0 if ($spine) {
686 0         0 $vrml .= $self->{'TAB'}." spine [\n";
687 0         0 $vrml .= $self->{'TAB'}."\t\t";
688 0         0 $vrml .= join("\n$self->{'TAB'}\t\t",@$spine);
689 0         0 $vrml .= "\n".$self->{'TAB'}." ]\n";
690             }
691 0 0       0 if ($scale) {
692 0         0 $vrml .= $self->{'TAB'}." scale [\n";
693 0         0 $vrml .= $self->{'TAB'}."\t\t";
694 0         0 $vrml .= join("\n$self->{'TAB'}\t\t",@$scale);
695 0         0 $vrml .= "\n".$self->{'TAB'}." ]\n";
696             }
697 0 0       0 if ($orientation) {
698 0         0 $vrml .= $self->{'TAB'}." orientation [\n";
699 0         0 $vrml .= $self->{'TAB'}."\t\t";
700 0         0 $vrml .= join("\n$self->{'TAB'}\t\t",@$orientation);
701 0         0 $vrml .= "\n".$self->{'TAB'}." ]\n";
702             }
703 0         0 $vrml .= $self->{'TAB'}."}\n";
704 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
705 0         0 return $self;
706             }
707              
708             =item IndexedFaceSet
709              
710             C
711              
712             $coordIndex can be a string with a list of point index
713             like C<'0 1 3 2', '2 3 5 4', ...> or a reference of list of point index
714              
715             $coordIndex can be a string or a reference of a list of colors index
716              
717             $normalIndex can be a string or a reference of a list of normals index
718              
719             $texCoordIndex can be a string or a reference of a list of textures index
720              
721             =cut
722              
723             sub IndexedFaceSet {
724 0     0 1 0 my $self = shift;
725 0         0 my ($coord, $coordIndex, $color, $colorIndex, $colorPerVertex, $normal, $normalIndex, $texCoord, $texCoordIndex) = @_;
726 0         0 my $vrml = "";
727 0         0 $vrml = $self->{'TAB'}."IndexedFaceSet {\n";
728 0 0       0 if (defined $coord) {
729 0 0       0 if (ref($coord) eq "CODE") {
730 0         0 $vrml .= $self->{'TAB'}." coord ";
731 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
732 0         0 $self->{'TAB'} .= "\t";
733 0         0 my $pos = $#{$self->{'VRML'}}+1;
  0         0  
734 0         0 &$coord;
735 0         0 $self->_trim($pos);
736 0         0 chop($self->{'TAB'});
737 0         0 $vrml = "";
738             } else {
739 0         0 $vrml .= $self->{'TAB'}." coord $coord\n";
740             }
741             }
742 0 0       0 if ($coordIndex) {
743 0 0       0 if (ref($coordIndex) eq "ARRAY") {
744 0         0 $vrml .= $self->{'TAB'}." coordIndex [\n";
745 0         0 $vrml .= $self->{'TAB'}."\t\t";
746 0         0 $vrml .= join(", -1,\n$self->{'TAB'}\t\t",@$coordIndex);
747 0         0 $vrml .= ", -1\n".$self->{'TAB'}." ]\n";
748             } else {
749 0         0 $vrml .= $self->{'TAB'}." coordIndex [ $coordIndex ]\n";
750             }
751             }
752 0 0       0 if (defined $color) {
753 0 0       0 if (ref($color) eq "CODE") { # Color Node
    0          
754 0         0 $vrml .= $self->{'TAB'}." color ";
755 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
756 0         0 $self->{'TAB'} .= "\t";
757 0         0 my $pos = $#{$self->{'VRML'}}+1;
  0         0  
758 0         0 &$color;
759 0         0 $self->_trim($pos);
760 0         0 chop($self->{'TAB'});
761 0         0 $vrml = "";
762             } elsif (ref($colorIndex) eq "ARRAY") {
763 0         0 $vrml .= $self->{'TAB'}." color Color { color [\n";
764 0         0 $vrml .= $self->{'TAB'}."\t\t";
765 0         0 $vrml .= join(",\n$self->{'TAB'}\t\t",@$colorIndex);
766 0         0 $vrml .= "\n".$self->{'TAB'}." ] }\n";
767             } else {
768 0         0 $vrml .= $self->{'TAB'}." color $color\n";
769             }
770 0 0       0 if ($colorIndex) {
771 0         0 $vrml .= $self->{'TAB'}." colorIndex [\n";
772 0 0       0 if (ref($colorIndex) eq "ARRAY") {
773 0         0 $vrml .= $self->{'TAB'}."\t\t";
774 0 0 0     0 if (defined $colorPerVertex && $colorPerVertex eq "FALSE") {
775 0         0 $vrml .= join(",\n$self->{'TAB'}\t\t",@$colorIndex);
776             } else {
777 0         0 $vrml .= join(", -1\n$self->{'TAB'}\t\t",@$colorIndex);
778             }
779             } else {
780 0         0 $vrml .= $colorIndex;
781             }
782 0         0 $vrml .= "\n".$self->{'TAB'}." ]\n";
783             }
784 0 0       0 $vrml .= $self->{'TAB'}." colorPerVertex $colorPerVertex\n" if $colorPerVertex;
785             }
786 0 0       0 if ($normalIndex) {
787 0 0       0 if (ref($normalIndex) eq "ARRAY") {
788 0         0 $vrml .= $self->{'TAB'}." normalIndex [\n";
789 0         0 $vrml .= $self->{'TAB'}."\t\t";
790 0         0 $vrml .= join(", -1,\n$self->{'TAB'}\t\t",@$normalIndex);
791 0         0 $vrml .= ", -1\n".$self->{'TAB'}." ]\n";
792             } else {
793 0         0 $vrml .= $self->{'TAB'}." normalIndex [ $normalIndex ]\n";
794             }
795             }
796 0 0       0 if ($texCoordIndex) {
797 0 0       0 if (ref($texCoordIndex) eq "ARRAY") {
798 0         0 $vrml .= $self->{'TAB'}." texCoordIndex [\n";
799 0         0 $vrml .= $self->{'TAB'}."\t\t";
800 0         0 $vrml .= join(", -1,\n$self->{'TAB'}\t\t",@$texCoordIndex);
801 0         0 $vrml .= ", -1\n".$self->{'TAB'}." ]\n";
802             } else {
803 0         0 $vrml .= $self->{'TAB'}." texCoordIndex [ $texCoordIndex ]\n";
804             }
805             }
806 0         0 $vrml .= $self->{'TAB'}."}\n";
807 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
808 0         0 return $self;
809             }
810              
811             =item IndexedLineSet
812              
813             C
814              
815             $coord can be a string with the C node or a reference to a
816             C method
817              
818             $coordIndex can be a string or a reference of a list of point index
819             like C<'0, 1, 3, 2', '2, 3, 5, 4', ...>
820              
821             $color can be a string with the node or a reference of a method
822              
823             $colorIndex can be a string or a reference of a list of color index
824              
825             =cut
826              
827             sub IndexedLineSet {
828 0     0 1 0 my $self = shift;
829 0         0 my ($coord, $coordIndex, $color, $colorIndex, $colorPerVertex) = @_;
830 0         0 my $vrml = "";
831 0         0 $vrml = $self->{'TAB'}."IndexedLineSet {\n";
832 0 0       0 if (defined $coord) {
833 0 0       0 if (ref($coord) eq "CODE") {
834 0         0 $vrml .= $self->{'TAB'}." coord ";
835 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
836 0         0 $self->{'TAB'} .= "\t";
837 0         0 my $pos = $#{$self->{'VRML'}}+1;
  0         0  
838 0         0 &$coord;
839 0         0 $self->_trim($pos);
840 0         0 chop($self->{'TAB'});
841 0         0 $vrml = "";
842             } else {
843 0         0 $vrml .= $self->{'TAB'}." coord $coord\n";
844             }
845             }
846 0 0       0 if ($coordIndex) {
847 0 0       0 if (ref($coordIndex) eq "ARRAY") {
848 0         0 $vrml .= $self->{'TAB'}." coordIndex [\n";
849 0         0 $vrml .= $self->{'TAB'}."\t\t";
850 0         0 $vrml .= join(", -1,\n$self->{'TAB'}\t\t",@$coordIndex);
851 0         0 $vrml .= ", -1\n".$self->{'TAB'}." ]\n";
852             } else {
853 0         0 $vrml .= $self->{'TAB'}." coordIndex [ $coordIndex ]\n";
854             }
855             }
856 0 0       0 if (defined $color) {
857 0 0       0 if (ref($color) eq "CODE") {
858 0         0 $vrml .= $self->{'TAB'}." color ";
859 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
860 0         0 $self->{'TAB'} .= "\t";
861 0         0 my $pos = $#{$self->{'VRML'}}+1;
  0         0  
862 0         0 &$color;
863 0         0 $self->_trim($pos);
864 0         0 chop($self->{'TAB'});
865 0         0 $vrml = "";
866             } else {
867 0         0 $vrml .= $self->{'TAB'}." color $color\n";
868             }
869 0 0       0 if ($colorIndex) {
870 0         0 $vrml .= $self->{'TAB'}." colorIndex [\n";
871 0 0       0 if (ref($colorIndex) eq "ARRAY") {
872 0         0 $vrml .= $self->{'TAB'}."\t\t";
873 0 0 0     0 if (defined $colorPerVertex && $colorPerVertex eq "FALSE") {
874 0         0 $vrml .= join(",\n$self->{'TAB'}\t\t",@$colorIndex);
875             } else {
876 0         0 $vrml .= join(", -1\n$self->{'TAB'}\t\t",@$colorIndex);
877             }
878             } else {
879 0         0 $vrml .= $colorIndex;
880             }
881 0         0 $vrml .= "\n".$self->{'TAB'}." ]\n";
882             }
883 0 0       0 $vrml .= $self->{'TAB'}." colorPerVertex $colorPerVertex\n" if $colorPerVertex;
884             }
885 0         0 $vrml .= $self->{'TAB'}."}\n";
886 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
887 0         0 return $self;
888             }
889              
890             =item PointSet
891              
892             C
893              
894             =cut
895              
896             sub PointSet {
897 0     0 1 0 my $self = shift;
898 0         0 my ($coord, $color) = @_;
899 0         0 my $vrml = "";
900 0         0 $vrml = $self->{'TAB'}."PointSet {\n";
901 0 0       0 if (defined $coord) {
902 0 0       0 if (ref($coord) eq "CODE") {
903 0         0 $vrml .= $self->{'TAB'}." coord ";
904 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
905 0         0 $self->{'TAB'} .= "\t";
906 0         0 my $pos = $#{$self->{'VRML'}}+1;
  0         0  
907 0         0 &$coord;
908 0         0 $self->_trim($pos);
909 0         0 chop($self->{'TAB'});
910 0         0 $vrml = "";
911             } else {
912 0         0 $vrml .= $self->{'TAB'}." coord $coord\n";
913             }
914             }
915 0 0       0 if (defined $color) {
916 0 0       0 if (ref($color) eq "CODE") {
917 0         0 $vrml .= $self->{'TAB'}." color ";
918 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
919 0         0 $self->{'TAB'} .= "\t";
920 0         0 my $pos = $#{$self->{'VRML'}}+1;
  0         0  
921 0         0 &$color;
922 0         0 $self->_trim($pos);
923 0         0 chop($self->{'TAB'});
924 0         0 $vrml = "";
925             } else {
926 0         0 $vrml .= $self->{'TAB'}." color $color\n";
927             }
928             }
929 0         0 $vrml .= $self->{'TAB'}."}\n";
930 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
931 0         0 return $self;
932             }
933              
934             =item Sphere
935              
936             C
937              
938             $radius have to be > 0
939              
940             =cut
941              
942             sub Sphere {
943 1     1 1 2 my $self = shift;
944 1         2 my ($radius) = @_;
945 1         2 my $vrml = "";
946 1         3 $vrml = $self->{'TAB'}."Sphere {\n";
947 1 50       6 $vrml .= $self->{'TAB'}." radius $radius\n" if $radius;
948 1         2 $vrml .= $self->{'TAB'}."}\n";
949 1         3 push @{$self->{'VRML'}}, $vrml;
  1         2  
950 1         2 return $self;
951             }
952              
953             =item Text
954              
955             C
956              
957             =cut
958              
959             sub Text {
960 1     1 1 2 my $self = shift;
961 1         3 my ($string, $fontStyle, $length, $maxExtent) = @_;
962 1 50       3 return unless $string;
963 1         3 my $vrml = $self->{'TAB'}."Text {\n";
964 1         10 $vrml .= $self->{'TAB'}." string ".$self->utf8($string)."\n";
965 1 50       4 if (defined $fontStyle) {
966 1 50       4 if (ref($fontStyle) eq "CODE") { # FontStyle Node
967 1         4 $vrml .= $self->{'TAB'}." fontStyle ";
968 1         2 push @{$self->{'VRML'}}, $vrml;
  1         3  
969 1         2 $self->{'TAB'} .= "\t";
970 1         2 my $pos = $#{$self->{'VRML'}}+1;
  1         3  
971 1         3 &$fontStyle;
972 1         4 $self->_trim($pos);
973 1         2 chop($self->{'TAB'});
974 1         3 $vrml = "";
975             } else {
976 0         0 $vrml .= $self->{'TAB'}." fontStyle $fontStyle\n";
977             }
978             }
979 1 50       4 $vrml .= $self->{'TAB'}." length $length\n" if $length;
980 1 50       4 $vrml .= $self->{'TAB'}." maxExtent $maxExtent\n" if $maxExtent;
981 1         4 $vrml .= $self->{'TAB'}."}\n";
982 1         2 push @{$self->{'VRML'}}, $vrml;
  1         4  
983 1         1 return $self;
984             }
985              
986             #--------------------------------------------------------------------
987              
988             =back
989              
990             =head2 Geometric Properties
991              
992             =over 4
993              
994             =cut
995              
996             #--------------------------------------------------------------------
997              
998             =item Coordinate
999              
1000             C
1001              
1002             @point should be a list of points with strings like C<'1.0 0.0 0.0', '-1 2 0'>
1003              
1004             =cut
1005              
1006             sub Coordinate {
1007 0     0 1 0 my $self = shift;
1008 0         0 my (@point) = @_;
1009 0         0 my $vrml = "";
1010 0         0 $vrml = $self->{'TAB'}."Coordinate {\n";
1011 0         0 $vrml .= $self->{'TAB'}." point [\n";
1012 0         0 $vrml .= $self->{'TAB'}."\t\t";
1013 0         0 $vrml .= join(",\n$self->{'TAB'}\t\t",@point);
1014 0         0 $vrml .= "\n".$self->{'TAB'}." ]\n";
1015 0         0 $vrml .= $self->{'TAB'}."}\n";
1016 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
1017 0         0 return $self;
1018             }
1019              
1020             =item Color
1021              
1022             C
1023              
1024             @color should be a list of colors with strings like C<'1.0 0.0 0.0', '.3 .2 .1'>
1025              
1026             =cut
1027              
1028             sub Color {
1029 0     0 1 0 my $self = shift;
1030 0         0 my (@color) = @_;
1031 0         0 my $vrml = "";
1032 0         0 $vrml = $self->{'TAB'}."Color {\n";
1033 0         0 $vrml .= $self->{'TAB'}." color [\n";
1034 0         0 $vrml .= $self->{'TAB'}."\t\t";
1035 0         0 $vrml .= join(",\n$self->{'TAB'}\t\t",@color);
1036 0         0 $vrml .= "\n".$self->{'TAB'}." ]\n";
1037 0         0 $vrml .= $self->{'TAB'}."}\n";
1038 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
1039 0         0 return $self;
1040             }
1041              
1042             =item Normal
1043              
1044             C
1045              
1046             @vector should be a list of vectors with strings like C<'1.0 0.0 0.0', '.4 .2 0'>
1047              
1048             =cut
1049              
1050             sub Normal {
1051 0     0 1 0 my $self = shift;
1052 0         0 my (@vector) = @_;
1053 0         0 my $vrml = "";
1054 0         0 $vrml = $self->{'TAB'}."Normal {\n";
1055 0         0 $vrml .= $self->{'TAB'}." vector [\n$self->{'TAB'}\t\t";
1056 0         0 $vrml .= join(",\n$self->{'TAB'}\t\t",@vector);
1057 0         0 $vrml .= "\n".$self->{'TAB'}."\t]\n";
1058 0         0 $vrml .= $self->{'TAB'}."}\n";
1059 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
1060 0         0 return $self;
1061             }
1062              
1063              
1064             #--------------------------------------------------------------------
1065              
1066             =back
1067              
1068             =head2 Appearance
1069              
1070             =over 4
1071              
1072             =cut
1073              
1074             #--------------------------------------------------------------------
1075              
1076             =item Appearance
1077              
1078             C
1079              
1080             =cut
1081              
1082             sub Appearance {
1083 6     6 1 9 my $self = shift;
1084 6         8 my ($material, $texture, $textureTransform) = @_;
1085 6         9 my $vrml = "";
1086 6         11 $vrml = $self->{'TAB'}."Appearance {\n";
1087 6 50       26 if (defined $material) {
1088 6         13 $vrml .= $self->{'TAB'}." material ";
1089 6 50       14 if (ref($material)) {
1090 6         5 push @{$self->{'VRML'}}, $vrml;
  6         13  
1091 6         9 $vrml = "";
1092 6         7 $self->{'TAB'} .= "\t";
1093 6         6 my $pos = $#{$self->{'VRML'}}+1;
  6         10  
1094 6 50       14 if (ref($material) eq "CODE") { # Material Node
    0          
    0          
1095 6         14 &$material;
1096             } elsif (ref($material) eq "ARRAY") {
1097 0         0 $self->Material(@$material);
1098             } elsif (ref($material) eq "HASH") {
1099 0         0 $self->Material(%$material);
1100             }
1101 6         37 $self->_trim($pos);
1102 6         9 chop($self->{'TAB'});
1103             } else {
1104 0         0 $vrml .= "Material {$material}\n";
1105             }
1106             }
1107 6 50       13 if (defined $texture) {
1108 0 0       0 if (ref($texture) eq "CODE") {
1109 0         0 $vrml .= $self->{'TAB'}." texture ";
1110 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
1111 0         0 $self->{'TAB'} .= "\t";
1112 0         0 my $pos = $#{$self->{'VRML'}}+1;
  0         0  
1113 0         0 &$texture;
1114 0         0 $self->_trim($pos);
1115 0         0 chop($self->{'TAB'});
1116 0         0 $vrml = "";
1117             } else {
1118 0         0 $vrml .= $self->{'TAB'}." texture $texture\n";
1119             }
1120             }
1121 6 50       10 if (defined $textureTransform) {
1122 0 0       0 if (ref($textureTransform) eq "CODE") {
1123 0         0 $vrml .= $self->{'TAB'}." textureTransform ";
1124 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
1125 0         0 $self->{'TAB'} .= "\t";
1126 0         0 my $pos = $#{$self->{'VRML'}}+1;
  0         0  
1127 0         0 &$textureTransform;
1128 0         0 $self->_trim($pos);
1129 0         0 chop($self->{'TAB'});
1130 0         0 $vrml = "";
1131             } else {
1132 0         0 $vrml .= $self->{'TAB'}." textureTransform $textureTransform\n";
1133             }
1134             }
1135 6         12 $vrml .= $self->{'TAB'}."}\n";
1136 6         7 push @{$self->{'VRML'}}, $vrml;
  6         15  
1137 6         11 return $self;
1138             }
1139              
1140             =item Fontstyle
1141              
1142             C
1143             defines the current font style for the current C Nodes
1144              
1145              
1146             $style can be 'PLAIN','BOLD','ITALIC','BOLD ITALIC'
1147              
1148             $familiy can be 'SERIF','SANS','TYPEWRITER'
1149              
1150             $justify can be 'BEGIN', 'MIDDLE', 'END'
1151              
1152             =cut
1153              
1154             sub FontStyle {
1155 1     1 0 2 my $self = shift;
1156 1         3 my ($size, $family, $style, $justify, $language) = @_;
1157 1         2 my $vrml = "";
1158 1         3 $vrml = $self->{'TAB'}."FontStyle {\n";
1159 1 50       5 $vrml .= $self->{'TAB'}." size $size\n" if $size;
1160 1 50       7 $vrml .= $self->{'TAB'}." family \"$family\"\n" if $family;
1161 1 50       5 $vrml .= $self->{'TAB'}." style \"$style\"\n" if $style;
1162 1 50       3 $vrml .= $self->{'TAB'}." justify \"$justify\"\n" if $justify;
1163 1 50       4 $vrml .= $self->{'TAB'}." language \"$language\"\n" if $language;
1164 1         2 $vrml .= $self->{'TAB'}."}\n";
1165 1         2 push @{$self->{'VRML'}}, $vrml;
  1         12  
1166 1         2 return $self;
1167             }
1168              
1169             =item Material
1170              
1171             C
1172              
1173             =cut
1174              
1175             sub Material {
1176 6     6 1 6 my $self = shift;
1177 6         17 my (%materials) = @_;
1178 6         8 my $vrml = "";
1179 6         7 my ($key, $value);
1180 6         11 $vrml = $self->{'TAB'}."Material {\n";
1181 6         28 while(($key,$value) = each %materials) {
1182 6         32 $vrml .= $self->{'TAB'}." $key $value\n";
1183             }
1184 6         9 $vrml .= $self->{'TAB'}."}\n";
1185 6         5 push @{$self->{'VRML'}}, $vrml;
  6         14  
1186 6         15 return $self;
1187             }
1188              
1189             =item ImageTexture
1190              
1191             C
1192              
1193             =cut
1194              
1195             sub ImageTexture {
1196 0     0 1   my $self = shift;
1197 0           my ($url, $repeatS, $repeatT) = @_;
1198 0           my $vrml = "";
1199 0           $vrml = $self->{'TAB'}."ImageTexture {\n";
1200 0           $vrml .= $self->{'TAB'}." url \"".$self->escape($url)."\"\n";
1201 0 0         $vrml .= $self->{'TAB'}." repeatS $repeatS\n" if $repeatS;
1202 0 0         $vrml .= $self->{'TAB'}." repeatT $repeatT\n" if $repeatT;
1203 0           $vrml .= $self->{'TAB'}."}\n";
1204 0           push @{$self->{'VRML'}}, $vrml;
  0            
1205 0           return $self;
1206             }
1207              
1208             =item MovieTexture
1209              
1210             C
1211              
1212             =cut
1213              
1214             sub MovieTexture {
1215 0     0 1   my $self = shift;
1216 0           my ($url, $loop, $startTime, $stopTime, $repeatS, $repeatT) = @_;
1217 0           my $vrml = "";
1218 0           $vrml = $self->{'TAB'}."MovieTexture {\n";
1219 0           $vrml .= $self->{'TAB'}." url \"".$self->escape($url)."\"\n";
1220 0 0         $vrml .= $self->{'TAB'}." loop $loop\n" if $loop;
1221 0 0         $vrml .= $self->{'TAB'}." startTime $startTime\n" if $startTime;
1222 0 0         $vrml .= $self->{'TAB'}." stopTime $stopTime\n" if $stopTime;
1223 0 0         $vrml .= $self->{'TAB'}." repeatS $repeatS\n" if $repeatS;
1224 0 0         $vrml .= $self->{'TAB'}." repeatT $repeatT\n" if $repeatT;
1225 0           $vrml .= $self->{'TAB'}."}\n";
1226 0           push @{$self->{'VRML'}}, $vrml;
  0            
1227 0           return $self;
1228             }
1229              
1230             #--------------------------------------------------------------------
1231              
1232             =back
1233              
1234             =head2 Sensors
1235              
1236             =over 4
1237              
1238             =cut
1239              
1240             #--------------------------------------------------------------------
1241              
1242             =item CylinderSensor
1243              
1244             C
1245              
1246             =cut
1247              
1248             sub CylinderSensor {
1249 0     0 1   my $self = shift;
1250 0           my ($maxAngle, $minAngle, $diskAngle, $offset, $autoOffset, $enabled) = @_;
1251 0           my $vrml = "";
1252 0           $vrml = $self->{'TAB'}."CylinderSensor {\n";
1253 0 0         $vrml .= $self->{'TAB'}." maxAngle $maxAngle\n" if defined $maxAngle;
1254 0 0         $vrml .= $self->{'TAB'}." minAngle $minAngle\n" if defined $minAngle;
1255 0 0         $vrml .= $self->{'TAB'}." diskAngle $diskAngle\n" if defined $diskAngle;
1256 0 0         $vrml .= $self->{'TAB'}." offset $offset\n" if $offset;
1257 0 0         $vrml .= $self->{'TAB'}." autoOffset $autoOffset\n" if $autoOffset;
1258 0 0         $vrml .= $self->{'TAB'}." enabled $enabled\n" if $enabled;
1259 0           $vrml .= $self->{'TAB'}."}\n";
1260 0           push @{$self->{'VRML'}}, $vrml;
  0            
1261 0           return $self;
1262             }
1263              
1264             =item PlaneSensor
1265              
1266             C
1267              
1268             =cut
1269              
1270             sub PlaneSensor {
1271 0     0 1   my $self = shift;
1272 0           my ($maxPosition, $minPosition, $offset, $autoOffset, $enabled) = @_;
1273 0           my $vrml = "";
1274 0           $vrml = $self->{'TAB'}."PlaneSensor {\n";
1275 0 0         $vrml .= $self->{'TAB'}." maxPosition $maxPosition\n" if $maxPosition;
1276 0 0         $vrml .= $self->{'TAB'}." minPosition $minPosition\n" if $minPosition;
1277 0 0         $vrml .= $self->{'TAB'}." offset $offset\n" if defined $offset;
1278 0 0         $vrml .= $self->{'TAB'}." autoOffset $autoOffset\n" if $autoOffset;
1279 0 0         $vrml .= $self->{'TAB'}." enabled $enabled\n" if $enabled;
1280 0           $vrml .= $self->{'TAB'}."}\n";
1281 0           push @{$self->{'VRML'}}, $vrml;
  0            
1282 0           return $self;
1283             }
1284              
1285             =item ProximitySensor
1286              
1287             C
1288              
1289             =cut
1290              
1291             sub ProximitySensor {
1292 0     0 1   my $self = shift;
1293 0           my ($size, $center, $enabled) = @_;
1294 0           my $vrml = "";
1295 0           $vrml = $self->{'TAB'}."ProximitySensor {\n";
1296 0 0         $vrml .= $self->{'TAB'}." size $size\n" if $size;
1297 0 0         $vrml .= $self->{'TAB'}." center $center\n" if $center;
1298 0 0         $vrml .= $self->{'TAB'}." enabled $enabled\n" if $enabled;
1299 0           $vrml .= $self->{'TAB'}."}\n";
1300 0           push @{$self->{'VRML'}}, $vrml;
  0            
1301 0           return $self;
1302             }
1303              
1304             =item SphereSensor
1305              
1306             C
1307              
1308             =cut
1309              
1310             sub SphereSensor {
1311 0     0 1   my $self = shift;
1312 0           my ($offset, $autoOffset, $enabled) = @_;
1313 0           my $vrml = "";
1314 0           $vrml = $self->{'TAB'}."SphereSensor {\n";
1315 0 0         $vrml .= $self->{'TAB'}." offset $offset\n" if $offset;
1316 0 0         $vrml .= $self->{'TAB'}." autoOffset $autoOffset\n" if $autoOffset;
1317 0 0         $vrml .= $self->{'TAB'}." enabled $enabled\n" if $enabled;
1318 0           $vrml .= $self->{'TAB'}."}\n";
1319 0           push @{$self->{'VRML'}}, $vrml;
  0            
1320 0           return $self;
1321             }
1322              
1323             =item TimeSensor
1324              
1325             C
1326              
1327             =cut
1328              
1329             sub TimeSensor {
1330 0     0 1   my $self = shift;
1331 0           my ($cycleInterval, $loop, $startTime, $stopTime, $enabled) = @_;
1332 0           my $vrml = "";
1333 0           $vrml = $self->{'TAB'}."TimeSensor {\n";
1334 0 0         $vrml .= $self->{'TAB'}." cycleInterval $cycleInterval\n" if $cycleInterval;
1335 0 0         $vrml .= $self->{'TAB'}." loop $loop\n" if $loop;
1336 0 0         $vrml .= $self->{'TAB'}." startTime $startTime\n" if $startTime;
1337 0 0         $vrml .= $self->{'TAB'}." stopTime $stopTime\n" if $stopTime;
1338 0 0         $vrml .= $self->{'TAB'}." enabled $enabled\n" if $enabled;
1339 0           $vrml .= $self->{'TAB'}."}\n";
1340 0           push @{$self->{'VRML'}}, $vrml;
  0            
1341 0           return $self;
1342             }
1343              
1344             =item TouchSensor
1345              
1346             C
1347              
1348             =cut
1349              
1350             sub TouchSensor {
1351 0     0 1   my $self = shift;
1352 0           my ($enabled) = @_;
1353 0           my $vrml = "";
1354 0           $vrml = $self->{'TAB'}."TouchSensor {";
1355 0 0         $vrml .= $self->{'TAB'}." enabled $enabled\n" if $enabled;
1356 0           $vrml .= "}\n";
1357 0           push @{$self->{'VRML'}}, $vrml;
  0            
1358 0           return $self;
1359             }
1360              
1361             =item VisibilitySensor
1362              
1363             C
1364              
1365             =cut
1366              
1367             sub VisibilitySensor {
1368 0     0 1   my $self = shift;
1369 0           my ($size, $center, $enabled) = @_;
1370 0           my $vrml = "";
1371 0           $vrml = $self->{'TAB'}."VisibilitySensor {\n";
1372 0 0         $vrml .= $self->{'TAB'}." size $size\n" if $size;
1373 0 0         $vrml .= $self->{'TAB'}." center $center\n" if $center;
1374 0 0         $vrml .= $self->{'TAB'}." enabled $enabled\n" if $enabled;
1375 0           $vrml .= $self->{'TAB'}."}\n";
1376 0           push @{$self->{'VRML'}}, $vrml;
  0            
1377 0           return $self;
1378             }
1379              
1380             #--------------------------------------------------------------------
1381              
1382             =back
1383              
1384             =head2 Interpolators
1385              
1386             =over 4
1387              
1388             =cut
1389              
1390             #--------------------------------------------------------------------
1391              
1392             =item ColorInterpolator
1393              
1394             C
1395              
1396             =cut
1397              
1398             sub ColorInterpolator {
1399 0     0 1   my $self = shift;
1400 0           my ($key, $keyValue) = @_;
1401 0           my $vrml = "";
1402 0           $vrml = $self->{'TAB'}."ColorInterpolator {\n";
1403 0 0         if (ref($key) eq "ARRAY") {
1404 0           $vrml .= $self->{'TAB'}." key [\n$self->{'TAB'}\t\t".join(",\n$self->{'TAB'}\t\t",@$key)."\n$self->{'TAB'}\t]\n";
1405             } else {
1406 0           $vrml .= $self->{'TAB'}." key [$key]\n";
1407             }
1408 0 0         if (ref($keyValue) eq "ARRAY") {
1409 0           $vrml .= $self->{'TAB'}." keyValue [\n$self->{'TAB'}\t\t".join(",\n$self->{'TAB'}\t\t",@$keyValue)."\n$self->{'TAB'}\t]\n";
1410             } else {
1411 0           $vrml .= $self->{'TAB'}." keyValue [$keyValue]\n";
1412             }
1413 0           $vrml .= $self->{'TAB'}."}\n";
1414 0           push @{$self->{'VRML'}}, $vrml;
  0            
1415 0           return $self;
1416             }
1417              
1418             =item CoordinateInterpolator
1419              
1420             C
1421              
1422             =cut
1423              
1424             sub CoordinateInterpolator {
1425 0     0 1   my $self = shift;
1426 0           my ($key, $keyValue) = @_;
1427 0           my $vrml = "";
1428 0           $vrml = $self->{'TAB'}."CoordinateInterpolator {\n";
1429 0 0         if (ref($key) eq "ARRAY") {
1430 0           $vrml .= $self->{'TAB'}." key [\n$self->{'TAB'}\t\t".join(",\n$self->{'TAB'}\t\t",@$key)."\n$self->{'TAB'}\t]\n";
1431             } else {
1432 0           $vrml .= $self->{'TAB'}." key [$key]\n";
1433             }
1434 0 0         if (ref($keyValue) eq "ARRAY") {
1435 0           $vrml .= $self->{'TAB'}." keyValue [\n$self->{'TAB'}\t\t".join(",\n$self->{'TAB'}\t\t",@$keyValue)."\n$self->{'TAB'}\t]\n";
1436             } else {
1437 0           $vrml .= $self->{'TAB'}." keyValue [$keyValue]\n";
1438             }
1439 0           $vrml .= $self->{'TAB'}."}\n";
1440 0           push @{$self->{'VRML'}}, $vrml;
  0            
1441 0           return $self;
1442             }
1443              
1444             =item OrientationInterpolator
1445              
1446             C
1447              
1448             =cut
1449              
1450             sub OrientationInterpolator {
1451 0     0 1   my $self = shift;
1452 0           my ($key, $keyValue) = @_;
1453 0           my $vrml = "";
1454 0           $vrml = $self->{'TAB'}."OrientationInterpolator {\n";
1455 0 0         if (ref($key) eq "ARRAY") {
1456 0           $vrml .= $self->{'TAB'}." key [\n$self->{'TAB'}\t\t".join(",\n$self->{'TAB'}\t\t",@$key)."\n$self->{'TAB'}\t]\n";
1457             } else {
1458 0           $vrml .= $self->{'TAB'}." key [$key]\n";
1459             }
1460 0 0         if (ref($keyValue) eq "ARRAY") {
1461 0           $vrml .= $self->{'TAB'}." keyValue [\n$self->{'TAB'}\t\t".join(",\n$self->{'TAB'}\t\t",@$keyValue)."\n$self->{'TAB'}\t]\n";
1462             } else {
1463 0           $vrml .= $self->{'TAB'}." keyValue [$keyValue]\n";
1464             }
1465 0           $vrml .= $self->{'TAB'}."}\n";
1466 0           push @{$self->{'VRML'}}, $vrml;
  0            
1467 0           return $self;
1468             }
1469              
1470             =item NormalInterpolator
1471              
1472             C
1473              
1474             =cut
1475              
1476             sub NormalInterpolator {
1477 0     0 1   my $self = shift;
1478 0           my ($key, $keyValue) = @_;
1479 0           my $vrml = "";
1480 0           $vrml = $self->{'TAB'}."NormalInterpolator {\n";
1481 0 0         if (ref($key) eq "ARRAY") {
1482 0           $vrml .= $self->{'TAB'}." key [\n$self->{'TAB'}\t\t".join(",\n$self->{'TAB'}\t\t",@$key)."\n$self->{'TAB'}\t]\n";
1483             } else {
1484 0           $vrml .= $self->{'TAB'}." key [$key]\n";
1485             }
1486 0 0         if (ref($keyValue) eq "ARRAY") {
1487 0           $vrml .= $self->{'TAB'}." keyValue [\n$self->{'TAB'}\t\t".join(",\n$self->{'TAB'}\t\t",@$keyValue)."\n$self->{'TAB'}\t]\n";
1488             } else {
1489 0           $vrml .= $self->{'TAB'}." keyValue [$keyValue]\n";
1490             }
1491 0           $vrml .= $self->{'TAB'}."}\n";
1492 0           push @{$self->{'VRML'}}, $vrml;
  0            
1493 0           return $self;
1494             }
1495              
1496             =item PositionInterpolator
1497              
1498             C
1499              
1500             =cut
1501              
1502             sub PositionInterpolator {
1503 0     0 1   my $self = shift;
1504 0           my ($key, $keyValue) = @_;
1505 0           my $vrml = "";
1506 0           $vrml = $self->{'TAB'}."PositionInterpolator {\n";
1507 0 0         if (ref($key) eq "ARRAY") {
1508 0           $vrml .= $self->{'TAB'}." key [\n$self->{'TAB'}\t\t".join(",\n$self->{'TAB'}\t\t",@$key)."\n$self->{'TAB'}\t]\n";
1509             } else {
1510 0           $vrml .= $self->{'TAB'}." key [$key]\n";
1511             }
1512 0 0         if (ref($keyValue) eq "ARRAY") {
1513 0           $vrml .= $self->{'TAB'}." keyValue [\n$self->{'TAB'}\t\t".join(",\n$self->{'TAB'}\t\t",@$keyValue)."\n$self->{'TAB'}\t]\n";
1514             } else {
1515 0           $vrml .= $self->{'TAB'}." keyValue [$keyValue]\n";
1516             }
1517 0           $vrml .= $self->{'TAB'}."}\n";
1518 0           push @{$self->{'VRML'}}, $vrml;
  0            
1519 0           return $self;
1520             }
1521              
1522             =item ScalarInterpolator
1523              
1524             C
1525              
1526             $key MFFloat
1527             $keyValue MFFloat
1528              
1529             =cut
1530              
1531             sub ScalarInterpolator {
1532 0     0 1   my $self = shift;
1533 0           my ($key, $keyValue) = @_;
1534 0           my $vrml = "";
1535 0           $vrml = $self->{'TAB'}."ScalarInterpolator {\n";
1536 0 0         if (ref($key) eq "ARRAY") {
1537 0           $vrml .= $self->{'TAB'}." key [\n$self->{'TAB'}\t\t".join(",\n$self->{'TAB'}\t\t",@$key)."\n$self->{'TAB'}\t]\n";
1538             } else {
1539 0           $vrml .= $self->{'TAB'}." key [$key]\n";
1540             }
1541 0 0         if (ref($keyValue) eq "ARRAY") {
1542 0           $vrml .= $self->{'TAB'}." keyValue [\n$self->{'TAB'}\t\t".join(",\n$self->{'TAB'}\t\t",@$keyValue)."\n$self->{'TAB'}\t]\n";
1543             } else {
1544 0           $vrml .= $self->{'TAB'}." keyValue [$keyValue]\n";
1545             }
1546 0           $vrml .= $self->{'TAB'}."}\n";
1547 0           push @{$self->{'VRML'}}, $vrml;
  0            
1548 0           return $self;
1549             }
1550              
1551             #--------------------------------------------------------------------
1552              
1553             =back
1554              
1555             =head2 Bindable Nodes
1556              
1557             =over 4
1558              
1559             =cut
1560              
1561             #--------------------------------------------------------------------
1562              
1563             =item Background
1564              
1565             C
1566              
1567             You only can use a hash. Parameter see VRML Spec
1568              
1569             =cut
1570              
1571             sub Background {
1572 0     0 1   my $self = shift;
1573 0           my (%hash) = @_;
1574 0 0         return unless %hash;
1575 0           my $key;
1576 0           my $vrml = "";
1577 0           $vrml = $self->{'TAB'}."Background {\n";
1578 0           foreach $key (keys %hash) {
1579 0 0         $vrml .= $self->{'TAB'}." $key $hash{$key}\n" if defined $hash{$key};
1580             }
1581 0           $vrml .= $self->{'TAB'}."}\n";
1582 0           push @{$self->{'VRML'}}, $vrml;
  0            
1583 0           return $self;
1584             }
1585              
1586             =item NavigationInfo
1587              
1588             C
1589              
1590             You can use a hash reference or all parameter in the same order above
1591              
1592             =cut
1593              
1594             sub NavigationInfo {
1595 0     0 1   my $self = shift;
1596 0           my ($type, $speed, $headlight, $visibilityLimit, $avatarSize) = @_;
1597 0           my $key;
1598 0           my $vrml = "";
1599 0           $vrml = $self->{'TAB'}."NavigationInfo {\n";
1600 0 0         if (ref($type) eq "HASH") {
1601 0           foreach $key (keys %$type) {
1602 0 0         if (ref($type->{$key}) eq "ARRAY") {
1603 0           $vrml .= $self->{'TAB'}." $key [".join('","',@{$type->{$key}})."]\n";
  0            
1604             } else {
1605 0           $vrml .= $self->{'TAB'}." $key $type->{$key}\n";
1606             }
1607             }
1608             } else {
1609 0 0         $type = join('","',@$type) if ref($type) eq "ARRAY";
1610 0 0         $vrml .= $self->{'TAB'}." type [\"$type\"]\n" if $type;
1611 0 0         $vrml .= $self->{'TAB'}." speed $speed\n" if defined $speed;
1612 0 0         $vrml .= $self->{'TAB'}." headlight $headlight\n" if $headlight;
1613 0 0         $vrml .= $self->{'TAB'}." visibilityLimit $visibilityLimit\n" if defined $visibilityLimit;
1614 0 0         $avatarSize = join(', ',@$avatarSize) if ref($avatarSize) eq "ARRAY";
1615 0 0         $vrml .= $self->{'TAB'}." avatarSize [$avatarSize]\n" if $avatarSize;
1616             }
1617 0           $vrml .= $self->{'TAB'}."}\n";
1618 0           push @{$self->{'VRML'}}, $vrml;
  0            
1619 0           return $self;
1620             }
1621              
1622             =item Viewpoint
1623              
1624             C
1625              
1626             =cut
1627              
1628             sub Viewpoint {
1629 0     0 1   my $self = shift;
1630 0           my ($description, $position, $orientation, $fieldOfView, $jump) = @_;
1631 0           my $vrml = "";
1632 0           $vrml = $self->{'TAB_VIEW'}."Viewpoint {\n";
1633 0 0         $vrml .= $self->{'TAB_VIEW'}." description \"".$self->utf8($description)."\"\n" if $description;
1634 0 0         $vrml .= $self->{'TAB_VIEW'}." position $position\n" if $position;
1635 0 0         $vrml .= $self->{'TAB_VIEW'}." orientation $orientation\n" if $orientation;
1636 0 0         $vrml .= $self->{'TAB_VIEW'}." fieldOfView $fieldOfView\n" if $fieldOfView;
1637 0 0         $vrml .= $self->{'TAB_VIEW'}." jump $jump\n" if $jump;
1638 0           $vrml .= $self->{'TAB_VIEW'}."}\n";
1639 0           push @{$self->{'VRML'}}, $vrml;
  0            
1640 0           return $self;
1641             }
1642              
1643             =item PROTO
1644              
1645             C
1646              
1647             =cut
1648              
1649             sub PROTO {
1650 0     0 1   my $self = shift;
1651 0           my ($name, $declaration, $definition) = @_;
1652 0           $self->{'PROTO'}{$name} = $#{$self->{'VRML'}};
  0            
1653 0           my $vrml = $self->{'TAB'}."PROTO $name ";
1654 0           $self->{'TAB'} .= "\t";
1655 0           push @{$self->{'VRML'}}, $vrml;
  0            
1656 0           $vrml = "";
1657 0 0         if (defined $declaration) {
1658 0 0         if (ref($declaration) eq "ARRAY") {
1659 0           $vrml .= "[\n$self->{'TAB'}".join("\n$self->{'TAB'}",@{$declaration})."\n]\n{\n";
  0            
1660             } else {
1661 0           $vrml .= "[$declaration]\n{\n";
1662             }
1663             }
1664 0 0         if (defined $definition) {
1665 0 0         if (ref($definition) eq "CODE") {
1666 0           &$definition;
1667             } else {
1668 0           $vrml .= "$definition\n";
1669             }
1670             }
1671 0           chop($self->{'TAB'});
1672 0           $vrml .= $self->{'TAB'}."}\n";
1673 0           push @{$self->{'VRML'}}, $vrml;
  0            
1674 0           return $self;
1675             }
1676              
1677             #--------------------------------------------------------------------
1678              
1679             =back
1680              
1681             =head2 other
1682              
1683             =over 4
1684              
1685             =cut
1686              
1687             #--------------------------------------------------------------------
1688              
1689             =item USE
1690              
1691             C
1692              
1693             =cut
1694              
1695             sub USE {
1696 0     0 1   my $self = shift;
1697 0           my ($name) = @_;
1698 0           my $vrml = "";
1699 0           $vrml = $self->{'TAB'}."USE $name\n";
1700 0           push @{$self->{'VRML'}}, $vrml;
  0            
1701 0           return $self;
1702             }
1703              
1704             =item DEF
1705              
1706             C
1707              
1708             =cut
1709              
1710             sub DEF {
1711 0     0 1   my $self = shift;
1712 0           my ($name) = @_;
1713 0           my $vrml = $self->{'TAB'}."DEF $name\n";
1714 0           push @{$self->{'VRML'}}, $vrml;
  0            
1715 0           $self->{'DEF'}{$name} = $#{$self->{'VRML'}};
  0            
1716 0           return $self;
1717             }
1718              
1719             =item ROUTE
1720              
1721             C
1722              
1723             =cut
1724              
1725             sub ROUTE {
1726 0     0 1   my $self = shift;
1727 0           my ($from, $to) = @_;
1728 0 0 0       return $self unless $from && $to;
1729 0           my $vrml = $self->{'TAB'}."ROUTE $from TO $to\n";
1730 0           push @{$self->{'VRML'}}, $vrml;
  0            
1731 0           return $self;
1732             }
1733              
1734             =item End
1735              
1736             C
1737              
1738             Close an open node with }
1739              
1740             =cut
1741              
1742             sub End {
1743 0     0 1   my $self = shift;
1744 0           my ($comment) = @_;
1745 0           my $vrml = "";
1746 0 0 0       $comment = $comment && $self->{'DEBUG'} ? " # $comment" : "";
1747 0           $vrml .= $self->{'TAB'}."}$comment\n";
1748 0           push @{$self->{'VRML'}}, $vrml;
  0            
1749 0           return $self;
1750             }
1751              
1752             =item EndChildren
1753              
1754             C
1755              
1756             Close an open children part with ]
1757              
1758             =cut
1759              
1760             sub EndChildren {
1761 0     0 1   my $self = shift;
1762 0           my ($comment) = @_;
1763 0           my $vrml = "";
1764 0 0         return $self->_put("# ERROR: Too many Ends !\n") unless $self->{'TAB'};
1765 0           chop($self->{'TAB'});
1766 0 0 0       $comment = $comment && $self->{'DEBUG'} ? " # $comment" : "";
1767 0           $vrml .= $self->{'TAB'}." ]$comment\n";
1768 0           push @{$self->{'VRML'}}, $vrml;
  0            
1769 0           return $self;
1770             }
1771              
1772             =item EndTransform
1773              
1774             C
1775              
1776             Close an open children part with ] and the node with }
1777              
1778             =cut
1779              
1780             sub EndTransform {
1781 0     0 1   my $self = shift;
1782 0           my ($comment) = @_;
1783 0 0         return $self->_put("# ERROR: Too many Ends !\n") unless $self->{'TAB'};
1784 0           chop($self->{'TAB'});
1785 0 0 0       $comment = $comment && $self->{'DEBUG'} ? " # $comment" : "";
1786 0           my $vrml = $self->{'TAB'}." ]\n";
1787 0           $vrml .= $self->{'TAB'}."}$comment\n";
1788 0           push @{$self->{'VRML'}}, $vrml;
  0            
1789 0           shift @{$self->{'XYZ'}};
  0            
1790 0 0         $self->_put("# EndTransform ".join(', ',@{$self->{'XYZ'}[0]})."\n") if $self->{'DEBUG'};
  0            
1791 0           return $self;
1792             }
1793              
1794             sub AUTOLOAD {
1795 0     0     my $self = shift;
1796 0           $AUTOLOAD =~ s/.*:://g;
1797 0 0         unless (exists $self->{'PROTO'}{$AUTOLOAD}) {
1798 0           my ($package, $filename, $line) = caller;
1799 0           die qq{Unknown method "$AUTOLOAD" at $filename line $line.\n};
1800             }
1801 0           return $self->_row(qq#$AUTOLOAD { @_ } \n#);
1802             }
1803              
1804             1;
1805              
1806             __END__