source: trunk/gui/scripts/videospeed.tcl @ 4503

Last change on this file since 4503 was 3330, checked in by gah, 11 years ago

merge (by hand) with Rappture1.2 branch

File size: 6.0 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2
3# ----------------------------------------------------------------------
4#  COMPONENT: spinint - spinner for integer values
5#
6#  This widget is a spinner with up/down arrows for managing integer
7#  values.
8# ======================================================================
9#  AUTHOR:  Michael McLennan, Purdue University
10#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
11#
12#  See the file "license.terms" for information on usage and
13#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14# ======================================================================
15package require Itk
16package require BLT
17
18option add *Videospeed.width 5 widgetDefault
19option add *Videospeed.textBackground white widgetDefault
20
21blt::bitmap define Videospeed-up {
22#define up_width 8
23#define up_height 4
24static unsigned char up_bits[] = {
25   0x10, 0x38, 0x7c, 0xfe};
26}
27
28blt::bitmap define Videospeed-down {
29#define arrow_width 8
30#define arrow_height 4
31static unsigned char arrow_bits[] = {
32   0xfe, 0x7c, 0x38, 0x10};
33}
34
35itcl::class Rappture::Videospeed {
36    inherit itk::Widget
37
38    itk_option define -min min Min ""
39    itk_option define -max max Max ""
40    itk_option define -factor factor Factor 1
41
42    constructor {args} { # defined below }
43
44    public method value {args}
45    public method bump {{factor up}}
46    protected method _validate {char}
47    protected variable _value ""
48}
49
50itk::usual Videospeed {
51    keep -cursor -font
52    keep -foreground -background
53    keep -textforeground -textbackground
54    keep -selectbackground -selectforeground -selectborderwidth
55}
56
57# ----------------------------------------------------------------------
58# CONSTRUCTOR
59# ----------------------------------------------------------------------
60itcl::body Rappture::Videospeed::constructor {args} {
61    itk_component add entry {
62        entry $itk_interior.entry
63    } {
64        usual
65        keep -width
66        rename -background -textbackground textBackground Background
67        rename -foreground -textforeground textForeground Foreground
68        rename -highlightbackground -background background Background
69    }
70    pack $itk_component(entry) -side left -expand yes -fill x
71
72    bind $itk_component(entry) <KeyPress> \
73        [itcl::code $this _validate %A]
74    bind $itk_component(entry) <KeyPress-Return> \
75        "$this value \[$itk_component(entry) get\]"
76    bind $itk_component(entry) <KeyPress-Tab> \
77        "$this value \[$itk_component(entry) get\]"
78
79    itk_component add controls {
80        frame $itk_interior.cntls
81    }
82    pack $itk_component(controls) -side right
83
84    itk_component add up {
85        button $itk_component(controls).spinup -bitmap Videospeed-up \
86            -borderwidth 1 -relief raised -highlightthickness 0 \
87            -command [itcl::code $this bump up]
88    } {
89        usual
90        ignore -borderwidth -highlightthickness
91    }
92    pack $itk_component(up) -side top -expand yes -fill both
93
94    itk_component add down {
95        button $itk_component(controls).spindn -bitmap Videospeed-down \
96            -borderwidth 1 -relief raised -highlightthickness 0 \
97            -command [itcl::code $this bump down]
98    } {
99        usual
100        ignore -borderwidth -highlightthickness
101    }
102    pack $itk_component(down) -side bottom -expand yes -fill both
103
104    eval itk_initialize $args
105}
106
107# ----------------------------------------------------------------------
108# USAGE: value ?<newval>?
109#
110# Clients use this to query/set the value for this widget.  With
111# no args, it returns the current value for the widget.  If the
112# <newval> is specified, it sets the value of the widget and
113# sends a <<Value>> event.
114# ----------------------------------------------------------------------
115itcl::body Rappture::Videospeed::value {args} {
116    if {[llength $args] == 1} {
117        set string [lindex $args 0]
118        # allow for floating point values
119        if { [regexp {^ *([0-9]+\.?[0-9]*|\.[0-9]+)x *$} $string match newval] } {
120        } elseif { [regexp {^ *([0-9]+\.?[0-9]*|\.[0-9]+) *$} $string match newval] } {
121        } else {
122            bell
123            return
124        }
125        if {"" != $newval} {
126            if {"" != $itk_option(-min) && $newval < $itk_option(-min)} {
127                set newval $itk_option(-min)
128            }
129            if {"" != $itk_option(-max) && $newval > $itk_option(-max)} {
130                set newval $itk_option(-max)
131            }
132        }
133        set _value $newval
134        $itk_component(entry) delete 0 end
135        $itk_component(entry) insert 0 ${newval}x
136        after 10 \
137            [list catch [list event generate $itk_component(hull) <<Value>>]]
138    } elseif {[llength $args] != 0} {
139        error "wrong # args: should be \"value ?newval?\""
140    }
141    return $_value
142}
143
144# ----------------------------------------------------------------------
145# USAGE: bump ?<factor>?
146#
147# Used internally when you click on the up/down arrows.  Clients
148# can also use it directly to bump values up/down.  The optional
149# <factor> can be an integer value or the keyword "up" or "down".
150# ----------------------------------------------------------------------
151itcl::body Rappture::Videospeed::bump {{factor up}} {
152    if {"up" == $factor} {
153        set factor $itk_option(-factor)
154    } elseif {"down" == $factor} {
155        set factor [expr {1.0/$itk_option(-factor)}]
156    } elseif {![string is integer $factor]} {
157        error "bad factor \"$factor\": should be up, down, or integer"
158    }
159
160    set val [$itk_component(entry) get]
161    if {$val == ""} {
162        set val 0
163    }
164    value [expr {$_value*$factor}]
165}
166
167# ----------------------------------------------------------------------
168# USAGE: _validate <char>
169#
170# Validates each character as it is typed into the spinner.
171# If the <char> is not a digit, then this procedure beeps and
172# prevents the character from being inserted.
173# ----------------------------------------------------------------------
174itcl::body Rappture::Videospeed::_validate {char} {
175    if {[string match "\[ -~\]" $char]} {
176        if {![string match "\[0-9\]" $char]} {
177            bell
178            return -code break
179        }
180    }
181}
Note: See TracBrowser for help on using the repository browser.