#!/usr/local/bin/perl -w
#
# Bouncing Balls Simulator
# 
# This began as a borrowed idea from Python distribution 
# examples, ended up with a Ball module of its own. It 
# illustrates how one can run something without blocking
# xevent processing in a simple-minded sorta way. 
#
# Handles resizes to the main window
#
# Gurusamy Sarathy
# send comments to gsar@engin.umich.edu
#

#$| = 1;
require 5.000;
use English;
use Tk;
use AddINC qw(.);
use Ball;

# (Ripped from nTk examples)
# Make a Menubutton widget; note that the menu is automatically created.  
# We maintain a list of the Menubutton references since some callers 
# need to refer to the Menubutton, as well as to suppress stray name 
# warnings with Perl -w.
#
sub mkmb {

  my($mb_label, $mb_label_underline, $mb_msg, $mb_list_ref) = @ARG;
  my $mb = $menubar->Menubutton(-text => $mb_label, 
                                -underline => $mb_label_underline,
                                -background => 'DarkGreen',
                                -foreground => 'Yellow');
  my($menu) = $mb->Menu(-tearoff => 0);
  $mb->configure(-menu => $menu);

  foreach $mb_list (@{$mb_list_ref}) {
        $mb->command(-label => $mb_list->[0], 
                     -command => $mb_list->[1] , 
                     -underline => $mb_list->[2], 
                     -background => 'DarkGreen',
                     -foreground => 'White');
  }
  $mb->pack(-side => 'left');
#  $mb->bind('<Enter>' => sub {$status->insert('1.0', $mb_msg);});          # cant do this  
  $top->bind($mb, '<Enter>' => eval 'sub {&ClearMsg; &ShowMsg($mb_msg);}'); # true closures needed !
  $top->bind($mb, '<Leave>' => \&ClearMsg);

  push @menu_button_list, $mb;
  return $mb;
}

sub SimStart {
  if (!$running) {
        $running = 1;
        $menu_button_list[1]->cget(-menu)->entryconfigure(0, -state => 'disabled');
        $menu_button_list[1]->cget(-menu)->entryconfigure(1, -state => 'normal');
  }
}

sub SimStop {
  if ($running) {
        $running = 0;
        $menu_button_list[1]->cget(-menu)->entryconfigure(0, -state => 'normal');
        $menu_button_list[1]->cget(-menu)->entryconfigure(1, -state => 'disabled');
  }
}

sub NotDone {
  print "Not yet implemented.\n";
}

sub ShowMsg {
  my($msg) = shift;
  $status->insert('1.0', $msg);  
}

sub ClearMsg {
  $status->delete('1.0', 'end');
}
#
# The simulation handler
#
# Note that this handler must be cooperative and return
# after a short period, so that other X events may be 
# processed by the mainloop below
#
sub DoSingleStep {
  my($deltax, $deltay);
  &ClearMsg;
  &ShowMsg(++$counter);  

  #  $ballobj->moveAll;
  Ball->moveAll($speed->get() / 100.0);
}

#
#
# Main program
#
# 

$top = MainWindow->new;
$top->title('Prototype Simulator');
$top->wm('minsize', 0, 0);

$menubar = $top->Frame(-relief => 'raised', 
                       -background => 'DarkGreen',
                       -borderwidth => 2);
$menubar->pack(-side => 'top', -fill => 'x');

mkmb('File', 0, 'File related stuff',
         [
          ['Open',      \&NotDone,     0],
          ['New',       \&NotDone,     0],
          ['Print',     \&NotDone,     0],
          ['Exit',      sub {exit;},   0],
          ]);

mkmb('Simulate', 0, 'Simulator control',
     [
      ['Start',     \&SimStart,    2],
      ['Stop',      \&SimStop,     2],
     ]);

mkmb('Display', 0, 'Display settings',
     [
      ['Redraw',    \&NotDone,     2],
      ['Clear',     \&NotDone,     2],
     ]);

mkmb('Options', 0, 'Various preferences',
     [
      ['Steptime',  \&NotDone,     0],
      ['Colors',    \&NotDone,     0],
      ['Display',   \&NotDone,     0],
     ]);

mkmb('Help', 0, 'There when you need it',
     [
      ['About..',   \&NotDone,     0],
      ['Intro',     \&NotDone,     0],
      ['Contents',  \&NotDone,     0],
     ]);
$menu_button_list[$#menu_button_list]->pack(-side => 'right');

$feedback = $top->Frame();
$feedback->pack(-side => 'bottom', -fill => 'x');
$status = $feedback->Text(-relief => 'sunken',
                          -height => 1,
                          -background => 'gray',
                          -borderwidth => 2);
$status->pack(-side => 'left', -fill => 'x', -expand => 1);

$drawarea = $top->Frame();
$drawarea->pack(-side => 'top', -fill => 'both', -expand => 1);

$canvas = $drawarea->Canvas(-relief => 'ridge',
                            -height => 400,
                            -width => 600,
                            -borderwidth => 2);
$canvas->pack(-side => 'left', -fill => 'both', -expand => 1);
#$top->bind($canvas, '<Configure>' => sub { my $w = shift;
#                                           my $Ev = $w->XEvent;
#                                           $w->configure(-width => $Ev->w, -height => $Ev->h);});

$speed = $drawarea->Scale(-orient => 'vert',
                          -showvalue => 0,
                          -width => 10,
                          -from => 100, 
                          -to => 0,
                          -borderwidth => 1);
$speed->pack(-side => 'left', -fill => 'y');
$speed->bind('<Enter>' => sub {&ClearMsg; &ShowMsg('Adjust slider for ball speed');});
$speed->bind('<Leave>' => \&ClearMsg);
$speed->set(50);

$running = 0; 
$menu_button_list[1]->cget(-menu)->entryconfigure(1, -state => 'disabled');

Ball->new($canvas);
Ball->new($canvas, 'red', 30, [200, 75], [6.0, 9.0]);
Ball->new($canvas, 'green', 60, [490, 275], [8.0, 12.0]);
Ball->new($canvas, 'yellow', 100, [360, 60], [8.0, 12.0]);

$counter = 0;

#
# This runs the Tk mainloop. Note that the simulation itself
# has a main loop which must be processed. DoSingleStep runs
# a bit of the simulation during every iteration. Also note 
# that, with a flag of 0, Tk::DoOneEvent will suspend the 
# process until an X-event arrives, effectively blocking the 
# while loop. 
#
# My original idea was to run the simulation mainloop as an 
# asynchronous proc handler that runs when Tk is idle,
# but the necessary Async(3) calls from Tcl haven't made it
# into nTk yet
#

while (1) {
  DoOneEvent(($running) ? 1 : 0);  # process X events, and don't wait if no events around to process
  DoSingleStep if ($running); # do a bit of bouncing around if we're on
}


