# vim: syntax=perl

use RecDialog;

$^W = 1;

sub gen_can {
    # Generate a canvas. 
    # If $title is not given, the canvas lives in the tk default main window;
    # otherwise it is a new toplevel is generated.
    my ($mw, $title, %opts) = @_;
    my ($tl) = defined $title ? $mw->Toplevel(-title=>$title) : $mw;
    $title = "main" unless defined $title;
    my ($rc) = $tl->Scrolled("RecCanvas", -scrollbars=>"osow",
	-width=>300, -height=>200, -name=>$title, %opts);
    $rc->pack(-expand=>"yes", -fill=>"both");
    return $rc;
}

sub gen_ctrl {
    my ($mw, $can, %opts) = @_;
    my ($ctrl) = $mw->RecDialog(-slevel=>1, -canvas=>[values %$can]);
#	-clockstring=>\&gen_clock_string
    $ctrl->protocol("WM_DELETE_WINDOW", sub { exit; });
    $ctrl->configure(-recorder=>1);
    my ($mb) = $ctrl->Subwidget("menubar");
    $mb->{file} = $mb->Menubutton(
	-text=>"File", -tearoff=>0, -menuitems=>[
	    ["command"=>"export", -command=>sub { on_export($can); }, -underline=>1 ],
	    ["command"=>"quit", -command=>sub { exit; }, -underline=>0 ]
	]
    );
    my ($e) = $ctrl->{"#lowest_canvas"}->cget(-elevation);
    $mb->{b3} = $mb->Button(-text=>"|<-", -command=>
	sub { $ctrl->seek_bkwd_at_level($e+9); } );
    $mb->{b2} = $mb->Button(-text=>"<<-", -command=>
	sub { $ctrl->seek_bkwd_at_level($e+2); } );
    $mb->{b1} = $mb->Button(-text=>"<- ", -command=>
	sub { $ctrl->seek_bkwd_at_level($e+1); } );
    $mb->{b0} = $mb->Button(-text=>"<  ", -command=>
	sub { $ctrl->seek_bkwd_at_level($e); } );
    $mb->{f0} = $mb->Button(-text=>"  >", -command=>
	sub { $ctrl->seek_fwd_at_level($e); } );
    $mb->{f1} = $mb->Button(-text=>" ->", -command=>
	sub { $ctrl->seek_fwd_at_level($e+1); } );
    $mb->{f2} = $mb->Button(-text=>"->>", -command=>
	sub { $ctrl->seek_fwd_at_level($e+2); } );
    $mb->{f3} = $mb->Button(-text=>"->|", -command=>
	sub { $ctrl->seek_fwd_at_level($e+9); } );
    $mb->{file}->pack(@{$mb}{qw(b3 b2 b1 b0 f0 f1 f2 f3)}, -side=>"left");
    return $ctrl;
}

# code to post-process data generated by ciafbxf
# use Data::Dumper;
#
# my ($data) = do $ARGV[0];
# $data = [map { $_->[4] =~ s/ sq km//;
#     {name=>$_->[1], area=>$_->[4], population=>$_->[7]}
# } @$data];
# 
# print Dumper($data);

#sub gen_clock_string {
#    my ($rd, $now) = @_;
#    my (@m) = $rd->{"#canvas"}[0]->relative_mark($now);
#    return join ".",  reverse @m[1..3];
#}

sub dump_image {
    my ($can, $fn) = @_;
    my ($main, $c, $wd, $ht);
    $main = $can->{main};
    (undef, undef, $wd, $ht) = $main->bbox_ever();
    $main->postscript(-file=>$fn, -width=>$wd, -height=>$ht);
    foreach $c (keys %$can) {
	next if $c eq "main";
	my ($s) = $fn;
	$s =~ s/\.ps$/_$c.ps/;
	(undef, undef, $wd, $ht) = $can->{$c}->bbox_ever();
	$can->{$c}->postscript(-file=>$s, -width=>$wd, -height=>$ht);
    }
}

sub on_export {
    my ($can) = @_;
    my ($main, $fn);
    $main = $can->{main};
    $fn = $main->getSaveFile(-initialfile=>"algotutor.ps",
	-title=>"export as a postscript file");
    return unless $fn;
    $main->messageBox(-title=>"file extension must be .ps",
	-message=>"file extension must be .ps", -type=>"OK")
	unless $fn =~ /\.ps$/;
    dump_image($can, $fn);
}