1# FIXME: this is very SLOW!!!
2
3package stkutils::data_packet;
4use strict;
5
6sub new {
7	my $class = shift;
8	my $data = shift;
9	my $self = {};
10	$self->{data} = ($data or '');
11	$self->{init_length} = CORE::length($self->{data});
12	bless($self, $class);
13	return $self;
14}
15sub unpack {
16	my $self = shift;
17	my $template = shift;
18die if !(defined $self);
19die if !(defined $self->{data});
20die if !(defined $template);
21die if CORE::length($self->{data}) == 0;
22	my @values = CORE::unpack($template.'a*', $self->{data});
23die if $#values == -1;
24	$self->{data} = splice(@values, -1);
25die if !(defined $self->{data});
26	return @values;
27}
28sub pack {
29	my $self = shift;
30	my $template = shift;
31die if !(defined($template));
32die if !(defined(@_));
33die unless defined $_[0];
34	$self->{data} .= CORE::pack($template, @_);
35}
36use constant template_for_scalar => {
37	h32	=> 'V',
38	h16	=> 'v',
39	h8	=> 'C',
40	u32	=> 'V',
41	u16	=> 'v',
42	u8	=> 'C',
43	q8	=> 'C',
44	s32	=> 'l',
45	s16	=> 'v',
46	s8	=> 'C',
47	sz	=> 'Z*',
48	f32	=> 'f',
49	guid	=> 'a[16]',
50};
51use constant template_for_vector => {
52	l8u8v	=> 'C/C',
53	l32u8v	=> 'V/C',
54	l32u16v	=> 'V/v',
55	l32szv	=> 'V/(Z*)',
56	l8szbv	=> 'C/(Z*C)',
57	u8v8	=> 'C8',
58	u8v4	=> 'C4',
59	f32v3	=> 'f3',
60	f32v4	=> 'f4',
61	s32v3	=> 'l3',
62	s32v4	=> 'l4',
63};
64sub unpack_properties {
65	my $self = shift;
66	my $container = shift;
67
68	foreach my $p (@_) {
69		#print "unpacking $p->{name} type $p->{type}\n";
70		if ($p->{type} eq 'shape') {
71			my ($count) = $self->unpack('C');
72			while ($count--) {
73				my %shape;
74				($shape{type}) = $self->unpack('C');
75				if ($shape{type} == 0) {
76					@{$shape{sphere}} = $self->unpack('f4');
77				} elsif ($shape{type} == 1) {
78					@{$shape{box}} = $self->unpack('f12');
79				} else {
80					die;
81				}
82				push @{$container->{$p->{name}}}, \%shape;
83			}
84		} else {
85			my $template = template_for_scalar->{$p->{type}};
86			if (defined $template) {
87				($container->{$p->{name}}) = $self->unpack($template);
88				if ($p->{type} eq 'sz') {
89					chomp $container->{$p->{name}};
90					$container->{$p->{name}} =~ s/\r//g;
91				}
92			} elsif ($p->{type} eq 'u24') {
93				($container->{$p->{name}}) = CORE::unpack('V', CORE::pack('CCCC', $self->unpack('C3'), 0));
94			} else {
95				@{$container->{$p->{name}}} = $self->unpack(template_for_vector->{$p->{type}});
96			}
97		}
98	}
99}
100sub pack_properties {
101	my $self = shift;
102	my $container = shift;
103
104	foreach my $p (@_) {
105		my $template = template_for_scalar->{$p->{type}};
106		if (defined $template) {
107			$self->pack($template, $container->{$p->{name}});
108		} elsif ($p->{type} eq 'shape') {
109			$self->pack('C', $#{$container->{$p->{name}}} + 1);
110			foreach my $shape (@{$container->{$p->{name}}}) {
111				$self->pack('C', $$shape{type});
112				if ($$shape{type} == 0) {
113					$self->pack('f4', @{$$shape{sphere}});
114				} elsif ($$shape{type} == 1) {
115					$self->pack('f12', @{$$shape{box}});
116				}
117			}
118		} else {
119			my $n = $#{$container->{$p->{name}}} + 1;
120			if ($p->{type} eq 'l32u16v') {
121				$self->pack("Vv$n", $n, @{$container->{$p->{name}}});
122			} elsif ($p->{type} eq 'l32u8v') {
123				$self->pack("VC$n", $n, @{$container->{$p->{name}}});
124			} elsif ($p->{type} eq 'l32szv') {
125				$self->pack("V(Z*)$n", $n, @{$container->{$p->{name}}});
126			} elsif ($p->{type} eq 'l8u8v') {
127				$self->pack("CC$n", $n, @{$container->{$p->{name}}});
128			} elsif ($p->{type} eq 'u8v8' or $p->{type} eq 'u8v4') {
129				$self->pack("C$n", @{$container->{$p->{name}}});
130			} elsif ($p->{type} eq 'f32v3') {
131				$self->pack('f3', @{$container->{$p->{name}}});
132			} elsif ($p->{type} eq 'f32v4') {
133				$self->pack('f4', @{$container->{$p->{name}}});
134			} elsif ($p->{type} eq 's32v3') {
135				$self->pack('l3', @{$container->{$p->{name}}});
136			} elsif ($p->{type} eq 's32v4') {
137				$self->pack('l4', @{$container->{$p->{name}}});
138			} elsif ($p->{type} eq 'q8v') {
139				$self->pack("C$n", @{$container->{$p->{name}}});
140			} elsif ($p->{type} eq 'l8szbv') {
141				$self->pack("C(Z*C)$n", $n/2, @{$container->{$p->{name}}});
142			} else {
143				die;
144			}
145		}
146	}
147}
148sub length {
149	return CORE::length($_[0]->{data});
150}
151sub r_tell {
152	return $_[0]->{init_length} - CORE::length($_[0]->{data});
153}
154sub w_tell {
155	return CORE::length($_[0]->{data});
156}
157sub data {
158	return $_[0]->{data};
159}
160
1611;
162