algotutor 0.8.6-1 / usr / share / algotutor / RecDialog.pm

# Author:  Chao-Kuei Hung
# For more info, including license, please see doc/index.html

package RecDialog;

use strict;
use Carp;
use RecCanvas;
use base qw(Tk::Toplevel);

# see perldoc Tk::mega and perldoc Tk::composite
Construct Tk::Widget 'RecDialog';

sub Populate {
    my ($self, $args) = @_;

    $self->{"#canvas"} = delete $args->{-canvas};
    my ($lowest, $c);
    foreach $c (@{ $self->{"#canvas"} }) {
	$lowest = $c if (not defined $lowest or
	    $c->cget(-elevation) < $lowest->cget(-elevation) );
	$c->configure(-coordinator=>$self);
    }
    $self->{"#lowest_canvas"} = $lowest;
#    my (@ml) = $ml ? (-maxlevel=>$ml) : ();
#    my ($buttons) = delete $args->{-buttons};
    $self->{"#slevel"} = (delete $args->{-slevel} or 0); # scale level

    $self->SUPER::Populate($args);
    $self->Component("Frame", "menubar", -relief=>"raised", -bd=>2);
    $self->Subwidget("menubar")->pack(-side=>"top", -fill=>"x");
    $self->Component("Frame", "statusbar", -relief=>"sunken", -bd=>2);
    $self->Subwidget("statusbar")->pack(-side=>"bottom", -fill=>"x");
    $self->Component("Frame", "timebar", -relief=>"sunken", -bd=>2);
    $self->Subwidget("timebar")->pack(-side=>"bottom", -fill=>"x");
#    my ($c) = $self->Scrolled("RecCanvas", -scrollbars=>"osow", @ml);
#    $self->Advertise("worksp"=>$c);
#    $self->Subwidget("worksp")->pack(-side=>"top", -fill=>"both",
#	-expand=>"yes");

    $self->Subwidget("timebar")->Component("Scale", "timeknob",
	-orient=>"horizontal", -showvalue=>0, # -width=>"3m",
	-command=>sub { $self->timeknob_seek($_[0]); }
    );
    $self->Subwidget("timebar")->Subwidget("timeknob")->pack(-side=>"right",
	-expand=>1, -fill=>"both");
    $self->Subwidget("timebar")->Component("Label", "clock",
	-width=>$self->{"#slevel"}*6+6);
#        -textvariable=>\${ $c->Subwidget("reccanvas") }{"#now"} );
    $self->Subwidget("timebar")->Subwidget("clock")->pack(-side=>"left", -fill=>"both");

#    $self->Delegates(DEFAULT => $self->Subwidget("worksp"));
    $self->ConfigSpecs(
	-recorder=>[qw(METHOD recorder Recorder 0)],
	-clockstring=>[qw(PASSIVE clockstring ClockString), \&_clock_string_],
	-bg=>[qw(DESCENDANTS background Background)],
#	DEFAULT=>[$self->Subwidget("worksp")]
    );
}

sub incr_other_canvases {
    my ($self, $initiator) = @_;
    my ($rc);
    $initiator = $initiator->cget(-name);
    foreach $rc (@{ $self->{"#canvas"} }) {
	# next if $rc eq $initiator;
	# wrong! $rc might also be the scrolled version of $initiator
	next if $rc->cget(-name) eq $initiator;
	$rc->no_op();
    }
}

sub mark_other_canvases {
    my ($self, $initiator, $absolute_level) = @_;
    my ($rc);
    $initiator = $initiator->cget(-name);
    foreach $rc (@{ $self->{"#canvas"} }) {
	# next if $rc eq $initiator;
	# wrong! $rc might also be the scrolled version of $initiator
#my ($t) = $rc->Subwidget("scrolled");
#print " [elev", $t->{-elevation}, "] : $t->{'#now'}";
	next if $rc->cget(-name) eq $initiator;
	$rc->set_mark($absolute_level - $rc->cget(-elevation), "final");
    }
#print "\n";
}

sub seek_bkwd_at_level {
    my ($self, $level) = @_;
    my ($tk, $rc, $pos);
#    my ($rc) = $self->Subwidget("worksp")->Subwidget("reccanvas");
    $tk = $self->Subwidget("timebar")->Subwidget("timeknob");
    $rc = $self->{"#lowest_canvas"};
    $pos = $rc->find_backward_stop($level);
    $tk->set($rc->get_mark_at($pos, $self->{"#slevel"}));
    $tk->update();
    # no need to $rc->time_seek -- $tk->timeknob_seek will be
    # automatically invoked and will do just that
    $self->_update_status_();
}

sub seek_fwd_at_level {
    my ($self, $level) = @_;
    my ($tk, $rc, $pos);
    $tk = $self->Subwidget("timebar")->Subwidget("timeknob");
    $rc = $self->{"#lowest_canvas"};
    $pos = $rc->find_forward_stop($level);
    $tk->set($rc->get_mark_at($pos, $self->{"#slevel"}));
    $tk->update();
    # no need to $rc->time_seek -- $tk->timeknob_seek will be
    # automatically invoked and will do just that
    $self->_update_status_();
}

sub timeknob_seek {
    my ($self, $target) = @_;
    my ($tk, $rc);
    $tk = $self->Subwidget("timebar")->Subwidget("timeknob");
    foreach $rc (@{ $self->{"#canvas"} }) {
	$rc->time_seek($rc->find_position($self->{"#slevel"}, $target));
    }
    $tk->set($target) if ($target != $tk->get()); # avoid deep recursion
    $tk->update();
    $self->_update_status_();
}

sub _clock_string_ {
    my ($self) = @_;
    my ($r, $s, $rc, $now);
    $rc = $self->{"#canvas"}[0];
    $now = [ $rc->get_mark() ];
    $s = [ $rc->relative_mark($now) ];
#    $now = [ reverse @$now ]; pop @$now;
    $s = [ reverse @$s ]; pop @$s;
    return join(".", @$s) # . "\n" . join(".", @$now);
#    foreach $rc (@{ $self->{"#canvas"} }) {
#	$now = [ $rc->get_mark() ];
#	$s = [ reverse $rc->relative_mark($now) ];
##print "($now)";
##	$s = join ".", $rc->get_mark_at($now);
#	push @$r, join ".", @$s; #@{$s}[1..$#$s];
#    }
#    return join "\n", @$r;
}

sub _update_status_ {
    my ($self) = @_;
    $self->Subwidget("timebar")->Subwidget("clock")->configure(
	-text => $self->{Configure}{-clockstring}->($self)
    );
}

sub recorder {
    my ($self, $state) = @_;
    my ($tk) = $self->Subwidget("timebar")->Subwidget("timeknob");
    my ($rc) = $self->{"#lowest_canvas"};
    my ($lv) = $self->{"#slevel"};
    $tk->configure(-to=>$rc->total_marks($lv));
    $tk->set($rc->get_mark($lv));

    # $tk->update;
    # Uncomment this line in case the Scale widget gets confused
    # after the -to configuration and the set operation.
    # (Might have been just an artifact of bugs in my old code.) 

    foreach $rc (@{ $self->{"#canvas"} }) {
	$rc->configure(-recorder=>$state);
    }
}

if ($0 =~ /RecDialog.pm$/) {
# being tested as a stand-alone program, so run test code.

use Tk;
my ($main, $rc, $rd, $mb);
$main = MainWindow->new();
$rc = $main->Scrolled("RecCanvas", -scrollbars=>"osow",
    -elevation=>4, -maxlevel=>6, -width=>300, -height=>200);
$rc->pack(-expand=>"yes", -fill=>"both");
$rd = $main->RecDialog(-slevel=>4, -canvas=>[$rc]);
$rd->protocol("WM_DELETE_WINDOW", sub { exit; });
$mb = $rd->Subwidget("menubar");
$mb->{file} = $mb->Menubutton(
    -text=>"File", -tearoff=>0, -menuitems=>[
	["command"=>"Quit", -command=>sub { exit; } ]
    ]
);
$mb->{x1} = $mb->Button(-text=>"|<-", -command=>
    sub { $rd->seek_bkwd_at_level(6); } );
$mb->{x2} = $mb->Button(-text=>"<<-", -command=>
    sub { $rd->seek_bkwd_at_level(5); } );
$mb->{x3} = $mb->Button(-text=>"<--", -command=>
    sub { $rd->seek_bkwd_at_level(4); } );
$mb->{x4} = $mb->Button(-text=>"-->", -command=>
    sub { $rd->seek_fwd_at_level(4); } );
$mb->{x5} = $mb->Button(-text=>"->>", -command=>
    sub { $rd->seek_fwd_at_level(5); } );
$mb->{x6} = $mb->Button(-text=>"->|", -command=>
    sub { $rd->seek_fwd_at_level(6); } );
$mb->{file}->pack(@{$mb}{qw(x1 x2 x3 x4 x5 x6)}, -side=>"left");

my ($i, $j, $block);
for ($i=0; $i<4; ++$i) {
    for ($j=0; $j<4; ++$j) {
	$block->[$i][$j] = $rc->createRectangle(
	    $j*40+20, $i*30+15, $j*40+40, $i*30+30);
	$rc->itemconfigure($block->[$i][$j], -outline=>"hidden");
    }
}
$rd->configure(-recorder=>1);
for ($i=0; $i<4; ++$i) {
    for ($j=0; $j<4; ++$j) {
	$rc->itemconfigure($block->[$i][$j], -outline=>"cyan");
	$rc->itemconfigure($block->[$i][$j], -outline=>"yellow");
	$rc->itemconfigure($block->[$i][$j], -outline=>"magenta");
	$rc->set_mark(0);
    }
    $rc->set_mark(1);
}
$rd->configure(-recorder=>0);
MainLoop();

}

1;