File Coverage

blib/lib/VRML/VRML1/Standard.pm
Criterion Covered Total %
statement 111 480 23.1
branch 20 182 10.9
condition 1 3 33.3
subroutine 12 40 30.0
pod 36 38 94.7
total 180 743 24.2


line stmt bran cond sub pod time code
1             package VRML::VRML1::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   5 use strict;
  1         2  
  1         44  
25 1     1   6 use vars qw(@ISA $VERSION);
  1         2  
  1         6646  
26             @ISA = qw(VRML::Base);
27             $VERSION = "1.07";
28              
29             =head1 NAME
30              
31             VRML::VRML1::Standard.pm - implements the VRML 1.x standard nodes
32              
33             =head1 SYNOPSIS
34              
35             use VRML::VRML1::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             =cut
50              
51             sub new {
52 6     6 1 4 my $class = shift;
53 6         13 my $self = new VRML::Base;
54 6         9 $self->{'Content-type'} = "x-world/x-vrml";
55 6         7 $self->{'VRML'} = ["#VRML V1.0 ascii\n"];
56 6         11 return bless $self, $class;
57             }
58              
59             #####################################################################
60             # VRML Implementation #
61             #####################################################################
62              
63             =head2 Group Nodes
64              
65             I C !
66              
67             =over 4
68              
69             =item Group
70              
71             C
72              
73             =cut
74              
75             sub Group {
76 6     6 1 6 my $self = shift;
77 6         4 my $vrml = "";
78 6         18 $vrml = $self->{'TAB'}."Group {\n";
79 6         7 $self->{'TAB'} .= "\t";
80 6         4 unshift @{$self->{'XYZ'}}, [@{$self->{'XYZ'}[0]}];
  6         8  
  6         11  
81 6         7 push @{$self->{'VRML'}}, $vrml;
  6         7  
82 6         46 return $self;
83             }
84              
85             =item Separator
86              
87             C
88              
89             =cut
90              
91             sub Separator {
92 0     0 1 0 my $self = shift;
93 0         0 my $vrml = "";
94 0         0 $vrml = $self->{'TAB'}."Separator {\n";
95 0         0 $self->{'TAB'} .= "\t";
96 0         0 unshift @{$self->{'XYZ'}}, [@{$self->{'XYZ'}[0]}];
  0         0  
  0         0  
97 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
98 0         0 return $self;
99             }
100              
101             =item Switch
102              
103             C
104              
105             =cut
106              
107             sub Switch {
108 0     0 1 0 my $self = shift;
109 0         0 my ($whichChild) = @_;
110 0         0 my $vrml = "";
111 0         0 $vrml = $self->{'TAB'}."Switch {\n";
112 0 0       0 $vrml .= $self->{'TAB'}." whichChild $whichChild\n" if defined $whichChild;
113 0         0 $self->{'TAB'} .= "\t";
114 0         0 unshift @{$self->{'XYZ'}}, [@{$self->{'XYZ'}[0]}];
  0         0  
  0         0  
115 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
116 0         0 return $self;
117             }
118              
119             =item WWWAnchor
120              
121             C
122              
123              
124             $target works only with I browsers
125              
126             =cut
127              
128             sub WWWAnchor {
129 0     0 1 0 my $self = shift;
130 0         0 my ($url, $description, $target) = @_;
131 0         0 my $vrml = "";
132 0         0 $vrml = $self->{'TAB'}."WWWAnchor {\n";
133 0         0 $vrml .= $self->{'TAB'}." name \"".$self->escape($url)."\"\n";
134 0 0       0 $vrml .= $self->{'TAB'}." description \"".$self->ascii($description)."\"\n" if defined $description;
135 0 0       0 $vrml .= $self->{'TAB'}." target \"$target\"\n" if defined $target;
136 0         0 $self->{'TAB'} .= "\t";
137 0         0 unshift @{$self->{'XYZ'}}, [@{$self->{'XYZ'}[0]}];
  0         0  
  0         0  
138 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
139 0         0 return $self;
140             }
141              
142             =item LOD
143              
144             C
145              
146             $range = MFFloat
147              
148             $center = SFVec3f
149              
150             example: C
151              
152             =cut
153              
154             sub LOD {
155 0     0 1 0 my $self = shift;
156 0         0 my ($range, $center) = @_;
157 0         0 my $vrml = "";
158 0         0 $vrml = $self->{'TAB'}."LOD {\n";
159 0 0       0 if ($range) {
160 0 0       0 if (ref($range) eq "ARRAY") {
161 0         0 $vrml .= $self->{'TAB'}." range [".join(',',@$range)."]\n";
162             } else {
163 0         0 $vrml .= $self->{'TAB'}." range [$range]\n";
164             }
165             }
166 0 0       0 $vrml .= $self->{'TAB'}." center $center\n" if $center;
167 0         0 $self->{'TAB'} .= "\t";
168 0         0 unshift @{$self->{'XYZ'}}, [@{$self->{'XYZ'}[0]}];
  0         0  
  0         0  
169 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
170 0         0 return $self;
171             }
172              
173             =item SpinGroup
174              
175             C is supported only by I browsers
176              
177             =cut
178              
179             sub SpinGroup {
180 0     0 1 0 my $self = shift;
181 0         0 my ($rotation, $local) = @_;
182 0         0 my $vrml = "";
183 0         0 $vrml = $self->{'TAB'}."SpinGroup {\n";
184 0         0 $vrml .= $self->{'TAB'}." rotation $rotation\n";
185 0 0       0 $vrml .= $self->{'TAB'}." local $local\n" if defined $local;
186 0         0 $self->{'TAB'} .= "\t";
187 0         0 unshift @{$self->{'XYZ'}}, [@{$self->{'XYZ'}[0]}];
  0         0  
  0         0  
188 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
189 0         0 return $self;
190             }
191              
192             =back
193              
194             =head2 Geometry Nodes
195              
196             =over 4
197              
198             =item AsciiText
199              
200             C
201              
202             $justification is a string ('LEFT','CENTER','RIGHT')
203              
204             =cut
205              
206             sub AsciiText {
207 1     1 1 1 my $self = shift;
208 1         2 my ($string, $width, $justification, $spacing) = @_;
209 1         1 my $vrml = "";
210 1         5 $vrml = $self->{'TAB'}."AsciiText {\n";
211 1 50       7 $vrml .= $self->{'TAB'}." string ".$self->ascii($string)."\n" if $string;
212 1 50       3 $vrml .= $self->{'TAB'}." width $width\n" if $width;
213 1 50       1 $vrml .= $self->{'TAB'}." justification $justification\n" if $justification;
214 1 50       3 $vrml .= $self->{'TAB'}." spacing $spacing\n" if $spacing;
215 1         2 $vrml .= $self->{'TAB'}."}\n";
216 1         1 push @{$self->{'VRML'}}, $vrml;
  1         2  
217 1         1 return $self;
218             }
219              
220             =item Cone
221              
222             C
223              
224             @parts is an array of strings ('SIDES', 'BOTTOM', 'ALL')
225              
226             =cut
227              
228             sub Cone {
229 1     1 1 2 my $self = shift;
230 1         2 my ($radius, $height, @parts) = @_;
231 1         1 my $vrml = "";
232 1         1 $vrml = $self->{'TAB'}."Cone {\n";
233 1 50       4 $vrml .= $self->{'TAB'}." bottomRadius $radius\n" if $radius;
234 1 50       7 $vrml .= $self->{'TAB'}." height $height\n" if $height;
235 1 50       2 $vrml .= $self->{'TAB'}." parts (".join("|",@parts).")\n" if @parts;
236 1         2 $vrml .= $self->{'TAB'}."}\n";
237 1         1 push @{$self->{'VRML'}}, $vrml;
  1         2  
238 1         2 return $self;
239             }
240              
241             =item Cube
242              
243             C
244              
245             =cut
246              
247             sub Cube {
248 2     2 1 3 my $self = shift;
249 2         2 my ($width, $height, $depth) = @_;
250 2         2 my $vrml = "";
251 2         2 $vrml = $self->{'TAB'}."Cube {\n";
252 2 50       6 $vrml .= $self->{'TAB'}." width $width\n" if $width;
253 2 50       6 $vrml .= $self->{'TAB'}." height $height\n" if $height;
254 2 50       5 $vrml .= $self->{'TAB'}." depth $depth\n" if $depth;
255 2         2 $vrml .= $self->{'TAB'}."}\n";
256 2         3 push @{$self->{'VRML'}}, $vrml;
  2         2  
257 2         3 return $self;
258             }
259              
260             =item Cylinder
261              
262             C
263              
264             @parts is a list of strings ('SIDES', 'TOP', 'BOTTOM', 'ALL')
265              
266             =cut
267              
268             sub Cylinder {
269 1     1 1 1 my $self = shift;
270 1         2 my ($radius, $height, @parts) = @_; # parts = SIDES|TOP|BOTTOM|ALL
271 1         1 my $vrml = "";
272 1         7 $vrml = $self->{'TAB'}."Cylinder {\n";
273 1 50       5 $vrml .= $self->{'TAB'}." radius $radius\n" if defined $radius;
274 1 50       3 $vrml .= $self->{'TAB'}." height $height\n" if defined $height;
275 1 50       3 $vrml .= $self->{'TAB'}." parts (".join("|",@parts).")\n" if @parts;
276 1         2 $vrml .= $self->{'TAB'}."}\n";
277 1         1 push @{$self->{'VRML'}}, $vrml;
  1         2  
278 1         2 return $self;
279             }
280              
281             =item IndexedFaceSet
282              
283             C
284              
285             $coordIndex_ref is a reference of a list of point index strings
286             like C<['0 1 3 2', '2 3 5 4', ...]>
287              
288             $materialIndex_ref is a reference of a list of materials
289              
290             $normalIndex_ref is a reference of a list of normals
291              
292             $textureCoordIndex_ref is a reference of a list of textures
293              
294             =cut
295              
296             sub IndexedFaceSet {
297 0     0 1 0 my $self = shift;
298 0         0 my ($coordIndex_ref, $materialIndex_ref, $normalIndex_ref, $textureCoordIndex_ref) = @_;
299 0         0 my $vrml = "";
300 0         0 $vrml = $self->{'TAB'}."IndexedFaceSet {\n";
301 0 0       0 if ($coordIndex_ref) {
302 0         0 $vrml .= $self->{'TAB'}." coordIndex [\n";
303 0         0 $vrml .= $self->{'TAB'}."\t\t";
304 0         0 $vrml .= join(", -1,\n$self->{'TAB'}\t\t",@$coordIndex_ref);
305 0         0 $vrml .= ", -1\n".$self->{'TAB'}." ]\n";
306             }
307 0 0       0 if ($materialIndex_ref) {
308 0         0 $vrml .= $self->{'TAB'}." materialIndex [\n";
309 0         0 $vrml .= $self->{'TAB'}."\t\t";
310 0         0 $vrml .= join(",\n$self->{'TAB'}\t\t",@$materialIndex_ref);
311 0         0 $vrml .= "\n".$self->{'TAB'}." ]\n";
312             }
313 0 0       0 if ($normalIndex_ref) {
314 0         0 $vrml .= $self->{'TAB'}." normalIndex [\n";
315 0         0 $vrml .= $self->{'TAB'}."\t\t";
316 0         0 $vrml .= join(", -1,\n$self->{'TAB'}\t\t",@$normalIndex_ref);
317 0         0 $vrml .= ", -1\n".$self->{'TAB'}." ]\n";
318             }
319 0 0       0 if ($textureCoordIndex_ref) {
320 0         0 $vrml .= $self->{'TAB'}." textureCoordIndex [\n";
321 0         0 $vrml .= $self->{'TAB'}."\t\t";
322 0         0 $vrml .= join(", -1,\n$self->{'TAB'}\t\t",@$textureCoordIndex_ref);
323 0         0 $vrml .= ", -1\n".$self->{'TAB'}." ]\n";
324             }
325 0         0 $vrml .= $self->{'TAB'}."}\n";
326 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
327 0         0 return $self;
328             }
329              
330             =item IndexedLineSet
331              
332             C
333              
334             $coordIndex_ref is a reference of a list of point index strings
335             like C<['0 1 3 2', '2 3 5 4', ...]>
336              
337             $materialIndex_ref is a reference of a list of materials
338              
339             $normalIndex_ref is a reference of a list of normals
340              
341             $textureCoordIndex_ref is a reference of a list of textures
342              
343             =cut
344              
345             sub IndexedLineSet {
346 0     0 1 0 my $self = shift;
347 0         0 my ($coordIndex_ref, $materialIndex_ref, $normalIndex_ref, $textureCoordIndex_ref) = @_;
348 0         0 my $vrml = "";
349 0         0 $vrml = $self->{'TAB'}."IndexedLineSet {\n";
350 0 0       0 if ($coordIndex_ref) {
351 0         0 $vrml .= $self->{'TAB'}." coordIndex [\n";
352 0         0 $vrml .= $self->{'TAB'}."\t\t";
353 0         0 $vrml .= join(", -1,\n$self->{'TAB'}\t\t",@$coordIndex_ref);
354 0         0 $vrml .= ", -1\n".$self->{'TAB'}." ]\n";
355             }
356 0 0       0 if ($materialIndex_ref) {
357 0         0 $vrml .= $self->{'TAB'}." materialIndex [\n";
358 0         0 $vrml .= $self->{'TAB'}."\t\t";
359 0         0 $vrml .= join(", -1,\n$self->{'TAB'}\t\t",@$materialIndex_ref);
360 0         0 $vrml .= "\n".$self->{'TAB'}." ]\n";
361             }
362 0 0       0 if ($normalIndex_ref) {
363 0         0 $vrml .= $self->{'TAB'}." normalIndex [\n";
364 0         0 $vrml .= $self->{'TAB'}."\t\t";
365 0         0 $vrml .= join(", -1,\n$self->{'TAB'}\t\t",@$normalIndex_ref);
366 0         0 $vrml .= ", -1\n".$self->{'TAB'}." ]\n";
367             }
368 0 0       0 if ($textureCoordIndex_ref) {
369 0         0 $vrml .= $self->{'TAB'}." textureCoordIndex [\n";
370 0         0 $vrml .= $self->{'TAB'}."\t\t";
371 0         0 $vrml .= join(", -1,\n$self->{'TAB'}\t\t",@$textureCoordIndex_ref);
372 0         0 $vrml .= ", -1\n".$self->{'TAB'}." ]\n";
373             }
374 0         0 $vrml .= $self->{'TAB'}."}\n";
375 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
376 0         0 return $self;
377             }
378              
379             =item PointSet
380              
381             C
382              
383             =cut
384              
385             sub PointSet {
386 0     0 1 0 my $self = shift;
387 0         0 my ($numPoints, $startIndex) = @_;
388 0 0       0 $startIndex = 0 unless defined $startIndex;
389 0         0 my $vrml = "";
390 0         0 $vrml = $self->{'TAB'}."PointSet {\n";
391 0 0       0 $vrml .= $self->{'TAB'}." startIndex $startIndex\n" if $startIndex;
392 0 0       0 $vrml .= $self->{'TAB'}." numPoints $numPoints\n" if $numPoints;
393 0         0 $vrml .= $self->{'TAB'}."}\n";
394 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
395 0         0 return $self;
396             }
397              
398             =item Sphere
399              
400             C
401              
402             $radius must be > 0
403              
404             =cut
405              
406             sub Sphere {
407 1     1 1 1 my $self = shift;
408 1         2 my ($radius) = @_;
409 1         1 my $vrml = "";
410 1         2 $vrml = $self->{'TAB'}."Sphere {\n";
411 1 50       4 $vrml .= $self->{'TAB'}." radius $radius\n" if $radius;
412 1         2 $vrml .= $self->{'TAB'}."}\n";
413 1         1 push @{$self->{'VRML'}}, $vrml;
  1         2  
414 1         1 return $self;
415             }
416              
417             #--------------------------------------------------------------------
418              
419             =back
420              
421             =head2 Property Nodes
422              
423             =over 4
424              
425             =cut
426              
427             #--------------------------------------------------------------------
428              
429             =item Coordinate3
430              
431             C
432              
433             @points is a list of points with strings like C<'1.0 0.0 0.0', '-1 2 0'>
434              
435             =cut
436              
437             sub Coordinate3 {
438 0     0 1 0 my $self = shift;
439 0         0 my (@points) = @_;
440 0         0 my $vrml = "";
441 0         0 $vrml = $self->{'TAB'}."Coordinate3 {\n";
442 0         0 $vrml .= $self->{'TAB'}." point [\n";
443 0         0 $vrml .= $self->{'TAB'}."\t\t";
444 0         0 $vrml .= join(",\n$self->{'TAB'}\t\t",@points);
445 0         0 $vrml .= "\n".$self->{'TAB'}." ]\n";
446 0         0 $vrml .= $self->{'TAB'}."}\n";
447 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
448 0         0 return $self;
449             }
450              
451             =item Fontstyle
452              
453             C
454             defines the current font style for all subsequent C Nodes
455              
456             $familiy can be 'SERIF','SANS','TYPEWRITER'
457              
458             $style can be 'NONE','BOLD','ITALIC'
459              
460             =cut
461              
462             sub FontStyle {
463 1     1 0 1 my $self = shift;
464 1         3 my ($size, $family, $style) = @_;
465 1         1 my $vrml = "";
466 1         2 $vrml = $self->{'TAB'}."FontStyle {\n";
467 1 50       3 $vrml .= $self->{'TAB'}." size $size\n" if $size;
468 1 50       4 $vrml .= $self->{'TAB'}." family $family\n" if $family;
469 1 50       4 $vrml .= $self->{'TAB'}." style $style\n" if $style;
470 1         2 $vrml .= $self->{'TAB'}."}\n";
471 1         1 push @{$self->{'VRML'}}, $vrml;
  1         2  
472 1         2 return $self;
473             }
474              
475             #--------------------------------------------------------------------
476              
477             =back
478              
479             =head2 Appearance Nodes
480              
481             =over 4
482              
483             =cut
484              
485             #--------------------------------------------------------------------
486              
487             =item Material
488              
489             C
490              
491             =cut
492              
493             sub Material {
494 6     6 1 5 my $self = shift;
495 6         10 my (%materials) = @_;
496 6         6 my $vrml = "";
497 6         4 my ($key, $value, $i, $l);
498 6         4 my $c = ",";
499 6         8 $vrml = $self->{'TAB'}."Material {\n";
500 6         18 while(($key,$value) = each %materials) {
501 6         10 $vrml .= $self->{'TAB'}." $key";
502 6 50       8 if (ref($value)) {
503 0         0 $l = $#{$value};
  0         0  
504 0         0 $vrml .= " [";
505 0         0 for ($i=0; $i<=$l; $i++) {
506 0 0       0 if ($i == $l) { $c = ""; }
  0         0  
507 0         0 $vrml .= "\n$self->{'TAB'}\t\t";
508 0 0       0 if (ref($value->[$i])) {
509 0         0 $vrml .= "$value->[$i][0]$c # $value->[$i][1]";
510             } else {
511 0         0 $vrml .= "$value->[$i]$c";
512             }
513             }
514 0         0 $vrml .= "\n".$self->{'TAB'}."\t]\n";
515             } else {
516 6         15 $vrml .= " $value\n";
517             }
518             }
519 6         4 $vrml .= $self->{'TAB'}."}\n";
520 6         4 push @{$self->{'VRML'}}, $vrml;
  6         7  
521 6         11 return $self;
522             }
523              
524             =item MaterialBinding
525              
526             C
527              
528              
529             $value can be
530              
531             DEFAULT Use default bindng
532             OVERALL Whole object has same material
533             PER_PART One material for each part of object
534             PER_PART_INDEXED One material for each part, indexed
535             PER_FACE One material for each face of object
536             PER_FACE_INDEXED One material for each face, indexed
537             PER_VERTEX One material for each vertex of object
538             PER_VERTEX_INDEXED One material for each vertex, indexed
539              
540             =cut
541              
542             sub MaterialBinding {
543 0     0 1 0 my $self = shift;
544 0         0 my $vrml = "";
545 0         0 $vrml = $self->{'TAB'}."MaterialBinding {\n";
546 0         0 $vrml .= $self->{'TAB'}." value @_\n";
547 0         0 $vrml .= $self->{'TAB'}."}\n";
548 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
549 0         0 return $self;
550             }
551              
552             =item Normal
553              
554             C
555              
556             @vector is a list of vectors with strings like C<'1.0 0.0 0.0', '.5 .2 0'>
557              
558             =cut
559              
560             sub Normal {
561 0     0 1 0 my $self = shift;
562 0         0 my (@vector) = @_;
563 0         0 my $vrml = "";
564 0         0 $vrml = $self->{'TAB'}."Normal {\n";
565 0         0 $vrml .= $self->{'TAB'}."\tvector [\n$self->{'TAB'}\t\t";
566 0         0 $vrml .= join(",\n$self->{'TAB'}\t\t",@vector);
567 0         0 $vrml .= "\n".$self->{'TAB'}."\t]\n";
568 0         0 $vrml .= $self->{'TAB'}."}\n";
569 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
570 0         0 return $self;
571             }
572              
573             =item NormalBinding
574              
575             C
576              
577             $value is the same as C
578              
579             =cut
580              
581             sub NormalBinding {
582 0     0 1 0 my $self = shift;
583 0         0 my $vrml = "";
584 0         0 $vrml = $self->{'TAB'}."NormalBinding {\n";
585 0         0 $vrml .= $self->{'TAB'}." value @_\n";
586 0         0 $vrml .= $self->{'TAB'}."}\n";
587 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
588 0         0 return $self;
589             }
590              
591             =item Texture2
592              
593             C
594              
595             =cut
596              
597             sub Texture2 {
598 0     0 1 0 my $self = shift;
599 0         0 my ($filename, $wrapS, $wrapT) = @_;
600 0         0 my $vrml = "";
601 0         0 $vrml = $self->{'TAB'}."Texture2 {\n";
602 0         0 $vrml .= $self->{'TAB'}." filename \"".$self->escape($filename)."\"\n";
603 0 0       0 $vrml .= $self->{'TAB'}." wrapS CLAMP\n" if $wrapS;
604 0 0       0 $vrml .= $self->{'TAB'}." wrapT CLAMP\n" if $wrapT;
605 0         0 $vrml .= $self->{'TAB'}."}\n";
606 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
607 0         0 return $self;
608             }
609              
610             #--------------------------------------------------------------------
611              
612             =back
613              
614             =head2 Transform Nodes
615              
616             =over 4
617              
618             =cut
619              
620             #--------------------------------------------------------------------
621              
622             =item Transform
623              
624             C
625              
626             $translation is a string like "0 1 -2"
627              
628             $rotation is a string like "0 0 1 1.57"
629              
630             $scaleFactor is a string like "1 1 1"
631              
632             $scaleOrientation is a string like "0 0 1 0"
633              
634             $center is a string like "0 0 0"
635              
636             =cut
637              
638             sub Transform {
639 0     0 1 0 my $self = shift;
640 0         0 my ($translation, $rotation, $scaleFactor, $scaleOrientation, $center) = @_;
641 0 0       0 unless (@_) {
642 0         0 return $self;
643 0         0 return "";
644             }
645 0 0       0 $self->xyz($self->string_to_array($translation)) if defined $translation;
646 0         0 my $vrml = "";
647 0         0 $vrml = $self->{'TAB'}."Transform {\n";
648 0 0       0 $vrml .= $self->{'TAB'}." translation $translation\n" if $translation;
649 0 0       0 $vrml .= $self->{'TAB'}." rotation $rotation\n" if $rotation;
650 0 0       0 $vrml .= $self->{'TAB'}." scaleFactor $scaleFactor\n" if $scaleFactor;
651 0 0       0 $vrml .= $self->{'TAB'}." scaleOrientation $scaleOrientation\n" if $scaleOrientation;
652 0 0       0 $vrml .= $self->{'TAB'}." center $center\n" if $center;
653 0         0 $vrml .= $self->{'TAB'}."}\n";
654 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
655 0         0 return $self;
656             }
657              
658             =item Rotation
659              
660             C
661              
662             $rotation is a string like "0 0 1 1.57"
663              
664             C
665              
666             =cut
667              
668             sub Rotation {
669 0     0 1 0 my $self = shift;
670 0         0 my $vrml = "";
671 0         0 $vrml = $self->{'TAB'}."Rotation {\n";
672 0         0 $vrml .= $self->{'TAB'}." rotation @_\n";
673 0         0 $vrml .= $self->{'TAB'}."}\n";
674 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
675 0         0 return $self;
676             }
677              
678             =item Scale
679              
680             C
681              
682             $scaleFactor is a string like "1 1 1"
683              
684             C
685              
686             =cut
687              
688             sub Scale {
689 0     0 1 0 my $self = shift;
690 0         0 my $vrml = "";
691 0         0 $vrml = $self->{'TAB'}."Scale {\n";
692 0         0 $vrml .= $self->{'TAB'}." scaleFactor @_\n";
693 0         0 $vrml .= $self->{'TAB'}."}\n";
694 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
695 0         0 return $self;
696             }
697              
698             =item Translation
699              
700             C
701              
702             $translation is a string like "0 1 -2"
703              
704             C
705              
706             =cut
707              
708             sub Translation {
709 0     0 1 0 my $self = shift;
710 0         0 my ($translation) = @_;
711 0 0       0 $self->xyz($self->string_to_array($translation)) if defined $translation;
712 0         0 my $vrml = "";
713 0         0 $vrml = $self->{'TAB'}."Translation {\n";
714 0         0 $vrml .= $self->{'TAB'}." translation $translation\n";
715 0         0 $vrml .= $self->{'TAB'}."}\n";
716 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
717 0         0 return $self;
718             }
719              
720             #--------------------------------------------------------------------
721              
722             =back
723              
724             =head2 Common Nodes
725              
726             =over 4
727              
728             =cut
729              
730             #--------------------------------------------------------------------
731              
732             =item PerspectiveCamera
733              
734             C
735              
736             =cut
737              
738             sub PerspectiveCamera {
739 0     0 1 0 my $self = shift;
740 0         0 my ($position, $orientation, $heightAngle,
741             $focalDistance, $nearDistance, $farDistance) = @_;
742 0         0 my $vrml = "";
743 0         0 $vrml = $self->{'TAB_VIEW'}."PerspectiveCamera {\n";
744 0 0       0 $vrml .= $self->{'TAB_VIEW'}." position $position\n" if $position;
745 0 0       0 $vrml .= $self->{'TAB_VIEW'}." orientation $orientation\n" if $orientation;
746 0 0       0 $vrml .= $self->{'TAB_VIEW'}." heightAngle $heightAngle\n" if $heightAngle;
747 0 0       0 $vrml .= $self->{'TAB_VIEW'}." focalDistance $focalDistance\n" if $focalDistance;
748 0 0       0 $vrml .= $self->{'TAB_VIEW'}." nearDistance $nearDistance\n" if $nearDistance;
749 0 0       0 $vrml .= $self->{'TAB_VIEW'}." farDistance $farDistance\n" if $farDistance;
750 0         0 $vrml .= $self->{'TAB_VIEW'}."}\n";
751 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
752 0         0 return $self;
753             }
754              
755             =item OrthographicCamera
756              
757             C
758              
759             =cut
760              
761             sub OrthographicCamera {
762 0     0 1 0 my $self = shift;
763 0         0 my ($position, $orientation, $height,
764             $focalDistance, $nearDistance, $farDistance) = @_;
765 0         0 my $vrml = "";
766 0         0 $vrml = $self->{'TAB_VIEW'}."OrthographicCamera {\n";
767 0 0       0 $vrml .= $self->{'TAB_VIEW'}." position $position\n" if $position;
768 0 0       0 $vrml .= $self->{'TAB_VIEW'}." orientation $orientation\n" if $orientation;
769 0 0       0 $vrml .= $self->{'TAB_VIEW'}." height $height\n" if $height;
770 0 0       0 $vrml .= $self->{'TAB_VIEW'}." focalDistance $focalDistance\n" if $focalDistance;
771 0 0       0 $vrml .= $self->{'TAB_VIEW'}." nearDistance $nearDistance\n" if $nearDistance;
772 0 0       0 $vrml .= $self->{'TAB_VIEW'}." farDistance $farDistance\n" if $farDistance;
773 0         0 $vrml .= $self->{'TAB_VIEW'}."}\n";
774 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
775 0         0 return $self;
776             }
777              
778             =item DirectionalLight
779              
780             C
781              
782             =cut
783              
784             sub DirectionalLight {
785 0     0 1 0 my $self = shift;
786 0         0 my ($direction, $intensity, $color, $on) = @_;
787 0         0 my $vrml = "";
788 0         0 $vrml = $self->{'TAB'}."DirectionalLight {\n";
789 0 0       0 $vrml .= $self->{'TAB'}." direction $direction\n" if $direction;
790 0 0       0 $vrml .= $self->{'TAB'}." intensity $intensity\n" if $intensity;
791 0 0       0 $vrml .= $self->{'TAB'}." color $color\n" if $color;
792 0 0       0 $vrml .= $self->{'TAB'}." on $on\n" if $on;
793 0         0 $vrml .= $self->{'TAB'}."}\n";
794 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
795 0         0 return $self;
796             }
797              
798             =item PointLight
799              
800             C
801              
802             =cut
803              
804             sub PointLight {
805 0     0 1 0 my $self = shift;
806 0         0 my ($location, $intensity, $color, $on) = @_;
807 0         0 my $vrml = "";
808 0         0 $vrml = $self->{'TAB'}."PointLight {\n";
809 0 0       0 $vrml .= $self->{'TAB'}." location $location\n" if $location;
810 0 0       0 $vrml .= $self->{'TAB'}." intensity $intensity\n" if $intensity;
811 0 0       0 $vrml .= $self->{'TAB'}." color $color\n" if $color;
812 0 0       0 $vrml .= $self->{'TAB'}." on $on\n" if $on;
813 0         0 $vrml .= $self->{'TAB'}."}\n";
814 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
815 0         0 return $self;
816             }
817              
818             =item SpotLight
819              
820             C
821              
822             =cut
823              
824             sub SpotLight {
825 0     0 1 0 my $self = shift;
826 0         0 my ($location, $direction, $intensity, $color, $on) = @_;
827 0         0 my $vrml = "";
828 0         0 $vrml = $self->{'TAB'}."SpotLight {\n";
829 0 0       0 $vrml .= $self->{'TAB'}." location $location\n" if $location;
830 0 0       0 $vrml .= $self->{'TAB'}." direction $direction\n" if $direction;
831 0 0       0 $vrml .= $self->{'TAB'}." intensity $intensity\n" if $intensity;
832 0 0       0 $vrml .= $self->{'TAB'}." color $color\n" if $color;
833 0 0       0 $vrml .= $self->{'TAB'}." on $on\n" if $on;
834 0         0 $vrml .= $self->{'TAB'}."}\n";
835 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
836 0         0 return $self;
837             }
838              
839             =item DirectedSound
840              
841             C
842              
843             =cut
844              
845             sub DirectedSound {
846 0     0 1 0 my $self = shift;
847 0         0 my ($name, $description, $location, $direction, $intensity, $maxFrontRange, $maxBackRange, $minFrontRange, $minBackRange, $loop, $pause) = @_;
848 0         0 my $vrml = $self->{'TAB'}."DirectedSound {\n";
849 0         0 $vrml .= $self->{'TAB'}." name \"".$self->escape($name)."\"\n";
850 0 0       0 $vrml .= $self->{'TAB'}." description \"".$self->ascii($description)."\"\n" if defined $description;
851 0 0       0 $vrml .= $self->{'TAB'}." location $location\n" if $location;
852 0 0       0 $vrml .= $self->{'TAB'}." direction $direction\n" if $direction;
853 0 0       0 $vrml .= $self->{'TAB'}." intensity $intensity\n" if $intensity;
854 0 0       0 $vrml .= $self->{'TAB'}." maxFrontRange $maxFrontRange\n" if $maxFrontRange;
855 0 0       0 $vrml .= $self->{'TAB'}." maxBackRange $maxBackRange\n" if $maxBackRange;
856 0 0       0 $vrml .= $self->{'TAB'}." minFrontRange $minFrontRange\n" if $minFrontRange;
857 0 0       0 $vrml .= $self->{'TAB'}." minBackRange $minBackRange\n" if $minBackRange;
858 0 0       0 $vrml .= $self->{'TAB'}." loop $loop\n" if defined $loop;
859 0 0       0 $vrml .= $self->{'TAB'}." pause $pause\n" if $pause;
860 0         0 $vrml .= $self->{'TAB'}."}\n";
861 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
862 0         0 return $self;
863             }
864              
865             #--------------------------------------------------------------------
866              
867             =back
868              
869             =head2 other
870              
871             =over 4
872              
873             =item WWWInline
874              
875             C
876              
877             =cut
878              
879             sub WWWInline {
880 0     0 1 0 my $self = shift;
881 0         0 my $vrml = "";
882 0         0 my ($name, $bboxSize, $bboxCenter) = @_;
883 0         0 $vrml = $self->{'TAB'}."WWWInline {\n";
884 0         0 $vrml .= $self->{'TAB'}." name \"".$self->escape($name)."\"\n";
885 0 0       0 $vrml .= $self->{'TAB'}." bboxSize $bboxSize\n" if $bboxSize;
886 0 0       0 $vrml .= $self->{'TAB'}." bboxCenter $bboxCenter\n" if $bboxCenter;
887 0         0 $vrml .= $self->{'TAB'}."}\n";
888 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
889 0         0 return $self;
890             }
891              
892             =item Info
893              
894             C
895              
896             =cut
897              
898             sub Info {
899 0     0 1 0 my $self = shift;
900 0         0 my ($string) = @_;
901 0         0 my $vrml = "";
902 0         0 $vrml = $self->{'TAB'}."Info {\n";
903 0         0 $vrml .= $self->{'TAB'}." string \"".$self->ascii($string)."\"\n";
904 0         0 $vrml .= $self->{'TAB'}."}\n";
905 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
906 0         0 return $self;
907             }
908              
909             =item NavigationInfo
910              
911             C
912              
913             Works only with Live3D and WebFX
914              
915             =cut
916              
917             sub NavigationInfo {
918 0     0 1 0 my $self = shift;
919 0         0 my ($type, $speed, $headlight) = @_;
920 0         0 my $key;
921 0         0 my $vrml = "";
922 0         0 $vrml = $self->{'TAB'}."NavigationInfo {\n";
923 0 0       0 if (ref($type) eq "HASH") {
924 0         0 foreach $key (keys %$type) {
925 0         0 $vrml .= $self->{'TAB'}." $key \"$type->{$key}\"\n";
926             }
927             } else {
928 0 0       0 $vrml .= $self->{'TAB'}." type \"$type\"\n" if defined $type;
929 0 0       0 $vrml .= $self->{'TAB'}." speed $speed\n" if defined $speed;
930 0 0       0 $vrml .= $self->{'TAB'}." headlight $type\n" if $type;
931 0         0 $vrml .= $self->{'TAB'}."}\n";
932             }
933 0         0 push @{$self->{'VRML'}}, $vrml;
  0         0  
934 0         0 return $self;
935             }
936              
937             sub End {
938 6     6 0 22 my $self = shift;
939 6         4 my ($comment) = @_;
940 6 50       11 return $self->_put("# ERROR: TAB < 0 !\n") unless $self->{'TAB'};
941 6         7 chop($self->{'TAB'});
942 6 50 33     10 $comment = $comment && $self->{'DEBUG'} ? " # $comment" : "";
943 6         8 my $vrml = $self->{'TAB'}."}$comment\n";
944 6         5 push @{$self->{'VRML'}}, $vrml;
  6         6  
945 6         6 shift @{$self->{'XYZ'}};
  6         5  
946 6         9 return $self;
947             }
948              
949             =item USE
950              
951             C
952              
953             =cut
954              
955             sub USE {
956 0     0 1   my $self = shift;
957 0           my ($name) = @_;
958 0           my $vrml = "";
959 0           $vrml = $self->{'TAB'}."USE $name\n";
960 0           push @{$self->{'VRML'}}, $vrml;
  0            
961 0           return $self;
962             }
963              
964             =item DEF
965              
966             C
967              
968             =cut
969              
970             sub DEF {
971 0     0 1   my $self = shift;
972 0           my ($name) = @_;
973 0           my $vrml = $self->{'TAB'}."DEF $name\n";
974 0           push @{$self->{'VRML'}}, $vrml;
  0            
975 0           $self->{'DEF'}{$name} = $#{$self->{'VRML'}};
  0            
976 0           return $self;
977             }
978              
979             1;
980              
981             __END__