← Back to branch summary

~ubuntu-branches/ubuntu/trusty/rheolef/trusty-proposed

« back to all changes in this revision

Viewing changes to nfem/vtk/tcl_toolbar.tcl

  • Committer: Bazaar Package Importer
  • Author(s): Christophe Prud'homme
  • Date: 2010-06-12 09:08:59 UTC
  • Revision ID: james.westby@ubuntu.com-20100612090859-8gpm2gc7j3ab43et
Tags: upstream-5.89
Import upstream version 5.89

Show diffs side-by-side

added added

removed removed

Lines of Context:
nfem/vtk/tcl_toolbar.tcl
 
1
#
 
2
# This file is part of Rheolef.
 
3
#
 
4
# Copyright (C) 2000-2009 Pierre Saramito 
 
5
#
 
6
# Rheolef is free software; you can redistribute it and/or modify
 
7
# it under the terms of the GNU General Public License as published by
 
8
# the Free Software Foundation; either version 2 of the License, or
 
9
# (at your option) any later version.
 
10
#
 
11
# Rheolef is distributed in the hope that it will be useful,
 
12
# but WITHOUT ANY WARRANTY; without even the implied warranty of
 
13
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
14
# GNU General Public License for more details.
 
15
#
 
16
# You should have received a copy of the GNU General Public License
 
17
# along with Rheolef; if not, write to the Free Software
 
18
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 
19
#
 
20
# ----------------------------------------------------------------------
 
21
#  simple toolbar with mutually-exclusive tools
 
22
# ----------------------------------------------------------------------
 
23
 
 
24
proc toolbar_create {win {origin "top"} {command ""}} {
 
25
    global toolbar_data
 
26
 
 
27
    frame $win -class Toolbar
 
28
 
 
29
    set toolbar_data($win-current) ""
 
30
    set toolbar_data($win-origin) $origin
 
31
    set toolbar_data($win-command) $command
 
32
    return $win
 
33
}
 
34
 
 
35
proc toolbar_add {win tool image} {
 
36
    global toolbar_data
 
37
 
 
38
    set label "$win.tool-$tool"
 
39
    label $label -borderwidth 2 -relief raised -image $image
 
40
    pack $label -side $toolbar_data($win-origin) -fill both
 
41
 
 
42
    bind $label <ButtonPress-1> [list toolbar_select $win $tool]
 
43
 
 
44
    if {[llength [pack slaves $win]] == 1} {
 
45
        # after idle [list toolbar_select $win $tool]
 
46
        toolbar_select $win $tool
 
47
    }
 
48
    return $label
 
49
}
 
50
 
 
51
proc toolbar_configure {win tool} {
 
52
    global toolbar_data
 
53
 
 
54
    if {$toolbar_data($win-current) != ""} {
 
55
        set label "$win.tool-$toolbar_data($win-current)"
 
56
        $label configure -relief raised
 
57
    }
 
58
    set label "$win.tool-$tool"
 
59
    $label configure -relief sunken
 
60
 
 
61
    set toolbar_data($win-current) $tool
 
62
}
 
63
 
 
64
# use also callback
 
65
proc toolbar_select {win tool} {
 
66
    global toolbar_data
 
67
 
 
68
    toolbar_configure $win $tool
 
69
 
 
70
    if {$toolbar_data($win-command) != ""} {
 
71
        set cmd [percent_subst %t $toolbar_data($win-command) $tool]
 
72
        uplevel #0 $cmd
 
73
    }
 
74
}
 
75
 
 
76
proc toolbar_get {win} {
 
77
    global toolbar_data
 
78
    return $toolbar_data($win-current)
 
79
}