1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
package PDL::Graphics::TriD::Object;
use strict;
use warnings;
use fields qw(Objects ValidList ChangedSub List VRML);
$PDL::Graphics::TriD::verbose //= 0;
sub new{
my $class = shift;
my $self = fields::new($class);
$self;
}
sub clear_objects {
my($this) = @_;
$this->{Objects} = [];
$this->{ValidList} = 0;
}
sub delete_object {
my($this,$object) = @_;
return unless(defined $object && defined $this->{Objects});
for(0..$#{$this->{Objects}}){
if($object == $this->{Objects}[$_]){
splice(@{$this->{Objects}},$_,1);
redo;
}
}
}
# XXXXXXXXX sub {} makes all these objects and this window immortal!
sub add_object {
my($this,$object) = @_;
push @{$this->{Objects}},$object;
$this->{ValidList} = 0;
for(@{$this->{ChangedSub}}) {
$object->add_changedsub($_);
}
$object->add_changedsub(sub {$this->changed_from_above()});
}
sub changed_from_above {
my($this) = @_;
print "CHANGED_FROM_ABOVE\n" if $PDL::Graphics::TriD::verbose;
$this->changed;
}
sub add_changedsub {
my($this,$chsub) = @_;
push @{$this->{ChangedSub}}, $chsub;
for (@{$this->{Objects}}) {
$_->add_changedsub($chsub);
}
}
sub clear {
my($this) = @_;
# print "Clear: $this\n";
for(@{$this->{Objects}}) {
$_->clear();
}
$this->delete_displist();
delete $this->{ChangedSub};
delete $this->{Objects};
}
sub changed {
my($this) = @_;
print "VALID0 $this\n" if $PDL::Graphics::TriD::verbose;
$this->{ValidList} = 0;
$_->($this) for @{$this->{ChangedSub}};
}
sub vrml_update {
my ($this) = @_;
use PDL::Graphics::VRML;
$this->{VRML} = PDL::Graphics::VRMLNode->new('Transform',
'translation' => "-1 -1 -1",
'scale' => "2 2 2");
$this->{ValidList} = 1;
}
sub tovrml {
my($this) = @_;
print ref($this)," valid=",$this->{ValidList}," tovrml\n";
if (!$this->{ValidList}) {
$this->vrml_update();
}
$this->{VRML}->add('children',
[map {$_->tovrml()} @{$this->{Objects}}]);
}
1;
|
