3 require 5.002; # becase we use prototypes
\r
8 use vars qw(@ISA @EXPORT_OK);
\r
10 @ISA = qw(Exporter);
\r
11 @EXPORT_OK = qw(VNC_PIXELFORMAT_32BPP_RGB888 VNC_PIXELFORMAT_16BPP_RGB565 VNC_PIXELFORMAT_8BPP_RGB332);
\r
19 my @b = split (//, $t) ;
\r
22 $result .= sprintf("%02X ", ord($_)) ;
\r
30 # helper function to build the PIXELFORMAT binary struct (please see VNC documentation
\r
32 sub BUILD_PIXEL_FORMAT {
\r
33 my ($bits_per_pixel,
\r
37 $red_max,$green_max,$blue_max,
\r
38 $red_shift,$green_shift, $blue_shift) = @_ ;
\r
40 my $buffer = pack ("CCCCnnnCCCCn", $bits_per_pixel,
\r
44 $red_max,$green_max,$blue_max,
\r
45 $red_shift,$green_shift, $blue_shift ) ;
\r
50 sub VNC_PIXELFORMAT_32BPP_RGB888 {
\r
51 return BUILD_PIXEL_FORMAT(32,24,1,1,255,255,255,16,8,0);
\r
54 sub VNC_PIXELFORMAT_16BPP_RGB565 {
\r
55 return BUILD_PIXEL_FORMAT(16,16,1,1,31,63,31,11,5,0);
\r
58 sub VNC_PIXELFORMAT_8BPP_RGB332 {
\r
59 return BUILD_PIXEL_FORMAT(8,8,1,1,7,7,3,0,3,6);
\r
63 # Constructs a new VNC Codec object
\r
70 bless ($self, $class);
\r
72 #use default PIXELFORMAT of 32bpp, RGB888
\r
73 $self->{RED_MAX} = 255 ;
\r
74 $self->{GREEN_MAX} = 255 ;
\r
75 $self->{BLUE_MAX} = 255 ;
\r
76 $self->{RED_SHIFT} = 16;
\r
77 $self->{GREEN_SHIFT} = 8 ;
\r
78 $self->{BLUE_SHIFT} = 0 ;
\r
79 $self->{BITS_PER_PIXEL} = 32;
\r
80 $self->{DEPTH} = 24 ;
\r
81 $self->{TRUE_COLOR} = 1 ;
\r
82 $self->{BIG_ENDIAN} = 1 ;
\r
85 #This is used for the internal representation o RGB data
\r
86 $self->{INTERNAL_RED_MAX} = 255 ;
\r
87 $self->{INTERNAL_GREEN_MAX} = 255 ;
\r
88 $self->{INTERNAL_BLUE_MAX} = 255 ;
\r
93 sub set_pixel_format {
\r
94 my ($self, $bits_per_pixel,
\r
98 $red_max,$green_max,$blue_max,
\r
99 $red_shift,$green_shift, $blue_shift) = @_ ;
\r
101 $self->{RED_MAX} = $red_max ;
\r
102 $self->{GREEN_MAX} = $green_max ;
\r
103 $self->{BLUE_MAX} = $blue_max ;
\r
104 $self->{RED_SHIFT} = $red_shift;
\r
105 $self->{GREEN_SHIFT} = $green_shift ;
\r
106 $self->{BLUE_SHIFT} = $blue_shift ;
\r
107 $self->{BITS_PER_PIXEL} = $bits_per_pixel;
\r
108 $self->{DEPTH} = $depth ;
\r
109 $self->{TRUE_COLOR} = $true_color ;
\r
110 $self->{BIG_ENDIAN} = $big_endian ;
\r
116 #############################
\r
118 # This function builds a raw pixel, according to the specified format (bits/pixel,and max/shift values)
\r
119 # It returns a raw (binary) scalar with the encoded pixel
\r
122 my ($self,$r,$g,$b) = @_ ;
\r
124 warn "VNC::Codec::encode_pixel called with self=undef" unless (defined $self);
\r
125 warn "VNC::Codec::encode_pixel called with r/g/b=undef" unless (defined $r and defined $g and defined $b);
\r
127 my $red_max = $self->{RED_MAX};
\r
128 my $green_max = $self->{GREEN_MAX};
\r
129 my $blue_max = $self->{BLUE_MAX};
\r
131 my $red_shift = $self->{RED_SHIFT};
\r
132 my $green_shift = $self->{GREEN_SHIFT};
\r
133 my $blue_shift = $self->{BLUE_SHIFT};
\r
135 my $bits_per_pixel = $self->{BITS_PER_PIXEL};
\r
137 my $z = ($r * ($red_max))/$self->{INTERNAL_RED_MAX} << $red_shift ;
\r
138 $z += ($g * ($green_max))/$self->{INTERNAL_GREEN_MAX} << $green_shift;
\r
139 $z += ($b * ($blue_max))/$self->{INTERNAL_BLUE_MAX} << $blue_shift;
\r
143 if ($bits_per_pixel==8) {
\r
144 $raw .= pack("C",$z) ;
\r
145 } elsif ($bits_per_pixel==16) {
\r
146 $raw .= pack("S",$z) ;
\r
147 } elsif ($bits_per_pixel==32) {
\r
148 $raw .= pack("i",$z) ;
\r
151 # print "encode_pixel($r,$g,$b) = ",buffer2hex($raw),"\n";
\r
156 #############################
\r
158 # This function builds a RAW encoded rectangle, with a singe RGB color
\r
159 # It returns a raw (binary) scalar with the encoded rect data
\r
161 sub encode_raw_rect {
\r
162 my ($self,$raw_pixel,$x,$y,$w,$h) = @_ ;
\r
168 for ($i=0;$i<$h;$i++) {
\r
169 for ($j=0;$j<$w;$j++) {
\r
170 $raw .= $raw_pixel;
\r
174 my $buffer = pack("nnnnN", $x,$y,$w,$h,0 ) . $raw ;
\r
176 # print "encode_raw_rect = ",buffer2hex($buffer),"\n";
\r
180 #############################
\r
182 # This function builds an RRE sub-rect
\r
183 # It returns a raw (binary) scalar with the encoded subrect data
\r
185 sub encode_rre_subrect {
\r
186 my ($self,$raw_pixel,$x,$y,$w,$h) = @_ ;
\r
188 warn "VNC::Codec::encode_rre_subrect called with self=undef" unless (defined $self);
\r
189 warn "VNC::Codec::encode_rre_subrect called with raw_pixel=undef" unless (defined $raw_pixel);
\r
190 warn "VNC::Codec::encode_rre_subrect called with x/y/w/h=undef" unless (defined $x and defined $y and defined $w and defined $h);
\r
192 return $raw_pixel . pack("nnnn",$x,$y,$w,$h);
\r
195 #############################
\r
197 # This function builds an RRE sub-rect
\r
198 # It returns a raw (binary) scalar with the encoded subrect data
\r
201 my ($self,$raw_background_pixel,$x,$y,$w,$h,@subrects) = @_ ;
\r
203 warn "VNC::Codec::encode_rre called with self=undef" unless (defined $self);
\r
204 warn "VNC::Codec::encode_rre called with x/y/w/h=undef" unless (defined $x and defined $y and defined $w and defined $h);
\r
205 warn "VNC::Codec::encode_rre called with raw_background_pixel=undef" unless (defined $raw_background_pixel);
\r
207 my $count = scalar @subrects;
\r
209 return pack("nnnnNN",$x,$y,$w,$h,2,$count) . $raw_background_pixel . join('',@subrects); # 2 = RRE encoding
\r
212 sub encode_framebuffer_update {
\r
213 my ($self,@rectangles) = @_ ;
\r
215 my $count = scalar @rectangles;
\r
216 my $buffer = pack("CCn",0,0,$count) . join('',@rectangles) ;
\r