gtkdbi.oldtry

   1 #!/usr/bin/perl
   2
   3 use vars qw( $VERSION );
   4 use Gtk;
   5 use Gtk::Gdk::ImlibImage;
   6
   7 $VERSION = "0.1";
   8
   9 init Gtk;
  10 init Gtk::Gdk::ImlibImage;
  11
  12 Gtk->idle_add(\&new_window);
  13 Gtk->idle_add(\&splash);
  14
  15 main Gtk;
  16 #exit;
  17
  18 sub splash {
  19   my $kitty = load_image Gtk::Gdk::ImlibImage("420kitty.gif");
  20     my $w = $kitty->rgb_width;
  21   my $h = $kitty->rgb_height;
  22
  23   my $win = new Gtk::Window -dialog;
  24
  25   $win->set_title("welcome to _dbi!");
  26
  27   $kitty->render($w, $h);
  28   my $p = $kitty->move_image();
  29   my $m = $kitty->move_mask;
  30   my $gtkitty = new Gtk::Pixmap ($p, $m);
  31
  32   my $label = new Gtk::Label <<END;
  33  welcome to gtkdbi
  34  version $VERSION
  35  keywords: gtk sql perl dbi
  36  http://420.am/gtkdbi
  37 END
  38
  39   my $box = new Gtk::HBox 0,0;
  40   $box->pack_start( $gtkitty, 0, 0, 0 );
  41   $box->pack_start( $label, 0, 0, 0);
  42
  43   $win->add( $box );
  44
  45   $win->show_all;
  46
  47   Gtk->timeout_add( 6000, sub { $win->destroy; 0; } );
  48   #Gtk->timeout_add( 6, sub { $win->destroy; 0; } );
  49
  50   0;
  51
  52 }
  53
  54 sub new_window {
  55   my $window = _Window->new;
  56   0;
  57 }
  58
  59 #--
  60
  61 package _Window;
  62
  63 sub new {
  64   my $proto = shift;
  65   my $class = ref($proto) || $proto;
  66   my $self = {
  67     'window' => new Gtk::Window -toplevel,
  68   };
  69   $self->{window}->set_usize(640,480);
  70   $self->{window}->set_title("gtkdbi: not connected");
  71   $self->{window}->set_name("gtkdbi");
  72   $self->{window}->show_all;
  73   bless($self, $class);
  74 }
  75
  76