tdenetwork/ksirc/puke/pbase.pm

package PBase;
use Carp;
#use Data::Dumper;
use strict;

$PBase::NO_WIDGET = -1;

$::AlignLeft  = 0x0001;
$::AlignRight = 0x0002;
$::AlignHCenter = 0x0004;
$::AlignTop = 0x0008;
$::AlignBottom = 0x0010;
$::AlignVCenter = 0x0020;
$::AlignCenter = $::AlignVCenter | $::AlignHCenter;

sub sendMessage {
  my $self = shift;
  
  my %ARG = @_;
  $ARG{"iWinId"} = $self->{iWinId} if($ARG{"iWinId"} == undef);
  
  return &::PukeSendMessage($ARG{"iCommand"}, 
	                    $ARG{"iWinId"}, 
		            $ARG{"iArg"},
                            $ARG{"cArg"},
                            $ARG{"CallBack"},
                            $ARG{"WaitFor"}
                           );
}

sub rndchr {
  my $string = "";
  my $i;
  for($i = 0; $i < 8; $i++){
    $string .= chr(int(rand(93)) + 0x21);  # 0x21 since we don't want spaces and 0x20 is space.
  }
  return $string;
}

sub new {
  my $class = shift;
  my $parent = $_[$#_];

  my $self  = {};


#  print "Parent: $parent\n";

  bless($self, $class);

  $parent = 0 if($parent == undef);

  $self->{iWinId} = -1;
  $self->{Parent} = $parent if $parent != 0;
  $self->{initId} = $self->rndchr();
  $self->{widgetType} = $PBase::NO_WIDGET;
  $self->{cmdQueue} = ();

  if($::PUKE_FETCH_WIDGET == 1) {
    $self->{Fetch} = 1;
  }

  #  $self->installHandler($::PUKE_WIDGET_DELETE_ACK, sub{$self->DESTROY});
  
  return $self;

}

sub create {
  my $self = shift;
  
  if($self->{widgetType} == undef ||
     $self->{widgetType} == $PBase::NO_WIDGET) {
    print("*E* PBase: Widget type was undefined, $self is really broken\n");
    print("*E* PBase: Giving up\n");
    return;
  }

  my $parent = $self->{Parent} ?  $self->{Parent}->{iWinId} : 0;
  
  #  print "*I* Createing widget of type: " . $self->{widgetType} . " with parent " . $parent . "\n";

  $self->{runable} = 1;

  my $carg = $parent . "\t" . $self->{widgetType} . "\t" .  $self->{initId};
  
  my %REPLY = $self->sendMessage('iCommand' => $::PUKE_WIDGET_CREATE,
                                 'iWinId' => $::PUKE_CONTROLLER,
                                 'cArg' => $carg,
                                 'CallBack' => sub { },
                                 'WaitFor' => 1);

    if($REPLY{iWinId} <= 0){
    print "*E* Widget Create Failed!\n";
    }

    $self->ackWinId(%REPLY);
    
    $self->clearQueue();
    #  $self->setRunable(0);
}

sub fetchWidget {
  my $self = shift;

  $self->{objName} = shift;
  my $regex = shift;

#  $self->sendMessage('iCommand' => $::PUKE_WIDGET_DELETE,
#                     'CallBack' => sub { print "Deleted\n"; });

  $regex = "0" if($regex eq '');
  my $carg = $regex . "\t" . $self->{widgetType} . "\t" .  $self->{initId} . "\t" . $self->{objName};
  
  my %REPLY = $self->sendMessage('iCommand' => $::PUKE_FETCHWIDGET,
                                 'iWinId' => $::PUKE_CONTROLLER,
                                 'cArg' =>  $carg,
                                 'CallBack' => sub { },
                                 'WaitFor' => 1);

  if($REPLY{iWinId} <= 0){
    print "*E* Widget Fetch Failed!\n";
    return -1;
  }
  my $winid;
  my $cmd;
  foreach $cmd (values %::PUKE_W_HANDLER){
    next unless ref $cmd eq 'CODE';
    foreach $winid (values %{$::PUKE_W_HANDLER{$cmd}}){
      if($winid == $self->{'iWinId'}){
        $::PUKE_W_HANDLER{$cmd}{$REPLY{iWinId}} = $::PUKE_W_HANDLER{$cmd}{$self->{iWinId}};
        delete $::PUKE_W_HANDLER{$cmd}{$self->{iWinId}};
      }
    }
  }
  
  $self->ackWinId(%REPLY);
  $self->{'Fetch'} = 1;
  #  $self->setRunable(0);
  return 0;
}

sub releaseWidget {
    my $self = shift;
    $self->sendMessage('iCommand' => $::PUKE_RELEASEWIDGET,
                       'CallBack' => sub {});
}

sub treeInfo {
  my $self = shift;
  
  my %REPLY = $self->sendMessage('iCommand' => $::PUKE_DUMPTREE,
                                 'iWinId' => $::PUKE_CONTROLLER,
                                 'CallBack' => sub { },
                                 'WaitFor' => 0);

}


sub DESTROY {
  my $self = shift;

  #  print "*I* Widget Deleted\n";
  eval{  $self->hide(); }; # Hide doesn't exist for all PBase's

  #  $self->setRunable(1);

  delete($::PBASE_IMORTALS{$self->{IMMORTAL}});

  if($self->{'Fetch'} != 1 && $self->{DESTROYED} != 1 && $self->{Parent} == 0){
    $self->sendMessage('iCommand' => $::PUKE_WIDGET_DELETE,
		       'CallBack' => sub {});
  }

  if($self->{'Fetch'} == 1){
    $self->sendMessage('iCommand' => $::PUKE_RELEASEWIDGET,
		       'CallBack' => sub {});

  }
  
  #  $self->setRunable(0);
  $self->{iWinId} = -1;
  $self->{DESTROYED} = 1;

}

sub close {
  my $self = shift;
  
  $self->hide();

  $self->DESTROY;
  
}

sub ackWinId {
  my $self = shift;
  my %ARG = @_;

  if($ARG{'iWinId'} <= 1){
      die("Failed on ack'ing Window ID, stopping!");
  }
  
  $self->{iWinId} = $ARG{'iWinId'};
}


sub installHandler {
  my $self = shift;

  my $command = shift;
  my $handler = shift;

  my $cmd =
    sub {
      $::PUKE_W_HANDLER{$command}{$self->{iWinId}} = $handler;
    };

  if($self->{iWinId} == -1){
    $self->addQueue($cmd);
  }
  else{
    &$cmd();
  }

}

sub onNext {
  my $self = shift;

  my $cb = shift;
  
  $self->sendMessage('iCommand' => $::PUKE_ECHO,
		     'iArg' => 0,
		     'iWinId' => $self->{iWinId},
		     'cArg' => "",
		     'CallBack' => $cb);  
}

sub immortal {
  my $self = shift;
  $self->{IMMORTAL} = &rndchr;
  $::PBASE_IMORTALS{$self->{IMMORTAL}} = $self;
  return $self;
}

sub addQueue {
  my $self = shift;

  push(@{$self->{cmdQueue}}, shift());
}

sub clearQueue {
  my $self = shift;
  
  my $cmd;
  while($cmd = pop(@{$self->{cmdQueue}})){
    &$cmd;
  }
}

package main;

1;