summaryrefslogtreecommitdiffstats
path: root/ksirc/puke/pbase.pm
diff options
context:
space:
mode:
Diffstat (limited to 'ksirc/puke/pbase.pm')
-rw-r--r--ksirc/puke/pbase.pm265
1 files changed, 265 insertions, 0 deletions
diff --git a/ksirc/puke/pbase.pm b/ksirc/puke/pbase.pm
new file mode 100644
index 00000000..b8345cdb
--- /dev/null
+++ b/ksirc/puke/pbase.pm
@@ -0,0 +1,265 @@
+
+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;