All,
On the plane last week I was struggling with something that I have been
mulling over for a while - I want the samples/demos that we distribute
to be more accessible.
Tk has as whole demo framework that can run demos from a app that is
installed as a script in the perl bin directory - and hence is more
often than not on the users path (try typing 'widget' at your command
prompt)
I've knocked up a demo application that I think would be suitable
(attached) - basically it finds the demos directory (based on the path
of GUI.pm), reads in the demo files, displaying them in a tree-view,
with a right hand panel that displays the source of the selected file,
and a button to run the sample.
If you've got a build directory for the latest code, drop the attached
file into the root directory and run:
perl -Mblib win32-gui-demos.pl
to see what it does with the most recent current sample set (including
the fixes I just committed). If you don't have a most recent CVS build,
then just run it, and see if you have any of the samples installed - but
note that some of them are broken.
Is this a good thing to pursue? Suggestions for changes or alternative
approaches welcome. A better name for the script would be good too!
Regards,
Rob.
--
Robert May
Win32::GUI, a perl extension for native Win32 applications
http://perl-win32-gui.sourceforge.net/
#!perl -w
use strict;
use warnings;
# Display and run the Win32::GUI demonstrations
# $Id$
# (c) Robert May, 2006. This software is released
# under the same terms as perl itself.
our $VERSION = '0.01';
my $progname = "Win32::GUI Demo Launcher";
my $copyright = "(c) Robert May, 2006.";
use Config();
use File::Find();
use File::Basename();
# XXX
#use Win32::GUI qw(WS_CLIPCHILDREN CW_USEDEFAULT SF_TEXT ANSI_FIXED_FONT
SW_SHOWNORMAL TVHT_ONITEM WM_MENUSELECT WM_NOTIFY NM_RETURN), 1.03_03;
use Win32::GUI qw(WS_CLIPCHILDREN);
sub CW_USEDEFAULT() {0x80000000}
sub SF_TEXT() {1}
sub ANSI_FIXED_FONT() {11}
sub SW_SHOWNORMAL() {1}
sub TVHT_ONITEM() {0x46}
sub WM_MENUSELECT() {0x011F}
sub NM_RETURN() {-4}
sub WM_NOTIFY() {0x004E}
## Globals:
my $options = MyConfig::load_config(); # Hash of option values
my %nodes; # mapping of treeview node_id to demo path/file.pl
######################################################################
# Build the UI
######################################################################
######################################################################
# Main menu
######################################################################
my $menu = Win32::GUI::Menu->new(
"&File" => "File",
">&Options" => { -name => "Options", -onClick => \&getOptions },
">&Source" => { -name => "Source", -onClick => \&showMySource },
">-" => 0,
">E&xit" => { -name => "Exit", -onClick => sub {-1}, },
"&Help" => "HelpB",
">&Help" => { -name => "Help", -onClick => \&showHelp, },
">&About" => { -name => "About", -onClick => \&showAboutBox, },
);
my @menu_help = (
undef, # File Button
undef, # Help Button
"Change program options.",
"View the source for this program.",
undef, # Seperator
"Exit.",
undef, # ??
"View help for using this program.",
$copyright,
);
######################################################################
# A class that removes the Win32::GUI default CS_HDRAW and CS_VDRAW
# styles - helps with reducing flicker when we are not scaling the
# content of the windows
######################################################################
my $class = Win32::GUI::Class->new(
-name => "Win32_GUI_MyClass",
-style => 0,
);
######################################################################
# Main window
######################################################################
my $mw = Win32::GUI::Window->new(
-title => $progname,
-left => CW_USEDEFAULT,
-size => [750,500],
-menu => $menu,
-class => $class,
-pushstyle => WS_CLIPCHILDREN, # avoid flicker on resize
-onResize => \&mwResize,
);
## Hook for displaying menu help in the status bar
$mw->Hook(WM_MENUSELECT, \&showMenuHelp);
######################################################################
# Status bar
######################################################################
$mw->AddStatusBar(
-name => 'SB',
);
######################################################################
# Treeview
######################################################################
$mw->AddTreeView(
-name => 'TV',
-pos => [0,0],
-width => 200,
-height => $mw->ScaleHeight() - $mw->SB->Height(),
-rootlines => 1,
-lines => 1,
-buttons => 1,
#-onNodeClick => \&loadFile,
-onMouseDown => \&tvClick,
-onMouseDblClick => \&tvDoubleClick,
);
## Hook for getting notification when <RETURN> key is pressed
$mw->TV->Hook(NM_RETURN, \&tvReturnHook);
######################################################################
# Splitter
######################################################################
$mw->AddSplitter(
-name => 'SP',
-top => 0,
-left => $mw->TV->Width(),
-height => $mw->ScaleHeight() - $mw->SB->Height(),
-width => 3,
-onRelease => \&splitterRelease,
);
######################################################################
# Launch Button
######################################################################
$mw->AddButton(
-name => 'BUT',
-text => "Run demo ...",
-disabled => 1,
-top => 10,
-onClick => \&runCurrent,
);
$mw->BUT->Left($mw->ScaleWidth()-10-$mw->BUT->Width());
######################################################################
# Code display area (RichEdit)
######################################################################
# TODO long term aim to use Win32::GUI::Scintilla instead of this
# RichEdit so we can have syntax highlighting
$mw->AddRichEdit(
-name => 'RE',
-left => $mw->SP->Left() + $mw->SP->Width(),
-top => $mw->BUT->Top() + $mw->BUT->Height() + 10,
-width => $mw->ScaleWidth() - $mw->TV->Width() - $mw->SP->Width(),
-height => $mw->ScaleHeight() -$mw->SB->Height()- $mw->BUT->Height() - 20,
-vscroll => 1,
-hscroll => 1,
-readonly => 1,
-font => Win32::GUI::GetStockObject(ANSI_FIXED_FONT),
);
######################################################################
# Display help as introduction, load tree view and run application
######################################################################
load_treeview($mw->TV);
showHelp($mw);
$mw->Show();
Win32::GUI::Dialog();
$mw->Hide();
exit(0);
######################################################################
# Callbacks
######################################################################
######################################################################
# Resize main window
######################################################################
sub mwResize {
my $win = shift;
my $h = $win->ScaleHeight();
my $w = $win->ScaleWidth();
# Move the Status bar
$win->SB->Top($h - $win->SB->Height());
$win->SB->Width($w);
# Adjust Height of treeview and splitter
$win->TV->Height($h - $win->SB->Height());
$win->SP->Height($h - $win->SB->Height());
# Re-position button
my $butleft = $win->ScaleWidth() - 10 - $win->BUT->Width();
my $butleft_min = $win->TV->Width() + $win->SP->Width();
$butleft = $butleft_min if $butleft < $butleft_min;
$win->BUT->Left($butleft);
# Fill remaining space with code display area
$win->RE->Width($w - $win->TV->Width() - $win->SP->Width());
$win->RE->Height($win->TV->Height() - $win->BUT->Height() - 20);
# Stop the splitter moving over our button
$win->SP->Change(-max => $win->BUT->Left() - 10);
return 1;
}
######################################################################
# Reposition splitter
# Horizontal splitter, so only need to resize the 2 panes
######################################################################
sub splitterRelease {
my ($s, $coord) = @_;
my $p = $s->GetParent();
$p->TV->Width($coord);
$p->RE->Left($coord + $s->Width());
$p->RE->Width($p->ScaleWidth() - $coord - $s->Width());
return 1;
}
######################################################################
# Display menu help in the status bar
######################################################################
sub showMenuHelp {
my ($win, $wParam, $lParam, $type, $msgcode) = @_;
return 1 unless $type == 0;
return 1 unless $msgcode == WM_MENUSELECT;
if($lParam == 0) { # leaving menu
$win->SB->Text($options->{current} || '');
}
else {
# This technique is distinctly flakey, and depends
# on understanding how the internals of Win32::GUI
# allocates ids to menu items. This mechanism has
# changed since Win32::GUI 1.03, the code below
# should work with old and new methods
my $item = $wParam & 0xFF;
$item -= 100 if $item > 100;;
$win->SB->Text($menu_help[$item] || '');
}
return 1;
}
######################################################################
# Treeview <RETURN> pressed
######################################################################
sub tvReturnHook {
my ($win, $wParam, $lParam, $type, $msgcode) = @_;
return 1 unless $type == WM_NOTIFY;
return 1 unless $msgcode == NM_RETURN;
my $node = $win->GetSelection();
loadFile($win, $node);
# Force a non-zero return value to stop the beep that results
# from default processing
$win->Result(1);
return 0;
}
######################################################################
# Treview node click - if node has associate file, load it
######################################################################
sub loadFile {
my ($tv, $node) = @_;
return 0 unless exists $nodes{$node};
my $file = $nodes{$node};
if(!defined($options->{current}) or $file ne $options->{current}) {
$options->{current} = $file;
# Can't use $tv->GetParent(), as GetParent is redefined to get
# the parent node ... oops
my $p = Win32::GUI::GetWindowObject(Win32::GUI::GetParent($tv));
$p->RE->Load($file,SF_TEXT);
$p->RE->SetSel(0,0);
$p->RE->ScrollCaret();
$p->SB->Text($options->{current});
$p->BUT->Enable();
}
return 1;
}
######################################################################
# Treview click - if click is on a node, load
# the associated file
######################################################################
sub tvClick {
my ($tv, $x, $y) = @_;
my ($node, $flags) = $tv->HitTest($x,$y);
if($node && ($flags & TVHT_ONITEM)) {
loadFile($tv, $node);
}
return 1;
}
######################################################################
# Treview double click - if double click is on a node, load and run
# the associated file
######################################################################
sub tvDoubleClick {
my ($tv, $x, $y) = @_;
my ($node, $flags) = $tv->HitTest($x,$y);
if($node && ($flags & TVHT_ONITEM)) {
my $loaded = loadFile($tv, $node);
runCurrent($tv) if($loaded);
}
return 1;
}
######################################################################
# Button click (and node double-click) - run current file
######################################################################
sub runCurrent {
my $control = shift;
return 1 unless -f $options->{current};
$control->ShellExecute("open",
$options->{hide_console} ? $options->{wperl} : $options->{perl},
$options->{current}, "", SW_SHOWNORMAL);
return 1;
}
######################################################################
# Help menu item. Show help text in code area
######################################################################
sub showHelp {
my $win = shift;
$win->RE->Text(<<HELPEND);
$progname
This application shows you all the sample code distributed
with Win32::GUI and its related modules. You'll find each
sample listed in the treeview to the left.
Select a sample file to see it's source-code in this
window, and then click on the 'Run demo' button to
run the sample itself.
By default the sample will start, with its own console
window, so that you can see any output it may generate
there. This behaviour can be changed by checking the
'hide console window' option (from the File->Options
menu), but be aware that by doing this you may not be
able to see some output. This option is only available
if a program called 'wperl.exe' can be found in the
same location as the perl used to run this application.
If there are no samples shown, then the options dialog
will show you where this application is looking for them.
It tries to determine this automatically, by looking at
where Win32::GUI is installed. If you have performed
a non-standard install you may need to edit this value.
To see the source of this program itself, choose the
'Source' item from the File menu.
That's all there is to it. I hope you find this useful.
$copyright
This software is released under the same terms as Perl
itself.
HELPEND
$win->RE->SetSel(0,0);
$win->RE->ScrollCaret();
return 1;
}
######################################################################
# About menu item.
######################################################################
sub showAboutBox {
my $win = shift;
my $ab = Win32::GUI::Window->new(
-parent => $win,
-title => "About ...",
-size => [220,180],
-maximizebox => 0,
-minimizebox => 0,
-resizable => 0,
-dialogui => 1,
);
my $text = "$progname v$VERSION\r\n";
$text .= "Using Win32::GUI v$Win32::GUI::VERSION";
my $text2 = "$copyright This software is released under "
. "the same terms as Perl itself.";
$ab->AddLabel(
-align => 'center',
-pos => [10,10],
-width => $ab->Width()-20,
-height => 50,
-text => $text,
);
$ab->AddLabel(
-pos => [10,60],
-width => $ab->Width()-20,
-height => 100,
-text => $text2,
);
$ab->AddButton(
-text => 'Ok',
-size => [60,25],
-left => $ab->ScaleWidth()-70,
-top => $ab->ScaleHeight()-35,
-ok => 1,
-default => 1,
-onClick => sub {-1},
);
$ab->Center($win);
$ab->DoModal();
return 1;
}
######################################################################
# Options Dialog
######################################################################
sub getOptions {
my $win = shift;
my $ok = 0;
my $ab = Win32::GUI::Window->new(
-parent => $win,
-title => "$progname Options",
-size => [400,120],
-maximizebox => 0,
-minimizebox => 0,
-resizable => 0,
-dialogui => 1,
);
$ab->AddTextfield(
-name => 'demo_dir',
-pos => [10,10],
-prompt => ["&Demo directory :",100],
-text => $options->{demo_dir},
-width => $ab->ScaleWidth()-150,
-height => 20,
-tabstop => 1,
);
$ab->AddButton(
-text => '...',
-top => 11,
-height => 18,
-left => $ab->ScaleWidth()-38,
-onClick => sub { $ab->demo_dir->Text(getDemoDir($ab)); 1;},
-tabstop => 1,
);
$ab->AddCheckbox(
-name => 'hide_console',
-pos => [10,40],
-text => 'Hide &Console Window',
-checked => $options->{hide_console},
-disabled => defined $options->{wperl} ? 0 : 1,
-height => 20,
-tabstop => 1,
);
$ab->AddButton(
-text => 'Ok',
-size => [60,25],
-left => $ab->ScaleWidth()-140,
-top => $ab->ScaleHeight()-35,
-ok => 1,
-default => 1,
-onClick => sub { $ok = 1; -1},
-tabstop => 1,
);
$ab->AddButton(
-text => 'Cancel',
-size => [60,25],
-left => $ab->ScaleWidth()-70,
-top => $ab->ScaleHeight()-35,
-cancel => 1,
-onClick => sub {-1},
-tabstop => 1,
);
$ab->Center($win);
$ab->DoModal();
# update options from dialog - but only if ok pressed
if($ok) {
if($options->{demo_dir} ne $ab->demo_dir->Text()) {
$options->{demo_dir} = $ab->demo_dir->Text();
load_treeview($win->TV); #only if directory changed
}
$options->{hide_console} = $ab->hide_console->Checked();
}
return 1;
}
######################################################################
# Show this program's source
######################################################################
sub showMySource {
my $win = shift;
$win->TV->Select(0); # unselect any tree view node
$options->{current} = $0; # Set the current file
$win->RE->Load($options->{current},SF_TEXT); # and load it
$win->RE->SetSel(0,0);
$win->RE->ScrollCaret();
$win->SB->Text($options->{current});
$win->BUT->Disable(); # Don't let us run another instance
return 1;
}
######################################################################
# Get a directory that contains demonstrations
######################################################################
sub getDemoDir {
my $p = shift;
# browse for folder doesn't like unix style paths ...
my $curdir = $options->{demo_dir};
$curdir =~ s/\//\\/g;
my $dir = Win32::GUI::BrowseForFolder(
-owner => $p,
-title => 'Select Win32::GUI demos directory',
-folderonly => 1,
-directory => $curdir,
);
# and back to Unix path seperators again
$dir =~ s/\\/\//g if $dir;
return $dir ? $dir : $options->{demo_dir};
}
######################################################################
# Helper: load treeview with nodes representing the directories
# and files
######################################################################
my %demos;
sub load_treeview {
my $tv = shift;
$tv->DeleteAllItems();
%nodes = ();
# Fix demo dir to be unix directory seperators
$options->{demo_dir} =~ s/\\/\//g;
File::Find::find(\&wanted, $options->{demo_dir});
sub wanted {
my $dir = $File::Find::dir;
$dir =~ s/^$options->{demo_dir}//;
$dir =~ s/^\///;
$dir = '/' unless $dir;
my $file = $_;
return if $file =~ /^\.$/;
return if -d $file;
return unless $file =~ /\.pl$/;
if (!exists($demos{$dir})) {
$demos{$dir} = [];
}
push @{$demos{$dir}}, { name => $file, fullpath =>
"$File::Find::dir/$file"};
}
#insert the nodes
for my $dir (sort keys %demos) {
my $dnode = $tv->InsertItem(
-text => ($dir eq '/' ? "Misc" : $dir),
);
for my $file (@{$demos{$dir}}) {
my $cnode = $tv->InsertItem(
-parent => $dnode,
-text => $file->{name},
);
$nodes{$cnode} = $file->{fullpath};
if($options->{current} and $options->{current} eq $nodes{$cnode}) {
$tv->Select($cnode);
}
}
}
undef %demos; # release memory
return;
}
######################################################################
# Global configuration
######################################################################
package MyConfig;
######################################################################
# Load configuration
# - populate hash with configuration values
######################################################################
sub load_config {
my %config;
_load_config_from_registry(\%config);
_load_config_from_file(\%config);
#defaults, if not provided
$config{current} = undef
unless exists $config{current};
$config{demo_dir} = File::Basename::dirname($INC{"Win32/GUI.pm"})
."/GUI/demos"
unless exists $config{demo_dir};
$config{perl} = _get_perl_exe()
unless exists $config{perl};
$config{wperl} = _get_wperl_exe($config{perl})
unless exists $config{wperl};
$config{hide_console} = 0
unless exists $config{hide_console} and defined $config{wperl};
return \%config;
}
######################################################################
# Load configuration from registry
# - populate hash with configuration values
# - for now a stub
######################################################################
sub _load_config_from_registry {
return;
}
######################################################################
# Load configuration from file
# - populate hash with configuration values
# - for now a stub
######################################################################
sub _load_config_from_file {
return;
}
######################################################################
# Find a perl executable, suitable for using to launch the scripts
######################################################################
sub _get_perl_exe {
my $perl = $Config::Config{perlpath};
if ($^O ne 'VMS') {
$perl .= $Config::Config{_exe}
unless $perl =~ m/$Config::Config{_exe}$/i;
}
return $perl;
}
######################################################################
# Find a perl executable, suitable for using to launch the scripts
# without a console. In ActiveSate perl we know there'll be wperl.exe
# in the same location as perl.exe (for a standard distribution)
######################################################################
sub _get_wperl_exe {
my $perl = shift;
my $wperl = $perl;
if($wperl =~ s/(perl$Config::Config{_exe})$/w$1/i) {
return $wperl;
}
else {
return undef;
}
}
