diff options
author | Norbert Preining <preining@logic.at> | 2010-05-12 16:51:27 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2010-05-12 16:51:27 +0000 |
commit | b645030efc22e13c2498a1522083634ab91b2de1 (patch) | |
tree | c75c7a71998200d419af56eb755dac2f5115b585 /Master/tlpkg/tlperl/lib/Tk/Scale.pm | |
parent | 44ccd4efc5352f9eb1099ba357708e7b5ff03b83 (diff) |
move tlperl to tlperl.old
git-svn-id: svn://tug.org/texlive/trunk@18209 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/Scale.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Tk/Scale.pm | 278 |
1 files changed, 0 insertions, 278 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/Scale.pm b/Master/tlpkg/tlperl/lib/Tk/Scale.pm deleted file mode 100644 index 57c7bb11aa1..00000000000 --- a/Master/tlpkg/tlperl/lib/Tk/Scale.pm +++ /dev/null @@ -1,278 +0,0 @@ -# Converted from scale.tcl -- -# -# This file defines the default bindings for Tk scale widgets. -# -# @(#) scale.tcl 1.3 94/12/17 16:05:23 -# -# Copyright (c) 1994 The Regents of the University of California. -# Copyright (c) 1994 Sun Microsystems, Inc. -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. - -package Tk::Scale; - -use vars qw($VERSION); -$VERSION = '4.004'; # $Id: //depot/Tkutf8/Scale/Scale.pm#4 $ - -use Tk qw($XS_VERSION); -use AutoLoader; - -use base qw(Tk::Widget); - -Construct Tk::Widget 'Scale'; - -bootstrap Tk::Scale; - -sub Tk_cmd { \&Tk::scale } - -Tk::Methods('coords','get','identify','set'); - - -import Tk qw(Ev); - -# -# Bind -- -# This procedure below invoked the first time the mouse enters a -# scale widget or a scale widget receives the input focus. It creates -# all of the class bindings for scales. -# -# Arguments: -# event - Indicates which event caused the procedure to be invoked -# (Enter or FocusIn). It is used so that we can carry out -# the functions of that event in addition to setting up -# bindings. -sub ClassInit -{ - my ($class,$mw) = @_; - - $mw->bind($class,'<Enter>',['Enter',Ev('x'),Ev('y')]); - $mw->bind($class,'<Motion>',['Activate',Ev('x'),Ev('y')]); - $mw->bind($class,'<Leave>','Leave'); - - $mw->bind($class,'<1>',['ButtonDown',Ev('x'),Ev('y')]); - $mw->bind($class,'<B1-Motion>',['Drag',Ev('x'),Ev('y')]); - $mw->bind($class,'<B1-Leave>','NoOp'); - $mw->bind($class,'<B1-Enter>','NoOp'); - $mw->bind($class,'<ButtonRelease-1>',['ButtonUp',Ev('x'),Ev('y')]); - - $mw->bind($class,'<2>',['ButtonDown',Ev('x'),Ev('y')]); - $mw->bind($class,'<B2-Motion>',['Drag',Ev('x'),Ev('y')]); - $mw->bind($class,'<B2-Leave>','NoOp'); - $mw->bind($class,'<B2-Enter>','NoOp'); - $mw->bind($class,'<ButtonRelease-2>',['ButtonUp',Ev('x'),Ev('y')]); - - $mw->bind($class,'<Control-1>',['ControlPress',Ev('x'),Ev('y')]); - - $mw->bind($class,'<Up>',['Increment','up','little','noRepeat']); - $mw->bind($class,'<Down>',['Increment','down','little','noRepeat']); - $mw->bind($class,'<Left>',['Increment','up','little','noRepeat']); - $mw->bind($class,'<Right>',['Increment','down','little','noRepeat']); - - $mw->bind($class,'<Control-Up>',['Increment','up','big','noRepeat']); - $mw->bind($class,'<Control-Down>',['Increment','down','big','noRepeat']); - $mw->bind($class,'<Control-Left>',['Increment','up','big','noRepeat']); - $mw->bind($class,'<Control-Right>',['Increment','down','big','noRepeat']); - - $mw->bind($class,'<Home>',['set',Ev('cget','-from')]); - $mw->bind($class,'<End>',['set',Ev('cget','-to')]); - return $class; -} - -1; - -__END__ - -# Activate -- -# This procedure is invoked to check a given x-y position in the -# scale and activate the slider if the x-y position falls within -# the slider. -# -# Arguments: -# w - The scale widget. -# x, y - Mouse coordinates. -sub Activate -{ - my $w = shift; - my $x = shift; - my $y = shift; - return if ($w->cget('-state') eq 'disabled'); - my $ident = $w->identify($x,$y); - if (defined($ident) && $ident eq 'slider') - { - $w->configure(-state => 'active') - } - else - { - $w->configure(-state => 'normal') - } -} - -sub Leave -{ - my ($w) = @_; - $w->configure('-activebackground',$w->{'activeBg'}) if ($Tk::strictMotif); - $w->configure('-state','normal') if ($w->cget('-state') eq 'active'); -} - -sub Enter -{ - my ($w,$x,$y) = @_; - if ($Tk::strictMotif) - { - $w->{'activeBg'} = $w->cget('-activebackground'); - $w->configure('-activebackground',$w->cget('-background')); - } - $w->Activate($x,$y); -} - -sub ButtonUp -{ - my ($w,$x,$y) = @_; - $w->CancelRepeat(); - $w->EndDrag(); - $w->Activate($x,$y) -} - - -# ButtonDown -- -# This procedure is invoked when a button is pressed in a scale. It -# takes different actions depending on where the button was pressed. -# -# Arguments: -# w - The scale widget. -# x, y - Mouse coordinates of button press. -sub ButtonDown -{ - my $w = shift; - my $x = shift; - my $y = shift; - $Tk::dragging = 0; - $el = $w->identify($x,$y); - return unless ($el); - if ($el eq 'trough1') - { - $w->Increment('up','little','initial') - } - elsif ($el eq 'trough2') - { - $w->Increment('down','little','initial') - } - elsif ($el eq 'slider') - { - $Tk::dragging = 1; - my @coords = $w->coords(); - $Tk::deltaX = $x-$coords[0]; - $Tk::deltaY = $y-$coords[1]; - } -} -# Drag -- -# This procedure is called when the mouse is dragged with -# mouse button 1 down. If the drag started inside the slider -# (i.e. the scale is active) then the scale's value is adjusted -# to reflect the mouse's position. -# -# Arguments: -# w - The scale widget. -# x, y - Mouse coordinates. -sub Drag -{ - my $w = shift; - my $x = shift; - my $y = shift; - if (!$Tk::dragging) - { - return; - } - $w->set($w->get($x-$Tk::deltaX,$y-$Tk::deltaY)) -} -# EndDrag -- -# This procedure is called to end an interactive drag of the -# slider. It just marks the drag as over. -# Arguments: -# w - The scale widget. -sub EndDrag -{ - my $w = shift; - if (!$Tk::dragging) - { - return; - } - $Tk::dragging = 0; -} -# Increment -- -# This procedure is invoked to increment the value of a scale and -# to set up auto-repeating of the action if that is desired. The -# way the value is incremented depends on the "dir" and "big" -# arguments. -# -# Arguments: -# w - The scale widget. -# dir - "up" means move value towards -from, "down" means -# move towards -to. -# big - Size of increments: "big" or "little". -# repeat - Whether and how to auto-repeat the action: "noRepeat" -# means don't auto-repeat, "initial" means this is the -# first action in an auto-repeat sequence, and "again" -# means this is the second repetition or later. -sub Increment -{ - my $w = shift; - my $dir = shift; - my $big = shift; - my $repeat = shift; - my $inc; - if ($big eq 'big') - { - $inc = $w->cget('-bigincrement'); - if ($inc == 0) - { - $inc = abs(($w->cget('-to')-$w->cget('-from')))/10.0 - } - if ($inc < $w->cget('-resolution')) - { - $inc = $w->cget('-resolution') - } - } - else - { - $inc = $w->cget('-resolution') - } - if (($w->cget('-from') > $w->cget('-to')) ^ ($dir eq 'up')) - { - $inc = -$inc - } - $w->set($w->get()+$inc); - if ($repeat eq 'again') - { - $w->RepeatId($w->after($w->cget('-repeatinterval'),'Increment',$w,$dir,$big,'again')); - } - elsif ($repeat eq 'initial') - { - $w->RepeatId($w->after($w->cget('-repeatdelay'),'Increment',$w,$dir,$big,'again')); - } -} -# ControlPress -- -# This procedure handles button presses that are made with the Control -# key down. Depending on the mouse position, it adjusts the scale -# value to one end of the range or the other. -# -# Arguments: -# w - The scale widget. -# x, y - Mouse coordinates where the button was pressed. -sub ControlPress -{ - my ($w,$x,$y) = @_; - my $el = $w->identify($x,$y); - return unless ($el); - if ($el eq 'trough1') - { - $w->set($w->cget('-from')) - } - elsif ($el eq 'trough2') - { - $w->set($w->cget('-to')) - } -} - - |