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__ |