An Object-Oriented UI for Perl
by Robert Kiesling


Listing One
Tk::Widget
Tk::TextUndo
Tk::Workspace

Listing Two
@ISA = qw(Tk::TextUndo);
Construct Tk::Widget `Workspace';
sub new {
    my $proto = shift;
    my $class = ref( $proto ) || $proto;
    my $self = {
        window => new MainWindow,
        textspace => undef,
        name => ((@_)?@_:'Workspace'),
        textfont => $defaulttextfont,
        # default is approximate width and height of 80x24 char. text widget
        width => $w,
        height => $h,
        filemenu => undef,
        editmenu => undef,
        helpmenu => undef,
        menubar => undef,
        text => []                   # The text itself.
        };
    bless($self, $class);
    $self -> {window} -> {parent} = $self;
 ... etc. ...
}

Listing Three
Tk
     Derived
           Debug
           DirList
           FloatEntry (Also derives from Entry)
           MenuBar (Also derives from Menu)
           OptionMenu (Also derives from Menubutton)
     DragDrop
     DropSite
     Widget
          Button
               RadioButton
          Canvas
                  Checkbutton
          CmdLine (resource)
          ColorSelect
          Entry
          Frame
                Adjuster
                        BrowseEntry
                LabFrame
                LabRadioButton
                Tiler
                  Font
          HList
          Label
          ListBox
          MenuButton
          Message
          NBFrame
               Notebook
          Scale
          Scrollbar
          TList
          Table
          Text
               TextUndo
                    *Workspace*
          TixGrid
          Toplevel
               Balloon
               Dialog
                    msgBox
               DialogBox (also inherits from Frame)
                       ErrorDialog
               FBox (File selection dialog)
               FileSelect
               IconList
     MainWindow
     Text
          ROText
     Image
          Bitmap
          Photo
                Animation
          Pixmap
     Wm (Window manager)
          Menu

Listing Four
 ($self -> window) -> SUPER::bind($self -> window, `<Configure>',
                                     [\&ws_save_size, Ev(`W'),
                                      Ev(`h'), Ev(`w'),
                                      Ev(`x'), Ev(`y')]);

Listing Five
sub ws_save_size {
     my $self = shift;
     my $widget = shift;
    my $height = shift;
    my $width = shift;
    # We need to do this because TextUndo subclasses MainWindow,
    # and both of them send Configure messages.
    if ( $self =~ /Tk::TextUndo/ ) {return;}
     # We have to ref the parent widget directly because
     # MainWindows don't define a parent widget value.
    $self -> {parent} -> ws_width($width);
    $self -> {parent} -> ws_height($height);
}

Listing Six
#!/usr/bin/perl
my $text='';
my $h='351';
my $w='565';
my $name='';
use Tk::Workspace;
@ISA = qw(Tk::Workspace);
use strict;
use Tk;
use FileHandle;
use Env qw(HOME);
my $workspace = Tk::Workspace -> new;
$workspace -> name($name);
$workspace -> menubar -> pack (-anchor => 'w', -fill => 'x');
$workspace -> textspace -> insert ( 'end', $text );
$workspace -> textspace -> pack;
bless($workspace,ref('Tk::Workspace'));
$workspace -> bind;
$workspace -> window -> geometry( $w . 'x' . $h );
MainLoop;


Listing Seven
sub ws_export {
    my $self = shift;
    my $filedialog;
    my $filename;
    my $filename;
    my $fh = new IO::File;
    $filedialog = ($self -> {window})
                -> FileSelect ( -directory => `.' );
    $filename = $filedialog -> Show;
    $fh -> open( "+> $filename" ) or &filenotfound( $self );
    print $fh ($self -> {textspace}) -> get( `1.0', `end' );
    close $fh;
}

Listing Eight
sub ws_paste {
    my $self = shift;
    my $selection;
    my $point;
     $selection = ($self -> {textspace}) -> clipboardGet;
    $point = ($self -> {textspace}) -> index("insert");
    ($self -> {textspace}) -> insert( $point, $selection);
    return $selection;
}



1