App-Cheats
view release on metacpan or search on metacpan
MainLoop;
'
# TODO: Check if Unigraph is perl tk
# Create Menu Buttons (PTk,bind method)
perl -MTk -le '$mw=MainWindow->new; $mw->Button(-text => "Exit", -command => sub{exit})->pack(-side => "bottom", -fill => "both", -expand => 1); $f=$mw->Frame(-relief => "ridge", -borderwidth => 2)->pack(-side => "top", -expand => 1, -fill => "both")...
# Perk Tk Event Types (PTk,bind method)
ButtonPress (or Button)
ButtonRelease
Circulate
Colormap
Configure
Destroy
Enter
Expose
FocusIn
FocusOut
Gravity
KeyPress (or Key)
KeyRelease
Leave
Map
Motion
Reparent
Unmap
Visibility
# Perl Tk Event Info Usage program
perl -MTk -le '$mw=MainWindow->new; $b=$mw->Button->pack(-ipadx => 60); $b->bind("<Key>", [sub{print "ARGV: @_[1..$#_]"}, Ev("k"), Ev("K"), Ev("N"), Ev("T")]); MainLoop'
# Perl Tk Event Info (PTk,bin methods,Ev)
#
# Coordinates (relative to window)
Ev('x')
Ev('y')
#
# Coordinates (relative to root of window)
Ev('X')
Ev('Y')
#
# Button Number (of mouse click)
Ev('b')
#
# Size of widget
Ev('h') # height
Ev('w') # width
#
# Keyboard Info
Ev('k') # Physical Key Value 37 37
Ev('K') # Letter A a
Ev("N") # Decimal 65 97
#
# Event Type
Ev('T') # KeyPress
# Perl Tk Event Info (PTk,bin methods,Ev)
# Stop events in callback.
return # Exits only current sub
Tk::break # Stops all callbacks for an event
# View order of bindings for a widget (PTk,bin methods,Ev)
print for $b->bindtags
print "$_: ", $b->bind($_) for $b->bindtags
# Order order of bindings for a widget (PTk,bin methods,Ev)
$b->bindtags("[all]")
# View the bindtags for (PTk):
# Class
# Install
# Toplevel
# All
perl -MTk -le '$b=MainWindow->new->Button->pack; $b->bind("<ButtonRelease-1>", sub{exit}); map {print $_; printf " $_\n" for $b->bind($_)} $b->bindtags'
# Check if widget exists, if widget if packed (mapped,PTk)
perl -MTk -le '$mw=MainWindow->new; $b=$mw->Button(-text => "unpack", -command => sub{$b->packForget})->pack; $mw->Button(-text => "Check status", -command => sub{print for "",Exists($b), $mw->appname, $b->ismapped()})->pack; MainLoop'
# Track mouse movements (PTk)
perl -MTk -le '$mw=MainWindow->new; $mw->geometry("200x200+0+0"); $w=$mw->Label(-textvariable => \$t, -width => 20)->pack; $mw->bind("<Motion>", sub{$t=join ", ", $mw->pointerxy}); MainLoop'
# Track mouse movements (PTk)
# More positional values
perl -MTk -le '$w=tkinit; $w->geometry("200x200"); $w->Label(-textvariable => \$t, -justify => "left")->pack; $w->bind("<Motion>", sub{$t=sprintf "pointerxy:%s,%s\nxy:%s,%s\nroot:%s.%s\nvroothw:+%s,+%s\nvrootxy:%s,%s\nscreen:%s", $w->pointerxy, $w->x...
# Add tab completion to an entry widget
perl -MTk -le '$mw=MainWindow->new; $e=$mw->Entry(-textvariable => \$t)->pack; $e->focus; $e->bind("<Tab>", sub{@a=glob "$t*"; $t=shift @a if @a; $e->selectionClear}); MainLoop'
# Bind Enter/Carriage Return key (PTk)
$e->bind("<Return>"
# Swap button (PTk)
perl -MTk -le '$mw=MainWindow->new; for(1..3){my $b=$mw->Button(-text => "B$_", -width => 20)->pack; $b->configure(-command => sub{ ($n)=grep{$b[$_] eq $b}0..$#b; return unless $n > 0; @b[$n,$n-1]=@b[$n-1,$n]; $_->packForget for @b; $_->pack for @b})...
# Drag and swap buttons (PTk)
perl -MTk -le '$mw=MainWindow->new; my @b; sub id{my($n)=grep{$b[$_] eq $_[0]}0..$#b; $n} for(1..3){push @b, $mw->Button(-text => "B$_", -width => 20)->pack} $mw->bind("<ButtonRelease-1>",[sub{$m=id(shift); $n=id($mw->containing(@_)); @b[$m,$n]=@b[$n...
# Swap frames of buttons (PTk)
perl -MTk -le '$mw=MainWindow->new; my @b; sub id{my($n)=grep{$b[$_] eq $_[0]}0..$#b; $n} for my $fi(1..3){my $f=$mw->Frame->pack; push @b,$f; $f->Button(-text => "Btn - $fi - $_", -width => 20)->pack(-side => "left") for 1..3} $mw->bind("<ButtonRele...
# Notebook example 1. multiple pages/tabs (PTk)
perl -MTk -MTk::NoteBook -le '$nb=MainWindow->new->NoteBook->pack(-fill => "both", -expand => 1); @pgs = map { $nb->add("page$_", -label => "Page $_") } 0..5; $pgs[0]->Button(-text => "Button $_")->pack(-fill => "both") for 1..5; $pgs[1]->Label(-text...
# Notebook example 2. multiple pages/tabs (PTk)
# Command when clicking a page/tab
perl -MTk -MTk::NoteBook -le '$nb=MainWindow->new->NoteBook(-font => "Courier 14 bold")->pack(-fill => "both", -expand => 1); @pgs = map { $nb->add("page$_", -label => "Page $_") } 0..20; $pgs[0]->Button(-text => "Button $_")->pack(-fill => "both") f...
# Notebook example 3. multiple pages/tabs (PTk)
# Page deletion
perl -MTk -MTk::NoteBook -le '$nb=MainWindow->new->NoteBook->pack(-fill => "both", -expand => 1); @pgs = map { $nb->add("page$_", -label => "Page $_") } 0..10; $nb->pagecget("page0", "-state"); $pgs[0]->Button(-text => "Button $_")->pack(-fill => "bo...
# Notebook example 4. multiple pages/tabs (PTk)
# Get page by name
perl -MTk -MTk::NoteBook -le '$nb=MainWindow->new->NoteBook->pack(-fill => "both", -expand => 1); @pgs = map { $nb->add("page$_", -label => "Page $_") } 0..10; $nb->pagecget("page0", "-state"); $pgs[0]->Button(-text => "Button $_")->pack(-fill => "bo...
# Notebook example 5. multiple pages/tabs (PTk)
# 2 rows
perl -MTk -MTk::NoteBook -le '$nb=MainWindow->new->NoteBook->pack(-fill => "both", -expand => 1); $nb->add("page0$_", -label => "Page $_") for 1..5; map { my $nb = $_; $nb->add("page1$_", -label => "Page $_") for 6..10; } map $_->NoteBook->pack, ma...
# Notebook example 6. multiple pages/tabs (PTk)
( run in 1.285 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )