view release on metacpan or  search on metacpan

Multi/Canvas.pm  view on Meta::CPAN

# Copyright (c) 1997-1998 Dominique Dumont. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

package Tk::Multi::Canvas ;

use strict;

use vars qw($printCmd $defaultPrintCmd $VERSION);

use base qw(Tk::Derived Tk::Frame Tk::Multi::Any);

$VERSION = sprintf "%d.%03d", q$Revision: 2.5 $ =~ /(\d+)\.(\d+)/;

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

$printCmd = $defaultPrintCmd = 'lp -opostscript' ;

Tk::Widget->Construct('MultiCanvas');

# Preloaded methods go here.

# Autoload methods go after =cut, and are processed by the autosplit program.

sub Populate
  {
    my ($cw,$args) = @_ ;
    Tk::Multi::Any::normalize($cw,$args) ;

    require Tk::Label;
    require Tk::Canvas;

    $cw->{_printCmdRef} = \$printCmd ;

    my $title = $cw->{'title'} = delete $args->{'-title'} || 'anonymous';

    my $menu = delete $args->{'-menu_button'};
    die "Multi window $title: missing -menu_button argument\n" 
      unless defined $menu ;

    my $titleLabel = $cw->Label(-text => $title.' display')-> pack(qw/-fill x/) ;

    $menu->command(-label=>'print...', -command => [$cw, 'print' ]) ;
    $menu->command(-label=>'clear', -command => [$cw, 'clear' ]);

    # print stuff
    $cw->{_printToFile} = 0;
    $cw->{_printFile} = '';

    my $slaveWindow = $cw -> Scrolled (qw/Canvas -relief sunken -bd 2/)
      -> pack(qw/-fill both -expand 1/) ;

    my $subref = sub {$menu->Popup(-popover => 'cursor', -popanchor => 'nw')};
    #$slaveWindow->Subwidget('scrolled') -> bind ('<Button-3>', $subref);
    $titleLabel -> bind('<Button-3>', $subref);

    $cw->ConfigSpecs(
                     '-relief' => [$cw, undef, undef, 'raised'],
                     '-borderwidth' => [$cw, undef, undef, 2 ],
                     '-scrollbars'=> [$slaveWindow, undef, undef,'osoe'],
                     '-width' => [$slaveWindow, undef, undef, 400],
                     '-height' => [$slaveWindow, undef, undef, 200],
                     'DEFAULT' => [$slaveWindow]
                    ) ;
    $cw->Delegates('command' => $menu, 
                   'clear' => $cw,
                   DEFAULT => $slaveWindow) ;

    $cw->SUPER::Populate($args);