home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / Tk / Image.pm < prev    next >
Encoding:
Perl POD Document  |  1997-08-10  |  1.3 KB  |  67 lines
  1. # Copyright (c) 1995-1997 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.
  4. package 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.
  8. require DynaLoader;
  9.  
  10. @Tk::Image::ISA = qw(DynaLoader Tk); # but are they ?
  11.  
  12. sub new
  13. {
  14.  my $package = shift;
  15.  my $widget  = shift;
  16.  $package->InitClass($widget);
  17.  my $leaf = $package->Tk_image;
  18.  my $obj = $widget->image('create',$leaf,@_);
  19.  return bless $obj,$package;
  20. }
  21.  
  22. sub Install
  23. {
  24.  # Dynamically loaded image types can install standard images here
  25.  my ($class,$mw) = @_;
  26. }
  27.  
  28. sub ClassInit
  29. {
  30.  # Carry out class bindings (or whatever)
  31.  my ($package,$mw) = @_;
  32.  return $package;
  33. }
  34.  
  35. require Tk::Submethods;
  36.  
  37. Direct Tk::Submethods ('image' => [qw(delete width height type)]);
  38.  
  39. sub Tk::Widget::imageNames
  40. {
  41.  my $w = shift;
  42.  $w->image('names',@_);
  43. }
  44.  
  45. sub Tk::Widget::imageTypes
  46. {
  47.  my $w = shift;
  48.  map("\u$_",$w->image('types',@_));
  49. }
  50.  
  51. sub Construct
  52. {
  53.  my ($base,$name) = @_;
  54.  my $class = (caller(0))[0];
  55.  *{"Tk::Widget::$name"}  = sub { $class->new(@_) };
  56. }
  57.  
  58. # This is here to prevent AUTOLOAD trying to find it.
  59. sub DESTROY
  60. {
  61.  my $i = shift;
  62.  # maybe do image delete ???
  63. }
  64.  
  65.  
  66. 1; 
  67.