summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Agent.pm405
-rw-r--r--src/IvyIO.pm114
-rwxr-xr-xsrc/ivycontrolpanel830
3 files changed, 1349 insertions, 0 deletions
diff --git a/src/Agent.pm b/src/Agent.pm
new file mode 100644
index 0000000..75cf616
--- /dev/null
+++ b/src/Agent.pm
@@ -0,0 +1,405 @@
+package Agent;
+
+use IvyIO;
+use FugueConfig;
+
+use strict;
+
+
+
+#----------------------------------------------------------------------
+#
+# class variables and methods
+#
+#----------------------------------------------------------------------
+my ($x0, $y0, $wmax, $dx, $dy, $cmin, $rmax, @matrix, @hosts, $tempo_id,
+ $mw, $bg, $fg, $selcolor, $hlbg, $darkbg, $fontspec, @fontspec,
+ $on_img, $off_img, %instances, @instances, $bus,
+ $hosts_tl, $selected_host, $preselected_host);
+
+
+# configure the class : graphic parameters, geometry and ivy bus
+sub configure {
+ shift;
+ ($mw, $bg, $fg, $selcolor, $hlbg, $darkbg,
+ $fontspec, $x0, $y0, $wmax, $dy, $cmin, $rmax, $bus) = @_;
+ @fontspec = @$fontspec if $fontspec;
+ $off_img = $mw->Bitmap('off', -file => Tk::findINC('led.bmp'),
+ -foreground => $bg);
+ $on_img = $mw->Bitmap('on', -file => Tk::findINC('led.bmp'),
+ -foreground => $selcolor);
+ &_resetmatrix;
+
+} # end configure
+
+
+# kill an named agent
+sub kill {
+ my ($class, $appname) = @_;
+ IvyIO::kill($appname);
+
+} # end kill;
+
+
+# kill all agents
+sub killall {
+ my ($class) = @_;
+ my $nb = 0;
+ for(@instances) {
+ if ($_->{status} > 0) {
+ IvyIO::kill($_->{appname});
+ $nb++;
+ }
+ }
+ return $nb;
+
+} # end killall;
+
+# set usable hosts list for executing agents
+sub hosts {
+ shift;
+ @hosts = @_;
+
+} # end hosts
+
+# callback called when an agent connects
+sub connect {
+ my ($class, $appname, $host) = @_;
+ if ($instances{$appname}) {
+ if ($instances{$appname}->{status} == 1) {
+ $instances{$appname}->addtwin;
+ } else {
+ $instances{$appname}->on;
+ }
+ } else {
+ $class->new($appname, $host, undef, undef, 1);
+ }
+
+} # end connect
+
+
+# callback called when an agent disconnects
+sub disconnect {
+ my ($class, $appname, $host) = @_;
+ if ($instances{$appname}) {
+ if ($instances{$appname}->{number} > 1) {
+ $instances{$appname}->removetwin;
+ } else {
+ $instances{$appname}->off;
+ }
+ } else {
+ $class->new($appname, $host, undef, undef, 0);
+ }
+
+} # end disconnect
+
+# class constructor
+sub new {
+ my ($class, $appname, $host, $command, $params, $status) = @_;
+ if ($instances{$appname}) {
+ $instances{$appname}->addtwin;
+ return;
+ }
+ my $self = {};
+ bless $self;
+
+ # set object attributes
+ $self->{appname} = $appname;
+ $self->{status} = $status;
+ $self->{host} = $host;
+ $self->{command} = $command;
+ $self->{params} = $params;
+ $self->{number} = 1;
+ $self->{led} = undef;
+ $self->{label} = undef;
+
+ # reset positions before adding new instance
+ if (@instances >= ($rmax*$cmin)) {
+ $cmin++;
+ $class->_updatepositions;
+ }
+ # set class variables
+ $instances{$appname} = $self;
+ push(@instances, $self);
+
+ # graphical updates
+ $self->createlabel;
+ $self->on if $status;
+
+ $class->_alphabeticsort();
+
+ return $self;
+
+} # end new
+
+
+
+#----------------------------------------------------------------------
+#
+# instance methods
+#
+#----------------------------------------------------------------------
+
+# called when several agent instances are detected
+sub addtwin {
+ my $self = shift;
+ $self->{number}++;
+ $self->{label}->configure(-text => $self->formatlabel);
+
+} # end addtwin
+
+# called when an instance of a not single agent dies
+sub removetwin {
+ my $self = shift;
+ return if $self->{number} == 1;
+ $self->{number}--;
+ $self->{label}->configure(-text => $self->formatlabel);
+
+} # end addtwin
+
+# graphical effect when a known agent connects
+sub on {
+ my $self = shift;
+ $self->{status} = 1;
+ $self->{led}->configure(-image => $on_img);
+ $self->{label}->raise;
+ $self->{label}->configure(-highlightthicknes => 2);
+ $tempo_id = $mw->after(3000, sub {
+ $self->{label}->configure(highlightthicknes => 0);
+ });
+
+} # end on
+
+# graphical effect when a known agent disconnects
+
+sub off {
+ my $self = shift;
+ $self->{status} = 0;
+ $self->{led}->configure(-image => $off_img);
+
+} # end off
+
+# label placement
+sub setposition {
+ my $self = shift;
+ my ($r, $c);
+ for (my $i=0; $i<@matrix; $i++) {
+ for (my $j=0; $j<=$#{$matrix[$i]}; $j++) {
+ unless ($matrix[$i][$j]->[0]) {
+ ($r, $c) = ($i, $j);
+ last;
+ }
+ }
+ last if defined $r;
+ }
+ $matrix[$r][$c]->[0] = $self;
+ my ($x, $y) = ($matrix[$r][$c]->[1], $matrix[$r][$c]->[2]);
+ my $y2 = $y - 5;
+ $y2 -= 12 if ($self->{label}->cget(-text) =~ /\n/);
+
+ if ($self->{command}) {
+ $self->{led}->configure(-highlightthickness => 6);
+ $self->{led}->place(-x => $x+3, -y => $y+3);
+ } else {
+ $self->{led}->configure(-highlightthickness => 2);
+ $self->{led}->place(-x => $x+6, -y => $y+6);
+ }
+ $self->{label}->place(-x => $x + 38, -y => $y2);
+
+} # end setposition
+
+
+# label creation
+sub createlabel {
+ my ($self) = @_;
+ $self->{led} =
+ $mw->Label(-image => $off_img,
+ -highlightbackground => $hlbg,
+ -borderwidth => 0,
+ );
+ $self->{label} =
+ $mw->Label(-text => $self->formatlabel,
+ -pady => 10,
+ -justify => 'left',
+ -relief => 'flat',
+ -highlightthickness => 0,
+ -background => $darkbg,
+ -foreground => $fg,
+ @fontspec,
+ );
+ $self->{led}->bind('<1>', [\&_cbOnPress, $self]);
+ $self->{label}->bind('<1>', [\&_cbOnPress, $self]);
+
+} # end createlabel
+
+# label format : affects too long labels and not single agents
+sub formatlabel {
+ my ($self) = @_;
+ my $im_width = 38;
+ my $dx = $dx - $im_width;
+ my $appname = $self->{appname};
+ # for not single agents
+ $appname = '['.$self->{number}.'] '.$appname if $self->{number} > 1;
+ my $width = $mw->fontMeasure($fontspec[1], $appname);
+ my $appnametext;
+ # for too long names
+ while ($width > 2*$dx) {
+ $appname = substr($appname, 0, -1);
+ $width = $mw->fontMeasure($fontspec[1], $appname);
+ }
+ if ($width > $dx) {
+ my $hlen = int(length($appname)/2);
+ my @fields = split(/:/, $appname);
+ if (@fields > 1) {
+ my $len = 0;
+ my $imax = -1;
+ for (my $i=0; $i<@fields; $i++) {
+ $len += length($fields[$i]);
+ if ($len > $hlen) {
+ $imax = $i - 1;
+ last;
+ }
+ }
+ if ($imax >= 0) {
+ $appnametext = join(':', (@fields)[0..$imax])."\n".
+ join(':', (@fields)[$imax+1..$#fields]);
+ }
+ }
+ $appnametext = substr($appname, 0, $hlen)."\n".substr($appname, $hlen)
+ unless $appnametext;
+ } else {
+ my @fields = split(/:/, $appname);
+ if (@fields > 1) {
+ $appnametext = $fields[0].":\n ".join(':', (@fields)[1..$#fields]);
+ }
+ }
+ $appnametext = $appname unless $appnametext;
+ return $appnametext;
+
+} # end formatlabel
+
+
+#----------------------------------------------------------------------
+#
+# private methods or functions
+#
+#----------------------------------------------------------------------
+sub _resetmatrix {
+ $dx = $wmax/$cmin;
+ for(my $r=0; $r<$rmax; $r++) {
+ for(my $c=0; $c<$cmin; $c++) {
+ $matrix[$r][$c] = [undef, $x0 + $c*$dx, $y0 + $r*$dy];
+ }
+ }
+
+} # end _resetmatrix
+
+
+sub _updatepositions {
+ &_resetmatrix;
+ for (@instances) {
+ $_->setposition();
+ $_->{label}->configure(-text => $_->formatlabel);
+ }
+
+} # end _updatepositions
+
+
+sub _alphabeticsort {
+ &_resetmatrix;
+ for (sort {uc($a->{appname}) cmp uc($b->{appname})} @instances) {
+ $_->setposition();
+ }
+
+} # end _alphabeticsort
+
+
+# callback invoked when user press on label
+sub _cbOnPress {
+ shift;
+ my $self = shift;
+ $self->{label}->configure(-foreground => $hlbg);
+ if ($self->{status} == 1) {
+ IvyIO::kill($self->{appname});
+ $mw->after(400, sub {$self->{label}->configure(-foreground => $fg);});
+ } elsif ($self->{command}) {
+ my ($x, $y) = ($self->{label}->rootx, $self->{label}->rooty);
+ my $host = &_hostsmenu($x, $y, $self->{host});
+ $self->{label}->configure(-foreground => $fg);
+ return unless $host;
+ FugueConfig::launchAgent($self->{appname}, $host,
+ $self->{command}, $self->{params}, $bus);
+ print "$self->{appname} launched\n";
+ } else {
+ $mw->bell;
+ $mw->after(400, sub {$self->{label}->configure(-foreground => $fg);});
+ }
+
+} # end _cbOnPress
+
+
+# create and show hosts menu
+sub _hostsmenu {
+ my $x = shift;
+ my $y = shift;
+ $x += 50;
+
+ my $preselected_host = shift;
+ return $preselected_host if @hosts <= 1;
+ $hosts_tl->destroy if Tk::Exists($hosts_tl);
+ $hosts_tl = $mw->Toplevel(-background => $darkbg);
+ $hosts_tl->resizable(0,0);
+ $hosts_tl->title('ivycontrolpanel');
+ my $hosts_fm = $hosts_tl->Frame(-background => $darkbg,
+ -highlightthickness => 3,
+ -highlightbackground => $hlbg,
+ )->pack(-side => 'top', -padx => 0, -pady => 0);
+ my @lattr = (-padx => 10,
+ -pady => 10,
+ -relief => 'flat',
+ -highlightthickness => 0,
+ -background => $darkbg,
+ -foreground => $fg,
+ -borderwidth => 0,
+ @fontspec);
+ my @battr = (@lattr,
+ -width => 4, -height => 1,
+ -highlightthickness => 3,
+ -highlightbackground => $hlbg,
+ -activebackground => $darkbg,
+ -activeforeground => $fg,
+ );
+ my @rattr = (@lattr,
+ -activebackground => $darkbg,
+ -activeforeground => $fg,
+ -selectcolor => $selcolor);
+
+ $hosts_fm->Label(@lattr, -text => "restart on :"
+ )->pack(-side => 'top', -padx => 20, -pady => 20);
+ for(@hosts) {
+ $hosts_fm->Radiobutton(@rattr,
+ -variable => \$preselected_host,
+ -value => $_,
+ -text => $_,
+ )->pack(-side => 'top');
+ }
+ my $fm = $hosts_fm->Frame(-background => $darkbg)->pack(-side => 'bottom');
+ $fm->Button(@battr,
+ -command => sub {$hosts_tl->destroy},
+ -text => 'ok')->pack(-side => 'left', -padx => 10, -pady => 20);
+ $fm->Button(@battr,
+ -command => sub {$preselected_host = undef; $hosts_tl->destroy},
+ -text => 'cancel')->pack(-side => 'left', -padx => 10, -pady => 20);
+ $hosts_tl->update;
+ my ($X, $Y) = ($mw->rootx, $mw->rooty);
+ my ($w, $h) = ($hosts_tl->width, $hosts_tl->height);
+ my ($W, $H) = ($mw->width, $mw->height);
+ $x = $X + $W - $w if ($x + $w) > $X + $W;
+ $y = $Y + $H - $h if ($y + $h) > $Y + $H;
+ $hosts_tl->geometry('+'.$x.'+'.$y);
+ $hosts_tl->waitWindow();
+ return $preselected_host;
+
+} # end hostsmenu
+
+1;
diff --git a/src/IvyIO.pm b/src/IvyIO.pm
new file mode 100644
index 0000000..8283a02
--- /dev/null
+++ b/src/IvyIO.pm
@@ -0,0 +1,114 @@
+package IvyIO;
+
+use strict;
+use Ivy;
+
+
+my $ivy;
+
+# init an ivy bus
+sub init {
+ my ($appname, $bus, $conncb, $disconncb) = @_;
+ Ivy->init(-loopMode => 'TK',
+ -appName => $appname,
+ -ivyBus => $bus,
+ );
+ $ivy = Ivy->new(-statusFunc => sub {&_status($conncb, $disconncb, @_);});
+ $ivy->start;
+
+} # end init
+
+# kill a named agent
+sub kill {
+ my $appname = shift;
+ $ivy->sendDieTo($appname);
+
+} # end kill
+
+
+sub _status {
+ my ($conncb, $disconncb, $ref_array_present, $ref_array_absent,
+ $ref_hash_present, $agent, $status, $host) = @_;
+ if ($status eq "new") {
+ &$conncb($agent, $host);
+ } elsif ($status eq "died") {
+ &$disconncb($agent, $host);
+ }
+
+} # end _status
+
+#------------------------------------------------------------------------
+#
+# output
+#
+#------------------------------------------------------------------------
+
+sub send_rate {
+ my ($rate) = shift;
+ return unless $ivy;
+ $ivy->sendMsgs("SetClock Rate=$rate");
+
+} # end ivy_send_rate
+
+
+sub send_time {
+ my ($time) = shift;
+ return unless $ivy;
+ $ivy->sendMsgs("SetClock Time=$time");
+
+} # end send_time
+
+
+sub send_pause {
+ return unless $ivy;
+ $ivy->sendMsgs("ClockStop");
+
+} # end send_pause
+
+
+sub send_play {
+ return unless $ivy;
+ $ivy->sendMsgs("ClockStart");
+
+} # end send_play_command
+
+
+#------------------------------------------------------------------------
+#
+# input
+#
+#------------------------------------------------------------------------
+
+sub bind_for_play_event {
+ my $cb = shift;
+ return unless $cb;
+ return unless $ivy;
+ $ivy->bindRegexp("ClockStart", [sub { shift; &$cb(); }]);
+
+} # end bind_for_play_event
+
+
+sub bind_for_pause_event {
+ my $cb = shift;
+ return unless $cb;
+ return unless $ivy;
+ $ivy->bindRegexp("ClockStop", [sub { shift; &$cb(); }]);
+
+
+} # end bind_for_pause_event
+
+
+# execute the callback with arguments <time> and <rate>
+sub bind_for_clock_and_rate_event {
+ my $cb = shift;
+ return unless $cb;
+ return unless $ivy;
+ $ivy->bindRegexp('ClockEvent Time=(\d\d):(\d\d):(\d\d) Rate=(.*) Bs=.*',
+ [sub { shift; &$cb(@_); }]);
+ $ivy->bindRegexp('ClockDatas Time=(\d\d):(\d\d):(\d\d) Rate=(.*) Bs=.*',
+ [sub { shift; &$cb(@_); }]);
+
+} # end bind_for_clock_event
+
+
+1;
diff --git a/src/ivycontrolpanel b/src/ivycontrolpanel
new file mode 100755
index 0000000..e0214bd
--- /dev/null
+++ b/src/ivycontrolpanel
@@ -0,0 +1,830 @@
+#!/usr/bin/perl
+#
+# ivycontrolpanel, an interface for controlling ivy agents
+#
+# Authors: created by Michelle Jacomi
+# rewritten by Daniel Etienne <etienne@cena.fr>
+#
+#
+
+use strict;
+use Carp;
+# where you may find bitmap files
+use lib "/usr/share/ivycontrolpanel";
+# where you may find the IvyIO and Agent modules
+use lib "/usr/lib/ivycontrolpanel";
+# where you may find the FugueConfig module
+use lib "/usr/lib/ivylaunch";
+
+# Tk classes
+use Tk;
+use Tk::DialogBox;
+use Tk::LabFrame;
+use Getopt::Long;
+# local modules
+use IvyIO;
+use FugueConfig;
+use Agent;
+
+use vars qw(%opt);
+#=================================================================================
+#
+# M A I N
+#
+#=================================================================================
+
+#---------------------------------------------------------------------------------
+#
+# variables definition
+#
+#---------------------------------------------------------------------------------
+
+# window size
+my $width = 1024;
+my $height = 768;
+
+# fonts spec
+my @fontspec34 = (-font =>
+ '-b&h-lucida-bold-r-normal-sans-34-240-100-100-p-216-iso8859-1');
+my @fontspec24 = (-font =>
+ '-b&h-lucida-bold-i-normal-sans-24-240-100-100-p-216-iso8859-1');
+my @fontspec20 = (-font =>
+ '-b&h-lucida-bold-r-normal-sans-20-140-100-100-p-127-iso8859-1');
+my @fontspec17 = (-font =>
+ '-adobe-helvetica-bold-r-normal--17-120-100-100-p-92-iso10646-1');
+
+# colors spec
+my $darkbg = '#1E161B';
+my $bg = '#5C5655';
+my $hlbg = '#7CC452';
+my $fg = '#FCFAFC';
+my $selcolor = 'yellow';
+
+# traffic rate spec
+my @rate = (-20..-1, -0.5, 0, 0.5, 1..20);
+my %rate2index;
+for (my $i=0; $i<@rate; $i++) {
+ $rate2index{$rate[$i]} = $i;
+}
+
+# flags
+my $isplaying;
+my $wasplayingBeforeSettingTime;
+my $wasplayingBeforeResettingRate;
+my $settingtime;
+
+# misc
+my $selectedtimelabel;
+my $ivylaunch_agent;
+
+
+#---------------------------------------------------------------------------------
+#
+# parse and test options
+#
+#---------------------------------------------------------------------------------
+
+&usage unless Getopt::Long::GetOptions(\%opt, 'b=s', 'nocursor', 'help');
+&usage if $opt{help};
+
+my ($fuguefile) = @ARGV;
+
+#---------------------------------------------------------------------------------
+#
+# init ivy
+#
+#---------------------------------------------------------------------------------
+
+IvyIO::init("ivycontrolpanel", $opt{b}, \&connected, \&disconnected);
+
+#---------------------------------------------------------------------------------
+#
+# build the mainwindow
+#
+#---------------------------------------------------------------------------------
+
+my $mw = MainWindow->new (-bg => 'black');
+
+if ($opt{nocursor}) {
+ open(CURSOR, ">/tmp/cursor-ivybanner");
+ print CURSOR "#define cursor_width 1\n";
+ print CURSOR "#define cursor_height 1\n";
+ print CURSOR "#define cursor_x_hot 0\n";
+ print CURSOR "#define cursor_y_hot 0 \n";
+ print CURSOR "static char cursor_bits[] = { 0x20};\n";
+ close(CURSOR);
+ $mw->configure(-cursor => ['@'.'/tmp/cursor-ivybanner',
+ '/tmp/cursor-ivybanner',
+ 'black', 'black']);
+ unlink("/tmp/cursor-ivybanner");
+} else {
+ $mw->configure(-cursor => 'circle');
+}
+$mw->geometry ($width."x".$height."--0+0");
+$mw->title ('ivycontrolpanel');
+$mw->client ('ivycontrolpanel');
+$mw->resizable(0,0);
+
+# geometry variables
+my $dxleft = 20;
+my $dxright = 20;
+my $dybot = 90;
+my $dytop = 20;
+my $ddy = 10;
+my $y;
+my $x;
+my $btn_h = $dybot - 3*$ddy;
+my $btn_w = $btn_h;
+my $fm_w = $btn_w + 10;
+my $fm_h = $btn_h + 10;
+
+# widgets attributes
+my @frameattr = (-relief => 'flat',
+ -highlightthickness => 3,
+ -highlightbackground => $hlbg,
+ -highlightcolor => $hlbg,
+ -height => $height - $dytop - $dybot,
+ -width => $width - $dxleft - $dxright,
+ -background => $bg);
+my @labelattr = (-width => 2, -height => 1,
+ @fontspec34,
+ -relief => 'flat',
+ -highlightthickness => 0,
+ -background => $bg,
+ -foreground => $fg);
+my @buttonattr = (@labelattr,
+ -borderwidth => 1,
+ -highlightbackground => $hlbg,
+ -highlightthickness => 3,
+ -width => $btn_w, -height => $btn_h,
+ -activebackground => $bg,
+ -activeforeground => $fg);
+
+my @cbuttonattr = (-relief => 'flat',
+ -highlightthickness => 0,
+ -background => $darkbg,
+ -foreground => $fg,
+ @fontspec20,
+ -activeforeground => $fg,
+ -activebackground => $bg,
+ -selectcolor => $selcolor);
+
+my $fm1 = $mw->Frame(-background => $darkbg)->pack(-expand => 1, -fill => 'both');
+
+
+$x = $dxleft;
+$y = $height - $dybot + $ddy;
+
+# build information fields
+#---------------------------------------------------------------------------------
+my $fm2 = $fm1->Frame(@frameattr,
+ -background => $darkbg)->place(-x => $dxleft, -y => $dytop);
+
+
+$fm1->Label(-borderwidth => 0,
+ -relief => 'flat',
+ -highlightthickness => 0,
+ -background => $darkbg,
+ -foreground => $bg,
+ -text => ' [ Bus ] '.(($opt{b}) ? $opt{b} : 'default').' '.
+ '[ File ] '.(($fuguefile) ? $fuguefile : 'none').' ',
+ @fontspec17,
+ -foreground => $hlbg)->place(-x => $dxleft+20, -y => $dytop-10);
+
+# build traffic rate frame
+#---------------------------------------------------------------------------------
+my $prevbmp = $mw->Bitmap('prev', -file => Tk::findINC('prev.bmp'),
+ -background => $bg,
+ -foreground => $hlbg);
+my $nextbmp = $mw->Bitmap('next', -file => Tk::findINC('next.bmp'),
+ -background => $bg,
+ -foreground => $hlbg);
+
+my $btn_prev = $fm1->Button(@buttonattr,
+ -image => $prevbmp,
+ )->place(-x => $x, -y => $y );
+
+$x += $btn_w + 15;
+my $fm_lab = $fm1->Frame(@frameattr,
+ -width => $fm_w,
+ -height => $fm_h)->place(-x => $x, -y => $y);
+my $lab_rate = $fm_lab->Label(@labelattr,
+ -anchor => 'center',
+ -text => 1)->place(-x => 7, -y => 10);
+
+$x += $fm_w + 5;
+my $btn_next = $fm1->Button(@buttonattr,
+ -image => $nextbmp,
+ )->place(-x => $x, -y => $y);
+$x += $btn_w + 15;
+
+&setloopcommand($btn_prev, \&decrease_rate);
+&setloopcommand($btn_next, \&increase_rate);
+
+
+$lab_rate->bind('<ButtonPress>', [sub {
+ &display_rate(1);
+ IvyIO::send_rate(1);
+
+}]);
+
+
+# build hour frame
+#---------------------------------------------------------------------------------
+$x += 90;
+my $xi;
+
+# next/prev buttons
+my $btn_tprev = $fm1->Button(@buttonattr,
+ -image => $prevbmp,
+ )->place(-x => $x-$fm_w-5, -y => $y + 80);
+
+my $fm_lab = $fm1->Frame(@frameattr,
+ -width => 3*$fm_w,
+ -height => $fm_h)->place(-x => $x, -y => $y);
+# separators
+$xi = -13 ;
+for (my $i=0; $i<2; $i++) {
+ $xi += $fm_w;
+ $fm_lab->Label(@labelattr,
+ -width => 0,
+ -anchor => 'center',
+ -text => ':')->place(-x => $xi, -y => $ddy);
+}
+# hour, minutes, seconds
+$xi = 5;
+my $lab_hour = $fm_lab->Label(@labelattr,
+ -anchor => 'center',
+ -text => '00')->place(-x => $xi, -y => $ddy);
+$xi += $fm_w;
+my $lab_min = $fm_lab->Label(@labelattr,
+ -anchor => 'center',
+ -text => '00')->place(-x => $xi, -y => 10);
+$xi += $fm_w;
+my $lab_sec = $fm_lab->Label(@labelattr,
+ -anchor => 'center',
+ -text => '00')->place(-x => $xi, -y => 10);
+
+$lab_hour->bind('<1>', [\&settime, 0]);
+$lab_min->bind('<1>', [\&settime, 1]);
+$lab_sec->bind('<1>', [\&settime, 2]);
+
+$x += 3*$fm_w + 10;
+
+my $btn_tnext = $fm1->Button(@buttonattr,
+ -image => $nextbmp,
+ )->place(-x => $x-5, -y => $y + 80);
+
+
+
+IvyIO::bind_for_clock_and_rate_event(sub {
+ my ($h, $m, $s, $rate) = @_;
+ #print "bind_for_clock_and_rate_event time=$h:$m:$s rate=$rate\n";
+ &display_play unless $isplaying;
+ &display_time($lab_hour, $h);
+ &display_time($lab_min, $m);
+ &display_time($lab_sec, $s);
+ &display_rate($rate);
+});
+
+# build traffic control frame
+#---------------------------------------------------------------------------------
+$x += 90;
+my $playbmp = $mw->Bitmap('play', -file => Tk::findINC('play.bmp'),
+ -background => $bg,
+ -foreground => $hlbg);
+my $pausebmp = $mw->Bitmap('pause', -file => Tk::findINC('pause.bmp'),
+ -background => $bg,
+ -foreground => $hlbg);
+my @buttonattr = (@buttonattr,
+ -width => $btn_w);
+my @pushedbuttonattr = (@buttonattr,
+ -highlightbackground => 'red',
+ -foreground => 'red');
+
+my $playbtn = $fm1->Button(@buttonattr,
+ -image => $playbmp,
+ )->place(-x => $x, -y => $y);
+
+$x += $btn_w + 20;
+my $pausebtn = $fm1->Button(@buttonattr,
+ -image => $pausebmp,
+ )->place(-x => $x, -y => $y );
+$x += $btn_w + 20;
+
+$playbtn->configure(-command => \&play);
+
+$pausebtn->configure(-command => \&pause);
+
+IvyIO::bind_for_play_event(\&display_play);
+IvyIO::bind_for_pause_event(\&display_pause);
+
+
+# Quit button
+#---------------------------------------------------------------------------------
+$x = $width - $dxright - $fm_w;
+
+my $quitbmp = $mw->Bitmap('quit', -file => Tk::findINC('quit.bmp'),
+ -background => $bg,
+ -foreground => $hlbg);
+
+$fm1->Button(@buttonattr,
+ -image => $quitbmp,
+ -command => \&quitdialogbox,
+ )->place(-x => $x, -y => $y);
+$x -= $fm_w + 10;
+
+
+#---------------------------------------------------------------------------------
+#
+# load fugue config file and create agents panel
+#
+#---------------------------------------------------------------------------------
+
+my ($code, @fugueconfigdata);
+if ($fuguefile) {
+ ($code, @fugueconfigdata) = &FugueConfig::parse($fuguefile);
+ die "Cant' parse fugue config file $fuguefile\n" unless $code;
+}
+
+my $x0 = $dxleft + 20;
+my $y0 = $dytop + 25;
+my $rmax = 10;
+my $cmin = 2;
+my $wmax = ($width-2*$x0);
+my $dy = 64;
+my %hosts;
+
+Agent->configure($mw, $bg, $fg, $selcolor, $hlbg, $darkbg, \@fontspec20,
+ $x0, $y0, $wmax, $dy, $cmin, $rmax, $opt{b});
+
+for (@fugueconfigdata) {
+ next unless $_->[0] eq 'global' or $_->[0] eq 'local';
+ my ($type, $host, $appname, $command, $params) = @$_;
+ $hosts{$host} = 1;
+ if ($appname eq 'ivylaunch') {
+ $ivylaunch_agent++;
+ } elsif ($appname ne 'ivycontrolpanel') {
+ Agent->new($appname, $host, $command, $params, 0);
+ }
+}
+
+Agent->hosts(keys(%hosts));
+
+
+MainLoop;
+
+#=================================================================================
+#
+# F U N C T I O N S
+#
+#=================================================================================
+
+sub usage {
+ print "Usage : ivycontrolpanel [-help] [-b ivybus] [-nocursor] [fugueconfigfile]\n";
+ print "\n";
+ print "Options :\n";
+ print " -b ivybus bus ivy\n";
+ print " -nocursor hide mouse cursor\n";
+ print "\n";
+ exit 0;
+
+} # end usage
+
+
+sub killandquit {
+ Agent->killall;
+ $mw->after(1500, sub {
+ Agent->kill('ivylaunch') if $ivylaunch_agent > 0;
+ &quit;});
+
+} # end killandquit
+
+
+sub quit {
+ exit(0);
+
+} # quit
+
+
+# function called when you press and maintain on a button
+sub setloopcommand {
+ my ($widget, $command) = @_;
+ $widget->bind('<1>', sub {
+ &$command;
+ my $repeatid;
+ my $afterid = $widget->after(500, sub {
+ $repeatid = $widget->repeat(100, \&$command);
+ });
+ $widget->bind('<ButtonRelease-1>', sub {
+ $widget->afterCancel($repeatid);
+ $widget->afterCancel($afterid);
+ });
+ });
+
+} # end setloopcommand
+
+
+sub unsetloopcommand {
+ my ($widget) = @_;
+ $widget->bind('<1>', '');
+ $widget->bind('<ButtonRelease-1>', '');
+
+} # end unsetloopcommand
+
+
+# create a dialog box to quit and/or kill all agents on bus
+sub quitdialogbox {
+ my $tl = $mw->Toplevel(-background => $darkbg);
+ $tl->title('ivycontrolpanel');
+ $tl->resizable(0, 0);
+ my $fm = $tl->Frame(-background => $darkbg,
+ -highlightthickness => 3,
+ -highlightbackground => $hlbg,
+ )->pack(-side => 'top', -padx => 0, -pady => 0);
+ my $fm1 = $fm->Frame(-background => $darkbg)->pack(-side => 'bottom');
+ my @labelattr = (-relief => 'flat',
+ -background => $darkbg,
+ -foreground => $fg,
+ -borderwidth => 0,
+ -highlightthickness => 0,
+ -height => 2,
+ @fontspec24);
+ my @buttonattr = (-relief => 'flat',
+ -background => $bg,
+ -foreground => $fg,
+ -borderwidth => 1,
+ -highlightbackground => $hlbg,
+ -highlightthickness => 3,
+ -height => 2,
+ -activebackground => $bg,
+ -activeforeground => $fg,
+ @fontspec24);
+ my $l = $fm->Label(@labelattr, -text => "kill all agents ?",
+ )->pack(-side => 'top', -padx => 20, -pady => 20,
+ -expand => 1, -fill => 'both');
+ $fm1->Button(@buttonattr, -text => 'yes',
+ -command => sub {
+ $l->configure(-text => $l->cget(-text)."...\nwait...");
+ &killandquit;
+ },
+ )->pack(-side => 'left', -padx => 20, -pady => 20,
+ -expand => 1, -fill => 'both');
+ $fm1->Button(@buttonattr, -text => 'cancel',
+ -command => sub { $tl->destroy },
+ )->pack(-side => 'left', -padx => 20, -pady => 20,
+ -expand => 1, -fill => 'both');
+ # placement at window center
+ $tl->update;
+ my ($x, $y) = ($mw->rootx, $mw->rooty);
+ $x += int($width/2 - $tl->width/2);
+ $y += int($height/2 - $tl->height/2);
+ $tl->geometry('+'.$x.'+'.$y);
+
+
+} # end quitdialogbox
+
+
+#---------------------------------------------------------------------------------
+#
+# Agents Functions
+#
+#---------------------------------------------------------------------------------
+# called when an ivy agent connects.
+sub connected {
+ my ($agent, $host) = @_;
+ if ($agent eq 'ivylaunch') {
+ $ivylaunch_agent++;
+ } elsif ($agent ne 'ivycontrolpanel') {
+ Agent->connect($agent, $host);
+ }
+} # end connected
+
+
+# called when an ivy agent disconnects.
+sub disconnected {
+ my ($agent, $host) = @_;
+ if ($agent eq 'ivylaunch') {
+ $ivylaunch_agent--;
+ } elsif ($agent ne 'ivycontrolpanel') {
+ Agent->disconnect($agent);
+ }
+
+} # end disconnected
+
+#---------------------------------------------------------------------------------
+#
+# Functions dedicated to play/pause buttons
+#
+#---------------------------------------------------------------------------------
+# called on user interaction to start traffic
+sub play {
+ if ($settingtime) {
+ $mw->bell;
+ return;
+ }
+ &display_play;
+ IvyIO::send_play();
+
+} # end play
+
+
+# called on user interaction to stop traffic
+sub pause {
+ &display_pause;
+ IvyIO::send_pause();
+
+} # end pause
+
+
+# graphical update when traffic starts
+sub display_play {
+ return if $isplaying == 1;
+ $isplaying = 1;
+ &btnpush($playbtn, $playbmp);
+ &btnpull($pausebtn, $pausebmp);
+
+} # end display_play
+
+
+# graphical update when traffic stops
+sub display_pause {
+ return if defined($isplaying) and $isplaying == 0;
+ $isplaying = 0;
+ &btnpull($playbtn, $playbmp);
+ &btnpush($pausebtn, $pausebmp);
+
+} # end display_pause
+
+
+# graphical update when a button is pushed
+sub btnpush {
+ my ($btn, $bmp) = @_;
+ $btn->configure(-highlightbackground => $selcolor);
+ $bmp->configure(-foreground => $selcolor);
+
+} # end btnpush
+
+
+# graphical update when a button is pulled
+sub btnpull {
+ my ($btn, $bmp) = @_;
+ $btn->configure(-highlightbackground => $hlbg);
+ $bmp->configure(-foreground => $hlbg);
+
+} # end btnpull
+
+#---------------------------------------------------------------------------------
+#
+# Rate management functions
+#
+#---------------------------------------------------------------------------------
+# find in the predefined rate list @rate the value closest given rate
+sub findclosestrate {
+ my $rate = shift;
+ my $sign = shift;
+ my $i1;
+ my $i2;
+ for (my $i=0; $i<@rate; $i++) {
+ if ($rate > $_) {
+ $i1 = $i;
+ } else {
+ $i2 = $i;
+ last;
+ }
+ }
+ if ($sign eq '-') {
+ return $i1;
+ } else {
+ return $i2;
+ }
+
+} # end findclosestrate
+
+# called on user interaction to decrease rate
+sub decrease_rate {
+ my $rate = $lab_rate->cget(-text);
+ if ($rate <= $rate[0]) {
+ $mw->bell;
+ return;
+ }
+ my $index = $rate2index{$rate};
+ if (defined($index)) {
+ $rate = $rate[$index-1];
+ } else {
+ $index = &findclosestrate($rate, '-');
+ if ($index == 0) {
+ $rate = $rate[$index];
+ } else {
+ $rate = $rate[$index-1];
+ }
+ }
+ &display_rate($rate);
+ IvyIO::send_rate($rate);
+
+} # end decrease_rate
+
+
+# called on user interaction to increase rate
+sub increase_rate {
+ my $rate = $lab_rate->cget(-text);
+ if ($rate >= $rate[-1]) {
+ $mw->bell;
+ return;
+ }
+ my $index = $rate2index{$rate};
+ if (defined($index)) {
+ $rate = $rate[$index+1];
+ } else {
+ $index = &findclosestrate($rate, '+');
+ if ($index == $#rate) {
+ $rate = $rate[$index];
+ } else {
+ $rate = $rate[$index+1];
+ }
+ }
+ &display_rate($rate);
+ IvyIO::send_rate($rate);
+
+} # end increase_rate
+
+
+# graphical update when rate is displayed
+sub display_rate {
+ my ($rate) = shift;
+ $rate =~ s/\.0+$//;
+ if (length($rate) > 2) {
+ $lab_rate->configure(-width => 3, @fontspec24);
+ $lab_rate->place(-x => 5, -y => 15);
+ } else {
+ $lab_rate->configure(-width => 2, @fontspec34);
+ $lab_rate->place(-x => 7, -y => 10);
+ }
+ $lab_rate->configure(-text => $rate);
+ if ($rate == 0 and $isplaying) {
+ &display_pause;
+ $wasplayingBeforeResettingRate = 1;
+ } elsif ($isplaying == 0 and $wasplayingBeforeResettingRate == 1) {
+ &play;
+ $wasplayingBeforeResettingRate = 0;
+ }
+
+} # end display_rate
+
+#---------------------------------------------------------------------------------
+#
+# Time management functions
+#
+#---------------------------------------------------------------------------------
+
+# called on user interaction : activates buttons to increase/decrease values
+# of time fields
+sub settime {
+ my ($lab, $field, $x, $y) = @_;
+ my %placeinfo = $btn_tprev->placeInfo;
+ my $y = $placeinfo{-y};
+ if ($isplaying) {
+ &pause;
+ $wasplayingBeforeSettingTime = 1;
+ }
+ if ($selectedtimelabel eq $lab) {
+ $selectedtimelabel = undef;
+ $lab->configure(-background => $bg, -foreground => $fg);
+ $btn_tprev->place(-y => $y + 80);
+ $btn_tnext->place(-y => $y + 80);
+ &unsetloopcommand($btn_tprev);
+ &unsetloopcommand($btn_tnext);
+ my $time = $lab_hour->cget(-text).':'.$lab_min->cget(-text).':'.
+ $lab_sec->cget(-text);
+ IvyIO::send_time($time);
+ $settingtime = 0;
+ if ($wasplayingBeforeSettingTime) {
+ &play;
+ $wasplayingBeforeSettingTime = 0;
+ }
+ } else {
+ $settingtime = 1;
+ for ($lab_hour, $lab_min, $lab_sec) {
+ $_->configure(-background => $bg, -foreground => $fg);
+ }
+ $lab->configure(-background => $fg, -foreground => $bg);
+ unless (defined $selectedtimelabel) {
+ $btn_tprev->place(-y => $y - 80);
+ $btn_tnext->place(-y => $y - 80);
+ }
+ $selectedtimelabel = $lab;
+ &setloopcommand($btn_tprev, sub {&decrease_time($lab, $field)});
+ &setloopcommand($btn_tnext, sub {&increase_time($lab, $field)});
+
+ }
+
+} # end settime
+
+# called on user interaction to increase the value of a time field.
+sub increase_time {
+ my ($lab, $field) = @_;
+ my $val = $lab->cget(-text);
+ if ($field == 0 and $val == 23 or $field > 0 and $val == 59) {
+ $val = 0;
+ } else {
+ $val += 1;
+ }
+ &display_time($lab, $val);
+
+} # end increase_time
+
+
+# called on user interaction to decrease the value of a time field.
+sub decrease_time {
+ my ($lab, $field) = @_;
+ my $val = $lab->cget(-text);
+ if ($field == 0 and $val == 0) {
+ $val = 23;
+ } elsif ($field > 0 and $val == 0) {
+ $val = 59;
+ } else {
+ $val -= 1;
+ }
+ &display_time($lab, $val);
+
+} # end decrease_time
+
+# graphical update when the value of a time field is set
+sub display_time {
+ my ($lab, $val) = @_;
+ return unless defined($val);
+ $val = '0'.$val if length($val) == 1;
+ $lab->configure(-text => $val);
+
+} # end display_time
+
+
+
+=head1 NAME
+
+ivycontrolpanel - an interface for controlling ivy agents
+
+=head1 SYNOPSIS
+
+ivycontrolpanel [-help] [-b bus] [-nocursor] [fugueconfigfile]
+
+=head1 DESCRIPTION
+
+ivycontrolpanel blabla.
+
+description des interactions de controle (vitesse, réglage de l'heure,
+play/pause, sortie)
+
+description du panneau agents.
+
+=head1 OPTIONS
+
+=over
+
+=item B<-b> bus
+
+Specify the ivy bus.
+
+=item B<-nocursor>
+
+Hide mouse cursor (for touchscreen usage).
+
+=back
+
+=head1 FILE FORMAT
+
+The format of fugue configuration files is described in ivylaunch(1) man page.
+
+=head1 SEE ALSO
+
+ivylaunch(1), ivybanner(1)
+
+=head1 AUTHORS
+
+Daniel Etienne <etienne@cena.fr>
+
+Michelle Jacomi
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
generated by cgit v1.1 at 2024-11-01 09:35:14 +0000