view release on metacpan or  search on metacpan

Tk/JukeboxDrive.pm  view on Meta::CPAN

$Tk::JukeboxDrive::VERSION = '2.0';

package Tk::JukeboxDrive;

# Jukebox tape drive widget derived from Tk::JukeboxSlot.

use base qw/Tk::Derived Tk::JukeboxSlot/;
use strict;

Construct Tk::Widget 'JukeboxDrive';

our $eject;			# image of an eject control

sub ClassInit {

    my($class, $mw) = @_;
    $class->SUPER::ClassInit($mw);

    my $xbm = <<'EJECT';
#define eject_width 32
#define eject_height 32
static unsigned char eject_bits[ = {
  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00,
  0x00, 0xc0, 0x01, 0x00, 0x00, 0xe0, 0x03, 0x00, 0x00, 0xf0, 0x07, 0x00,
  0x00, 0xf8, 0x0f, 0x00, 0x00, 0xfc, 0x1f, 0x00, 0x00, 0xfe, 0x3f, 0x00,
  0x00, 0xff, 0x7f, 0x00, 0x80, 0xff, 0xff, 0x00, 0xc0, 0xff, 0xff, 0x01,
  0xe0, 0xff, 0xff, 0x03, 0xf0, 0xff, 0xff, 0x07, 0xf8, 0xff, 0xff, 0x0f,
  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xff, 0xff, 0x0f,
  0xf8, 0xff, 0xff, 0x0f, 0xf8, 0xff, 0xff, 0x0f, 0x00, 0x00, 0x00, 0x00,
  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, };
EJECT
    
    $eject = $mw->Bitmap(-data => $xbm)

} # end ClassInit


sub Populate {

    my($self, $args) = @_;

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

    $self->{mail}->packForget;
    my $b = $self->Component('Button' => 'button', -image => $eject);
    $b->pack(qw/-side bottom -fill both -expand 1/);

    $self->ConfigSpecs(
        -drivenumber => '-slotnumber',
        -width       => [ 'CHILDREN', qw/width    Width           4/ ],
    );

} # end Populate

1;