diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/demos/widtrib/cursor.pl')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Tk/demos/widtrib/cursor.pl | 65 |
1 files changed, 65 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/demos/widtrib/cursor.pl b/Master/tlpkg/tlperl/lib/Tk/demos/widtrib/cursor.pl new file mode 100644 index 00000000000..645f1433d54 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Tk/demos/widtrib/cursor.pl @@ -0,0 +1,65 @@ +# Predefined cursors. +# -*- perl -*- + +# +# $Id: $ +# Author: Slaven Rezic +# +# Copyright (C) 2006,2008 Slaven Rezic. All rights reserved. +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +# Mail: slaven@rezic.de +# WWW: http://www.rezic.de/eserte/ +# + +use vars qw/$TOP/; + +sub cursor { + my($demo) = @_; + $TOP = $MW->WidgetDemo( + -name => $demo, + -text => <<'EOF', +This window displays the names of Tk's built-in +resp. predefined X11 cursors. Click or move on +the names to see the cursor shape. +EOF + -geometry_manager => 'grid', + -title => 'Predefined cursors', + -iconname => 'Predefined cursors', + ); + + my $fh; + TRY_CURSORFONTH: { + for my $cursorfonth (Tk->findINC("X11/cursorfont.h"), + "/usr/X11R6/include/X11/cursorfont.h", + "/usr/include/X11/cursorfont.h", + ) { + last TRY_CURSORFONTH if (open $fh, $cursorfonth); + } + $TOP->Label(-text => "Sorry. I can't find X11/cursorfont.h on this system.")->grid; + return; + } + + while(<$fh>) { + chomp; + if (/XC_(\S+)/) { + my $cursorname = $1; + next if $cursorname eq 'num_glyphs'; + push @cursors, $cursorname; + } + } + + $lb = $TOP->Scrolled("Listbox", -scrollbars => "ose", -selectmode => "browse")->grid(-sticky => "ns"); + $lb->insert("end", @cursors); + $lb->bind("<Motion>", sub { + my($inx) = $lb->nearest($lb->Subwidget("scrolled")->XEvent->y); + $lb->configure(-cursor => $cursors[$inx]); + }); + $lb->bind("<<ListboxSelect>>", sub { + my($inx) = $lb->curselection; + $lb->configure(-cursor => $cursors[$inx]); + }); +} + +__END__ |