Puppet::Show - Optional Tk Gui for Puppet::Body

 use Puppet::Show ;

 package myClass ;

 sub new
  {
    my $type = shift ;
    my $self = {};

    # no inheritance, your class contains the Puppet::Show class
    $self->{body} = new Puppet::Show(cloth => $self, @_) ;

    bless $self,$type ;
  }

 package main;

 my $mw = MainWindow-> new ;

 # these 2 parameters are passed to Puppet::Show constructor
 my $test = new MyTest( name => 'foo', 'topTk' => $mw) ;

 $test->display;

 MainLoop ; # Tk's

############################################################
#
# $Header: /mnt/barrayar/d06/home/domi/Tools/perlDev/Puppet_Show/RCS/Show.pm,v 1.7 1999/08/10 13:27:21 domi Exp $
#
# $Source: /mnt/barrayar/d06/home/domi/Tools/perlDev/Puppet_Show/RCS/Show.pm,v $
# $Revision: 1.7 $
# $Locker:  $
# 
############################################################

package Puppet::Show ;

use Carp ;
use Tk::Multi::Manager ;
use Tk::Multi::Text ;
use Tk::Multi::Toplevel ;
use base Puppet::Body;
use Puppet::Log ;
use AutoLoader 'AUTOLOAD' ;

use strict ;
use vars qw($VERSION) ;
$VERSION = sprintf "%d.%03d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/; 

sub new 
  {
    my $type = shift ;
    my %args = @_ ;

    my $topTk = delete $args{topTk} ; # could be a global variable
    my $self= Puppet::Body::new($type,@_);

    $self->{topTk} = $topTk;
    $self->{podName} = $args{podName} || 'Puppet::Show';
    $self->{podSection} = $args{podSection} || 'DESCRIPTION';
    $self->{title} = $args{title} || $self->{name} ;

    die "No parameter topTk passed to Puppet::Show $self->{name}\n"
      unless defined $topTk ;
    return $self;
  }

sub _createLogs
  {
    my $self = shift ;
    my $how = shift ;

    # config debug window
    foreach (qw/debug event/)
      {
        my $what = $_ ;
        $self->{'log'}{$_} = new Puppet::Log
          (
           title => $_,
           how => $how
          );
      }
  }

1;

__END__

#'

sub acquire
  {
    my $self = shift ;
    my %args = @_;

    my $raise = $args{raise} ;
    my $ref = $args{body};
    my $myRaise = $args{myRaise};

    croak("The object passed with body parameter is not a Puppet::Show object\n")
      unless $ref->isa( __PACKAGE__ ) ;
   
    $self->SUPER::acquire(raise => $raise, body => $ref);

    return unless defined $self->{multitop};
    $ref->whenAcquired(raise => $myRaise, body => $self);
   
    $self->updateMenu(raise => $raise,
                      body => $ref, 
                      menu => 'content');
  }

#internal
sub whenAcquired
  {
    my $self = shift;
    return unless defined $self->{multitop};
    $self->updateMenu(@_,menu => 'container');
  }

#internal
sub updateMenu
  {
    my $self = shift;
    my %args = @_;

    my $raise = $args{raise} ;
    my $ref = $args{body};
    my $menu = $args{menu};

    # method or sub ref to invoke when raising the object
    my $sub = ref($raise) eq 'CODE' ? $raise :
      defined $raise ? sub{$ref->cloth->$raise(); } :
        sub{$ref->cloth->display(); } ;
    
    my $name = $ref->getName();

    $self->{multitop}->menuCommand
      (
       name => $name,
       menu =>$menu,
       command => $sub
      );

  }


sub drop
  {
    my $self = shift ;

    $self->SUPER::drop(@_);

    foreach my $name (@_)
      {
        #print "self-{multitop} defined \n" if defined $self->{multitop};
        #print "self-{multitop} NOT defined \n" unless defined $self->{multitop};
        $self->{multitop}->menuRemove(name => $name,menu => 'content')
          if defined $self->{multitop};
      }
  }

sub droppedBy
  {
    my $self = shift ;

    $self->closeDisplay unless $self->SUPER::droppedBy(@_);
  }

# defines a top level display for each object, contains a MultiText ,amager
# and a objScanner.

# can be called with no parameter -> show itself
sub display
  {
    my $self =shift ;
    my %args = @_;

    my $master = $args{master}; # master destroyed -> exit ;
    my $onDestroy = $args{onDestroy} ; # sub ref to perform cleanup;

    if (defined $self->{multitop})
      {
        $self->{multitop}->deiconify() 
          if ($self->{multitop}->state() eq 'iconic') ;
	$self->{multitop}->raise();
	return undef ;
      }
    
    my $type = ref($self) ;
    $type =~ s/^.*::// ;
    my $labelName = ref($self->cloth).': ';
    if (defined $self->{title}) {$labelName .= $self->{title};} 
    else {$labelName .= $self->{'name'} ;} 
    
    $self->printDebug("Creating Multitop display for ".ref($self)."\n") ;

    my $poof ;
    my $top = $self->{multitop} = $self->{topTk} -> MultiTop
      (
       podName => $self->{podName},
       podSection => $self->{podSection},
       manager => $self->cloth
      );

    my $dsub ;
    if (defined $master and $master) 
      {
        $dsub = sub
          {
            &$onDestroy if defined $onDestroy ;
            $self->{topTk}->destroy;
          } ;
      }
    else 
      {
        $dsub = sub
          {
            &$onDestroy if defined $onDestroy ;
            delete $self->{multitop};
          };
      }

    $self->{multitop} -> OnDestroy($dsub); 

    $self->{multitop} -> title($labelName) ;

    # config debug window
    foreach (qw(debug event))
      {
        $self->{'log'}{$_} -> display ($self->{multitop},1);
      }
   
    foreach my $what (qw/container content/)
      {
        next unless defined $self->{$what} ;

        foreach my $name (sort keys %{$self->{$what}})
          {
            my $ref = $self->{$what}{$name};
            my $sub = ref($self->{raise}) eq 'CODE' ? $self->{raise} :
              sub{$ref->cloth->display(); } ;
            $self->{multitop}->menuCommand
              ( 
               name => $name,
               menu => $what,
               command => $sub
              ) ;
          }
      }

    return $self->{multitop} ;
  }

sub myDisplay
  {
    return shift->{multitop} ;
  }

sub closeDisplay
  {
    my $self = shift ;

    # must delete all values stored during display creation
    unless (defined $self->{multitop})
      {
        $self->printDebug
          ("$self->{name} closeDisplay called while not displaying\n") ;
        return ;
      }

    # this element will be deleted by the OnDestroy hook set in display()
    $self->{multitop}->destroy;
  }


sub showEvent
  {
    my $self= shift ;
    $self->{'log'}{'event'} -> show ();
  }

sub printEvent
  {
    my $self = shift ;
    my $text=shift ;
    $self->{'log'}{'event'}->log($text) ;
    # so that tk debug output are readable 
    $self->{'log'}{debug}  ->log($text, how => undef);
  }

1;