main.pl

   1 use strict;\r
   2 use warnings;\r
   3 use VNC::Server;\r
   4 \r
   5 \r
   6 my $type = 1;\r
   7 \r
   8 \r
   9 \r
  10 sub updater {\r
  11         my ($vnc, $inc, $x,$y,$w,$h) = @_ ;\r
  12 \r
  13         my $codec = $vnc->{CODEC};\r
  14 \r
  15 \r
  16         my $data ;\r
  17         \r
  18         if ($type==1) {\r
  19                 $data= $codec->encode_framebuffer_update($codec->encode_raw_rect($codec->encode_pixel(0,0,255), $x,$y,$w,$h) ) ;\r
  20         } else {\r
  21                 $data = $codec->encode_framebuffer_update(      $codec->encode_rre($codec->encode_pixel(0,255,0), $x,$y,$w,$h,\r
  22                                                                                                         $codec->encode_rre_subrect( $codec->encode_pixel(255,255,255), 10,10,20,10),\r
  23                                                                                                         $codec->encode_rre_subrect( $codec->encode_pixel(0,128,128), 10,20,10,20)\r
  24                                                                                                 )) ;\r
  25         }\r
  26 \r
  27         return $data ;\r
  28 }\r
  29 \r
  30 my $s = new VNC::Server( Port=>2, \r
  31                                                  Idle=>1, \r
  32                                                  Caption=>'Hello From perlVNC',\r
  33                                                  Width => 50, Height => 50,\r
  34                                                  Password => 'dummy',\r
  35                                                  IdleHandler => sub {print "Nothing happened for 1 second...\n"},\r
  36                                                  KeyEventHandler => sub { my ($vnc,$d,$k) = @_; print "down = $d, key = $k\n";},\r
  37                                                  PointerEventHandler => \&pointer,\r
  38                                                  UpdateDisplayHandler => \&updater\r
  39                                                 );\r
  40 \r
  41 $s->vnc_server_loop;\r
  42 \r
  43 sub pointer {\r
  44         my ($vnc,$mask,$x,$y) = @_ ;\r
  45 \r
  46         if ($mask==1) {\r
  47                 $type=1 ;\r
  48         };\r
  49         if ($mask==4) {\r
  50                 $type=2;\r
  51         }\r
  52         if ($mask==2) {\r
  53                 $vnc->disconnect ;\r
  54                 return ;\r
  55         }\r
  56 \r
  57         $s->update_all_displays;\r
  58 }\r