1# Copyright (c) 1995-2003 Nick Ing-Simmons. All rights reserved.
2# This program is free software; you can redistribute it and/or
3# modify it under the same terms as Perl itself.
4package Tk::Image;
5
6# This module does for images what Tk::Widget does for widgets:
7# provides a base class for them to inherit from.
8require DynaLoader;
9
10use base qw(DynaLoader Tk); # but are they ?
11
12use vars qw($VERSION);
13$VERSION = '4.011'; # $Id: //depot/Tkutf8/Tk/Image.pm#11 $
14
15sub new
16{
17 my $package = shift;
18 my $widget  = shift;
19 $package->InitClass($widget);
20 my $leaf = $package->Tk_image;
21 my $obj = $widget->Tk::image('create',$leaf,@_);
22 $obj = $widget->_object($obj) unless (ref $obj);
23 return bless $obj,$package;
24}
25
26sub Install
27{
28 # Dynamically loaded image types can install standard images here
29 my ($class,$mw) = @_;
30}
31
32sub ClassInit
33{
34 # Carry out class bindings (or whatever)
35 my ($package,$mw) = @_;
36 return $package;
37}
38
39require Tk::Submethods;
40
41Direct Tk::Submethods ('image' => [qw(delete width height inuse type)]);
42
43sub Tk::Widget::imageNames
44{
45 my $w = shift;
46 $w->image('names',@_);
47}
48
49sub Tk::Widget::imageTypes
50{
51 my $w = shift;
52 map("\u$_",$w->image('types',@_));
53}
54
55sub Construct
56{
57 my ($base,$name) = @_;
58 my $class = (caller(0))[0];
59
60 # Hack for broken ->isa in perl5.6.0
61 delete ${"$class\::"}{'::ISA::CACHE::'} if $] == 5.006;
62
63 *{"Tk::Widget::$name"}  = sub { $class->new(@_) };
64}
65
66# This is here to prevent AUTOLOAD trying to find it.
67sub DESTROY
68{
69 my $i = shift;
70 # maybe do image delete ???
71}
72
73
741;
75