VNC/Codec.pm

   1 package VNC::Codec;\r
   2 \r
   3 require 5.002;   # becase we use prototypes\r
   4 \r
   5 use Socket;\r
   6 use warnings;\r
   7 use strict;\r
   8 use vars qw(@ISA @EXPORT_OK);\r
   9 require Exporter;\r
  10 @ISA = qw(Exporter);\r
  11 @EXPORT_OK = qw(VNC_PIXELFORMAT_32BPP_RGB888 VNC_PIXELFORMAT_16BPP_RGB565 VNC_PIXELFORMAT_8BPP_RGB332);\r
  12 \r
  13 \r
  14 sub buffer2hex($) {\r
  15         my ($t) = @_ ;\r
  16 \r
  17         my $result = '';\r
  18 \r
  19         my @b = split (//, $t) ;\r
  20 \r
  21         foreach (@b) {\r
  22                 $result .= sprintf("%02X ", ord($_)) ;\r
  23         }\r
  24 \r
  25         return $result ;\r
  26 }\r
  27 \r
  28 ########## \r
  29 #\r
  30 # helper function to build the PIXELFORMAT binary struct (please see VNC documentation\r
  31 #\r
  32 sub BUILD_PIXEL_FORMAT {\r
  33         my ($bits_per_pixel, \r
  34                 $depth ,\r
  35                 $big_endian,\r
  36                 $true_color,\r
  37                 $red_max,$green_max,$blue_max,\r
  38                 $red_shift,$green_shift, $blue_shift) = @_ ;\r
  39 \r
  40         my $buffer = pack ("CCCCnnnCCCCn", $bits_per_pixel, \r
  41                 $depth ,\r
  42                 $big_endian,\r
  43                 $true_color,\r
  44                 $red_max,$green_max,$blue_max,\r
  45                 $red_shift,$green_shift, $blue_shift ) ;\r
  46 \r
  47         return $buffer;\r
  48 }\r
  49 \r
  50 sub VNC_PIXELFORMAT_32BPP_RGB888 {\r
  51         return BUILD_PIXEL_FORMAT(32,24,1,1,255,255,255,16,8,0);\r
  52 }\r
  53 \r
  54 sub VNC_PIXELFORMAT_16BPP_RGB565 {\r
  55         return BUILD_PIXEL_FORMAT(16,16,1,1,31,63,31,11,5,0);\r
  56 }\r
  57 \r
  58 sub VNC_PIXELFORMAT_8BPP_RGB332 {\r
  59         return BUILD_PIXEL_FORMAT(8,8,1,1,7,7,3,0,3,6);\r
  60 }\r
  61 \r
  62 #######\r
  63 # Constructs a new VNC Codec object\r
  64 #\r
  65 sub new {\r
  66         my $proto = shift;\r
  67         my $class = $proto;\r
  68 \r
  69         my $self  = {};\r
  70         bless ($self, $class);\r
  71 \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
  83 \r
  84         \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
  89 \r
  90         return $self;\r
  91 }\r
  92 \r
  93 sub set_pixel_format {\r
  94         my ($self, $bits_per_pixel, \r
  95                 $depth ,\r
  96                 $big_endian,\r
  97                 $true_color,\r
  98                 $red_max,$green_max,$blue_max,\r
  99                 $red_shift,$green_shift, $blue_shift) = @_ ;\r
 100 \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
 111 \r
 112         return 1;\r
 113 }\r
 114 \r
 115 \r
 116 #############################\r
 117 #\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
 120 #\r
 121 sub encode_pixel {\r
 122         my ($self,$r,$g,$b) = @_ ;\r
 123 \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
 126 \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
 130 \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
 134 \r
 135         my $bits_per_pixel = $self->{BITS_PER_PIXEL};\r
 136 \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
 140 \r
 141         my $raw;\r
 142 \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
 149         }\r
 150 \r
 151 #       print "encode_pixel($r,$g,$b) = ",buffer2hex($raw),"\n";\r
 152 \r
 153         return $raw;\r
 154 }\r
 155 \r
 156 #############################\r
 157 #\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
 160 #\r
 161 sub encode_raw_rect {\r
 162         my ($self,$raw_pixel,$x,$y,$w,$h) = @_ ;\r
 163 \r
 164         my $i;\r
 165         my $j;\r
 166         my $raw ;\r
 167         \r
 168         for ($i=0;$i<$h;$i++) {\r
 169                 for ($j=0;$j<$w;$j++) {\r
 170                         $raw .= $raw_pixel; \r
 171                 }\r
 172         }\r
 173 \r
 174         my $buffer = pack("nnnnN", $x,$y,$w,$h,0 ) . $raw ;\r
 175         \r
 176 #       print "encode_raw_rect = ",buffer2hex($buffer),"\n";\r
 177         return $buffer;\r
 178 }\r
 179 \r
 180 #############################\r
 181 #\r
 182 # This function builds an RRE sub-rect\r
 183 # It returns a raw (binary) scalar with the encoded subrect data\r
 184 #\r
 185 sub encode_rre_subrect {\r
 186         my ($self,$raw_pixel,$x,$y,$w,$h) = @_ ;\r
 187 \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
 191         \r
 192         return $raw_pixel . pack("nnnn",$x,$y,$w,$h);\r
 193 }\r
 194 \r
 195 #############################\r
 196 #\r
 197 # This function builds an RRE sub-rect\r
 198 # It returns a raw (binary) scalar with the encoded subrect data\r
 199 #\r
 200 sub encode_rre {\r
 201         my ($self,$raw_background_pixel,$x,$y,$w,$h,@subrects) = @_ ;\r
 202 \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
 206 \r
 207         my $count = scalar @subrects;\r
 208         \r
 209         return pack("nnnnNN",$x,$y,$w,$h,2,$count) . $raw_background_pixel . join('',@subrects); # 2 = RRE encoding\r
 210 }\r
 211 \r
 212 sub encode_framebuffer_update {\r
 213         my ($self,@rectangles) = @_ ;\r
 214 \r
 215         my $count = scalar @rectangles;\r
 216         my $buffer = pack("CCn",0,0,$count) . join('',@rectangles) ;\r
 217 \r
 218         return $buffer;\r
 219 }\r
 220 \r
 221 1;