perl/gconsole

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use IO::Socket;
   5
   6 use Gtk2 -init;
   7 use Glib qw/TRUE FALSE/;
   8 use Gtk2::Helper;
   9 use Gtk2::Pango;
  10 use Gtk2::Gdk::Keysyms;
  11
  12 my $callsign = uc $ARGV[0];
  13 #check and warn if we received wrong argument
  14 unless($callsign){
  15         print "usage <program name> <callsign> [<host> <port>]\n";
  16         exit;
  17 }
  18
  19 my ($sock, $MAXLEN, $SEND_PORT, $SEND_HOST) = (undef, 1024, 7301, "localhost");
  20
  21 if (@ARGV >= 3) {
  22         $SEND_HOST = $ARGV[1];
  23         $SEND_PORT = $ARGV[2];
  24 }
  25
  26 my $tview;
  27
  28 #---------------------------------
  29 #set up a udp server waiting for incomming messages
  30 $sock = IO::Socket::INET->new(PeerHost => $SEND_HOST, PeerPort => $SEND_PORT, Proto => 'tcp')
  31         or die "socket: $@";
  32
  33 #add a Gtk2::Helper watch on any incomming connections
  34 Gtk2::Helper->add_watch ( fileno $sock, 'in', sub{
  35                                                           my ($fd,$condition,$fh) = @_;
  36                                                           #call 'watch_callback' to handle the incoming data
  37                                                           \&watch_callback($fh, $tview);
  38                                                   },$sock);
  39
  40 print "Awaiting TCP messages on $SEND_HOST:$SEND_PORT\n";
  41 #---------------------------------
  42
  43 #Gtk2::Rc->parse ('/usr/share/themes/Anger/gtk/gtkrc');
  44 #this is parsing our theme file, giving a personal touch
  45 #Gtk2::Rc->parse ('gtkrc');
  46
  47 #standard window creation, placement, and signal connecting
  48 my $window = Gtk2::Window->new('toplevel');
  49 $window->signal_connect('delete_event' => sub { exit;});
  50 $window->set_border_width(5);
  51 $window->set_position('center_always');
  52 #again just some fine touches
  53 $window->set_title("gconsole: $callsign");
  54 #$window->set_icon_from_file($img_send);
  55
  56 #this vbox will geturn the bulk of the gui
  57 my ($vbox) = &ret_vbox();
  58
  59 #add and show the vbox
  60 $window->add($vbox);
  61 $window->show();
  62
  63 #our main event-loop
  64 Gtk2->main();
  65
  66 sub ret_vbox {
  67
  68         my $vbox = Gtk2::VBox->new(FALSE,0);
  69         #add an image to indicate who you are
  70 #       my $img_who = Gtk2::Image->new_from_file($img_big);
  71 #
  72 #       $vbox->pack_start($img_who,TRUE,TRUE,0);
  73
  74         my $frame = Gtk2::Frame->new("gconsole: $callsign");
  75
  76         #method of Gtk2::Container
  77         $frame->set_border_width(5);
  78
  79         my $sw = Gtk2::ScrolledWindow->new (undef, undef);
  80         $sw->set_shadow_type ('etched-out');
  81         $sw->set_policy ('automatic', 'automatic');
  82         #This is a method of the Gtk2::Widget class,it will force a minimum
  83         #size on the widget. Handy to give intitial size to a
  84         #Gtk2::ScrolledWindow class object
  85         $sw->set_size_request (800, 600);
  86         #method of Gtk2::Container
  87         $sw->set_border_width(5);
  88
  89         $tview = Gtk2::TextView->new();
  90         #we do not want to edit anything
  91         $tview->set_editable(FALSE);
  92         $tview->set_cursor_visible (FALSE);
  93
  94         my $buffer = $tview->get_buffer();
  95         $buffer->create_tag ("monospace", family => "monospace");
  96
  97         #create a mark at the end of the buffer, and on each
  98         #'insert_text' we tell the textview to scroll to that mark
  99         $buffer->create_mark ('end', $buffer->get_end_iter, FALSE);
 100 #       $buffer->signal_connect (insert_text => sub {
 101 #                                                                $tview->scroll_to_mark ($buffer->get_mark ('end'),
 102 #                                                                                                                0.0, TRUE, 0, 0.5);
 103 #                                                        });
 104
 105         #create a tag for the shreck
 106 #       $buffer->create_tag ("shrek",
 107 #                                                style =>'italic',
 108 #                                                weight => PANGO_WEIGHT_ULTRALIGHT,
 109 #                                                family => 'flubber',
 110 #                                                foreground => "#189f3b",
 111 #                                                size => 20000,
 112 #                                               );
 113
 114         #create a tag for the donkey
 115 #       $buffer->create_tag ("donkey",
 116 #                                                style =>'italic',
 117 #                                                weight => PANGO_WEIGHT_ULTRALIGHT,
 118 #                                                family => 'davis',
 119 #                                                foreground => "blue",
 120 #                                                size => 20000,
 121 #                                               );
 122
 123         $sw->add($tview);
 124         $frame->add($sw);
 125         $vbox->pack_start($frame,TRUE,TRUE,4);
 126         #--------------------------------------
 127         my $hbox = Gtk2::HBox->new(FALSE,5);
 128
 129         my $ent_send = Gtk2::Entry->new;
 130         $hbox->pack_start($ent_send,TRUE,TRUE,0);
 131
 132         my $btn_send = Gtk2::Button->new_from_stock('gtk-ok');
 133         #connect the 'key_press_signal' to a handler that will
 134         #filter for 'Return'; if TRUE, trigger a button click
 135         $ent_send->signal_connect('key_press_event'=> sub {
 136                                                                   my ($widget,$event) = @_;
 137                                                                   if ($event->keyval == $Gtk2::Gdk::Keysyms{Return}) {
 138                                                                           $btn_send->clicked;
 139                                                                           return 1;
 140                                                                   }
 141
 142                                                           });
 143
 144         $btn_send->signal_connect("clicked" =>sub {
 145                                                                   #get the contents of the entry
 146                                                                   my $msg_send = $ent_send->get_text;
 147                                                                   #clear the entry
 148                                                                   $ent_send->set_text("");
 149                                                                   #grab focus again for the next round of talks
 150                                                                   $ent_send->grab_focus;
 151                                                                   #if there was bogus input, ignore it!
 152                                                                   if ($msg_send !~ m/^$/) {
 153                                                                           my $msg = $msg_send;
 154                                                                           $msg =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg;
 155                                                                           syswrite($sock, $msg . "\r\n") or die "syswrite: $!";
 156                                                                           update_buffer($buffer, $msg_send, TRUE);
 157                                                                   }
 158                                                           });
 159
 160         $hbox->pack_end($btn_send,TRUE,TRUE,0);
 161         #--------------------------------------
 162         $vbox->pack_start($hbox,TRUE,TRUE,4);
 163         #set initial focus
 164         $vbox->set_focus_child($hbox);
 165
 166         $vbox->show_all();
 167         return $vbox;
 168 }
 169
 170 my $buf;
 171
 172 sub watch_callback {
 173
 174         my ($fh,$tview) = @_;
 175         my $msg;
 176         my $r = sysread($fh, $msg, $MAXLEN) or die "sysread: $!";
 177         if (defined $r && $r) {
 178                 $msg =~ s/\%([0-9A-F][0-9A-F])/chr(hex($1))/eg;
 179                 $msg =~ s/\x0d//g;
 180                 my $buffer = $tview->get_buffer();
 181                 update_buffer($buffer, $msg, FALSE);
 182         }
 183
 184         return 1;
 185 }
 186
 187 sub update_buffer {
 188
 189         my ($buffer,$msg,$send)= @_;
 190
 191         $msg = $msg;
 192         my $iter = $buffer->get_end_iter;
 193         $buffer->insert_with_tags_by_name($iter, $msg, "monospace");
 194         $tview->scroll_to_mark ($buffer->get_mark ('end'),       0.0, TRUE, 0, 0.5);
 195 }