[GRASS-SVN] r35027 -
grass/branches/develbranch_6/visualization/nviz/scripts
svn_grass at osgeo.org
svn_grass at osgeo.org
Fri Dec 26 01:50:23 EST 2008
Author: cmbarton
Date: 2008-12-26 01:50:22 -0500 (Fri, 26 Dec 2008)
New Revision: 35027
Modified:
grass/branches/develbranch_6/visualization/nviz/scripts/colorPopup.tcl
grass/branches/develbranch_6/visualization/nviz/scripts/nviz2.2_script
grass/branches/develbranch_6/visualization/nviz/scripts/panel_sdiff.tcl
grass/branches/develbranch_6/visualization/nviz/scripts/widgets.tcl
Log:
nviz2.2_script: various cosmetic fixes to buttons, enabled mouse wheel scrolling.
widgets.tcl: fix to button label
panel_sdiff.tcl: fix to button label
colorPopup.tcl: switched from legacy custom color selection panel to tk_colorSelect for native color selection on all platforms.
Modified: grass/branches/develbranch_6/visualization/nviz/scripts/colorPopup.tcl
===================================================================
--- grass/branches/develbranch_6/visualization/nviz/scripts/colorPopup.tcl 2008-12-26 06:48:33 UTC (rev 35026)
+++ grass/branches/develbranch_6/visualization/nviz/scripts/colorPopup.tcl 2008-12-26 06:50:22 UTC (rev 35027)
@@ -1,212 +1,31 @@
# mkColorPopup w name color
#
-# Create a dialog box with sliders and buttons to adjust current color
+# Replaced legacy custom dialog box which no longer works on Mac with aqua (and maybe other platforms?)
+# with native color picker called from tk_chooseColor widget
#
+# Kept old function name and arguments to avoid having to change call in many different modules
+#
# Arguments:
-# w - Name to use for new top-level window.
+# w - Name to use for new top-level window (no longer used)
# name - Label for ColorPopup
# color - CurrentColor
+# mode - Made window modal (no longer used)
global CurrColor
-proc mkColorPopup {w name {color "#000000"} {mode 0}} {
+proc mkColorPopup {w {name "Choose color"} {color "#000000"} {mode 0}} {
global CurrColor
-
- catch {destroy $w}
- toplevel $w -class Dialog
- wm title $w "Select Color"
- wm iconname $w "Color"
- wm geometry $w 300x450
- wm minsize $w 50 100
- wm resizable $w false false
-
- set tmp [tcl_to_rgb $color]
- set r [expr ($tmp&0xff0000)>>16]
- set g [expr ($tmp&0x00ff00)>>8]
- set b [expr ($tmp&0x0000ff)]
-
- set tmp $color
-
- # Create two frames in the main window. The top frame will hold the
- # sliders that interactively change color and the bottom one will hold
- # the buttons for predefined color.
-
- frame $w.top -relief raised -border 1
- frame $w.bot -relief raised -border 1
- pack $w.top $w.bot -side top -fill both -expand yes
-
- # Note that these sliders are now floating sliders since tk4.0
- # supports these. This means that color values should be
- # specified in the range 0.0-1.0. For ease of use, most routines
- # just convert from 00-FF to 0.0-1.0.
- frame $w.top.left
- Nv_mkColorScale $w.top.left Red $r red $w.top.color
- Nv_mkColorScale $w.top.left Green $g green $w.top.color
- Nv_mkColorScale $w.top.left Blue $b blue $w.top.color
-
- # ACS One line: without next line, the scales and $w.top.color are set to white next time
- # after a color button (not sliders) has been used, regardless $color. Don't know why
- setScales $w.top.left $color
- pack $w.top.left.red $w.top.left.green $w.top.left.blue -side top -expand 1
- set CurrColor $color
- label $w.top.color -bg $color -width 5
- pack $w.top.left -side left -expand 1
- pack $w.top.color -side left -padx 10 -pady 10 -fill both -expand yes
+ set CurrColor [tk_chooseColor -initialcolor $color -title $name]
- tkwait visibility $w
-
- frame $w.bot.buttonframe
- button $w.bot.buttonframe.ok -text OK -command "destroy $w" -bd 1
- button $w.bot.buttonframe.cancel -bd 1 \
- -text Cancel -command "set CurrColor $tmp; destroy $w"
- label $w.bot.buttonframe.label -text $name
- pack $w.bot.buttonframe.label -side left -expand yes -padx 10
- pack $w.bot.buttonframe.cancel $w.bot.buttonframe.ok -side right -expand 1
- pack $w.bot.buttonframe -side bottom -fill x
- mkColorButtons $w.bot.bf $w.top.left $w.top.color
- pack $w.bot.bf -padx 3 -pady 6 -side top -expand 1
- bind $w <Any-Enter> [list focus $w]
- focus $w
-
- # If the caller desires, make everything else wait until a color
- # has been selected or this popup has been dismissed.
- if {$mode} {grab $w}
-
- tkwait window $w
+ if {$CurrColor==""} {set CurrColor #000000}
return $CurrColor
}
-proc mkColorButtons { B S L } {
- global CurrColor
-
- frame $B
- set clist [mkColorList]
-
- for {set i 0; set k 0} {$i < 9 } {incr i} {
- # make frame to hold buttons in this row
- frame $B.f$i
- for {set j 0} {$j < 5 } {incr j; incr k} {
- set color [lindex $clist $k]
- button $B.f$i.$j -bg $color \
- -activeforeground $color \
- -activebackground $color \
- -width 0 -height 0 \
- -highlightthickness 1 \
- -padx 7 -pady 0 \
- -command "setScales $S $color; $L config -bg $color; set CurrColor $color"
- pack $B.f$i.$j -side top -expand 1
- }
- pack $B.f$i -side left
- }
-}
-
-proc getColorfromScales {S} {
-
- # Have to convert colors back to #XXXXXX since that is what
- # everyone else expects
- set r [expr int([$S.red.scale get] * 255.0)]
- set g [expr int([$S.green.scale get] * 255.0)]
- set b [expr int([$S.blue.scale get] * 255.0)]
-
- set r [hexval $r]
- set g [hexval $g]
- set b [hexval $b]
-
- return #$r$g$b
-}
-
-
-
-
-proc setLabelfromScales {S L args} {
- global CurrColor
-
- # Convert back to #XXXXXX
- set r [expr int([$S.red.scale get] * 255.0)]
- set g [expr int([$S.green.scale get] * 255.0)]
- set b [expr int([$S.blue.scale get] * 255.0)]
-
- set r [hexval $r]
- set g [hexval $g]
- set b [hexval $b]
-
- $L config -bg #$r$g$b
- set CurrColor #$r$g$b
-}
-
-proc setScales {S c} {
- set color [tcl_to_rgb $c]
- set r [expr ($color&0xff0000)>>16]
- set g [expr ($color&0x00ff00)>>8]
- set b [expr ($color&0x0000ff)]
-
- $S.red.scale set [expr ($r + 0.0)/255.0]
- $S.green.scale set [expr ($g + 0.0)/255.0]
- $S.blue.scale set [expr ($b + 0.0)/255.0]
-}
-
-proc mkColorList {} {
-
- set ramp 0
- set colorlist {}
- set maxval ff
- set minval 00
- for {set r 4; set i 0} {$r < 16} {incr r 5} {
- for {set g 4} {$g < 16} {incr g 5} {
- for {set b 4} {$b < 16 && $i < 40} {incr b 5} {
- set tmpr [hexval [expr $r/15.0*255]]
- set tmpg [hexval [expr $g/15.0*255]]
- set tmpb [hexval [expr $b/15.0*255]]
- set color #$tmpr$tmpg$tmpb
- set colorlist [concat $colorlist $color]
- incr i
- }
- if {$ramp == 0} {
- set colorlist [concat $colorlist #ff0000 #00ffff]
- incr ramp 2
- incr i 2
- } elseif {$ramp < 10} {
- set tmpg [hexval [expr $ramp/9.0*255]]
- set color #$maxval$tmpg$minval
- set colorlist [concat $colorlist $color]
- incr ramp
- incr i
-
- set tmpg [hexval [expr (1.0 - $ramp/9.0)*255]]
- set color #$minval$tmpg$maxval
- set colorlist [concat $colorlist $color]
- incr ramp
- incr i
-
- } elseif {$ramp < 16} {
- set tmpb [hexval [expr ($ramp-10)/7.0*255]]
- set color #$maxval$maxval$tmpb
- set colorlist [concat $colorlist $color]
- incr ramp
- incr i
- set tmpb [hexval [expr (1.0 - ($ramp-10)/7.0)*255]]
- set color #$minval$minval$tmpb
- set colorlist [concat $colorlist $color]
- incr ramp
- incr i
- }
- }
- }
- for {set gray 0} {$gray < 5} {incr gray} {
- set g [hexval [expr (1.0 - $gray/4.0)*255]]
- set color #$g$g$g
- set colorlist [concat $colorlist $color]
- }
-
-
- return $colorlist
-
-}
-
proc hexval { n } {
+ # this proc might be used by some other modules
set n [expr int($n)]
if {$n > 15} {
@@ -215,39 +34,10 @@
return [format "0%x" $n]
}
-##########################################################################
-# procedure to make sliders
-##########################################################################
-proc Nv_mkColorScale { P {name " "} {curr 200}\
- {color ""} {chip ""}} {
- set S $P.$color
- frame $S
- frame $S.f
-
- # Make a global variable shared by this scale and its entry
- global $S.val
-
- set $S.val [expr ($curr + 0.0)/255.0]
-
- scale $S.scale -from 0.0 -length 140 -showvalue 0 -orient h \
- -digits 3 -resolution 0.01 -tickinterval 0 -to 1.0 -width 13 \
- -command "setLabelfromScales $P $chip " \
- -activebackground gray80 -background gray90 -bg $color \
- -variable $S.val
-
- label $S.f.label -text $name
- $S.scale set $curr
- entry $S.f.entry -width 5 -borderwidth 2 -relief sunken -textvariable $S.val
- bind $S.f.entry <Return> "set $S.val [$S.f.entry get]"
- pack $S.scale $S.f -side top
- pack $S.f.label $S.f.entry -side left
-
- return $S
-}
-
-
proc tcl_to_rgb {c} {
+ # this proc is used by some other modules
+
regsub # $c 0x newcolor
return $newcolor
}
Modified: grass/branches/develbranch_6/visualization/nviz/scripts/nviz2.2_script
===================================================================
--- grass/branches/develbranch_6/visualization/nviz/scripts/nviz2.2_script 2008-12-26 06:48:33 UTC (rev 35026)
+++ grass/branches/develbranch_6/visualization/nviz/scripts/nviz2.2_script 2008-12-26 06:50:22 UTC (rev 35027)
@@ -8,7 +8,7 @@
# Major update of GUI Nov 2006, Michael Barton, Arizona State University
#
##########################################################################
-# COPYRIGHT: (C) 1999 - 2006 by Michael Barton and the GRASS Development Team
+# COPYRIGHT: (C) 1999 - 2008 by Michael Barton and the GRASS Development Team
#
# This program is free software under the GNU General Public
# License (>=v2). Read the file COPYING that comes with GRASS
@@ -313,24 +313,24 @@
# make panel area
###########################################################################
canvas $Nv_(PAREA).canvas -yscrollcommand "$Nv_(PAREA).f1.scrolly set" \
- -borderwidth 2 -relief sunken
+ -borderwidth 2 -relief sunken
frame $Nv_(PAREA).f1 -borderwidth 0 -relief flat
- scrollbar $Nv_(PAREA).f1.scrolly -command "$Nv_(PAREA).canvas yview"
+ scrollbar $Nv_(PAREA).f1.scrolly -command "$Nv_(PAREA).canvas yview"
+ bind all <MouseWheel> {$Nv_(PAREA).canvas yview scroll [expr -1 * %D] units}
button $Nv_(PAREA).f1.b1 -bitmap @$bit_map_path/left \
-width 8 -height 12 -command "hide_menus"
help $Nv_(PAREA).f1.b1 balloon "Hide Panels"
frame $Nv_(P_AREA) -relief flat
-
# DEBUG
if {$DEBUG} {puts "panel area made"}
###########################################################################
# make menubar
###########################################################################
- frame $Nv_(AREA).menu -relief flat -borderwidth 1
- pack $Nv_(AREA).menu -side top -fill x -expand no
+ frame $Nv_(AREA).menu -relief flat -borderwidth 0
+ #pack $Nv_(AREA).menu -side top -fill x -expand no
pack $Nv_(PAREA).canvas -side top -fill both -expand yes
pack $Nv_(PAREA).f1 -side left -before $Nv_(PAREA).canvas -fill y
@@ -346,19 +346,20 @@
$Nv_(PAREA).canvas create window 0 0 -window $Nv_(P_AREA) -anchor nw
bind $Nv_(P_AREA) <Configure> "set_scrollsize"
- pack [Nv_mkMenu $Nv_(AREA).menu.help Help \
+ set helpmenu [Nv_mkMenu $Nv_(AREA).menu.help "Help " \
{"NVIZ Help" "About NVIZ" "NVIZ - Bugs / ToDo"} \
{0 0 0} \
- {"nviz_browse nviz_toc.html" "nviz_browse nviz_desc.html" "nviz_browse bugs_todo.html"} ] \
- -side right -fill none -expand no -anchor e
+ {"nviz_browse nviz_toc.html" "nviz_browse nviz_desc.html" "nviz_browse bugs_todo.html"} ]
+# #pack $helpmenu -side right -fill none -expand yes -anchor e
+
# DEBUG
if {$DEBUG} {puts "Help menu made"}
- set Nv_(AREA).menu [frame $Nv_(AREA).menu.left -relief flat -bd 0]
+ #set Nv_(AREA).menu [frame $Nv_(AREA).menu.left -relief flat -bd 0]
# file menu
- set filemenu [Nv_mkMenu $Nv_(AREA).menu.file File \
+ set filemenu [Nv_mkMenu $Nv_(AREA).menu.file "File " \
{"Load State ..." "Save State ..." \
"" \
"Set Canvas Size ..."
@@ -379,7 +380,7 @@
"Separator" \
"reset_Nviz" "Nv_close_scripting ; exit ; puts"}]
- pack $filemenu -side left -fill x -expand no
+# pack $filemenu -side left -fill x -expand no
# DEBUG
@@ -392,16 +393,16 @@
# DEBUG
if {$DEBUG} {puts "disabled made"}
- pack [Nv_mkConfigMenu $Nv_(AREA).menu.config] -side left -fill x -expand no
+# pack [Nv_mkConfigMenu $Nv_(AREA).menu.config] -side left -fill x -expand no
- pack [Nv_mkPanelMenu $Nv_(AREA).menu.panel] -side left -fill x -expand no
+# pack [Nv_mkPanelMenu $Nv_(AREA).menu.panel] -side left -fill x -expand no
# DEBUG
if {$DEBUG} {puts "scripting menu 0 made"}
# Make a menu entry for scripting
- menubutton $Nv_(AREA).menu.scripting -text Scripting \
- -menu $Nv_(AREA).menu.scripting.m -underline 0
+ set scriptingbtn [menubutton $Nv_(AREA).menu.scripting -text "Scripting " \
+ -menu $Nv_(AREA).menu.scripting.m -underline 0 ]
set scriptingmenu [menu $Nv_(AREA).menu.scripting.m]
$scriptingmenu add checkbutton -label "On" \
@@ -432,18 +433,21 @@
$scriptingmenu add command -label "Script Tools" \
-underline 1 -command {exec nviz -f $default_panel_path/script_tools -q &}
- pack $Nv_(AREA).menu.scripting -side left -fill x -expand no
+ set configmenu [Nv_mkConfigMenu $Nv_(AREA).menu.config]
+ set panelmenu [Nv_mkPanelMenu $Nv_(AREA).menu.panel]
+ pack $helpmenu -side right -fill none -expand no -anchor e
+ pack $filemenu $configmenu $panelmenu $scriptingbtn -side left -fill none -expand no -anchor w
# DEBUG
if {$DEBUG} {puts "scripting menu made"}
- pack $Nv_(AREA).menu -side left -fill x -expand no
+ pack $Nv_(AREA).menu -side left -fill x -expand yes
+ tk_menuBar $Nv_(AREA).menu
+ #tk_menuBar $Nv_(AREA).menu $filemenu $Nv_(AREA).menu.panel \
+ #$scriptingbtn
- tk_menuBar $Nv_(AREA).menu $Nv_(AREA).menu.file $Nv_(AREA).menu.panel \
- $Nv_(AREA).menu.scripting
-
set Nv_(Q) [Q_init 2]
#pack $Nv_(AREA).menu.wait_pls -side left -fill x -expand yes
@@ -627,7 +631,7 @@
############################################################################
# procedure to make PANEL pulldown menu
###########################################################################
-proc Nv_mkPanelMenu { P { name Visualize } } {
+proc Nv_mkPanelMenu { P { name "Visualize " } } {
global Nv_ DEBUG
menubutton $P -text $name -menu $P.m -underline 0
@@ -660,7 +664,7 @@
############################################################################
# procedure to make CONFIG pulldown menu
###########################################################################
-proc Nv_mkConfigMenu { P { name Appearance } } {
+proc Nv_mkConfigMenu { P { name "Appearance " } } {
global Nv_ DEBUG
menubutton $P -text $name -menu $P.m -underline 0
Modified: grass/branches/develbranch_6/visualization/nviz/scripts/panel_sdiff.tcl
===================================================================
--- grass/branches/develbranch_6/visualization/nviz/scripts/panel_sdiff.tcl 2008-12-26 06:48:33 UTC (rev 35026)
+++ grass/branches/develbranch_6/visualization/nviz/scripts/panel_sdiff.tcl 2008-12-26 06:50:22 UTC (rev 35027)
@@ -121,7 +121,7 @@
set name [Nget_current sdiff]
if {$name == 0} {
- set name "none selected"
+ set name "None selected "
} else {
set n [lsearch $list $name]
set list [lreplace $list $n $n]
Modified: grass/branches/develbranch_6/visualization/nviz/scripts/widgets.tcl
===================================================================
--- grass/branches/develbranch_6/visualization/nviz/scripts/widgets.tcl 2008-12-26 06:48:33 UTC (rev 35026)
+++ grass/branches/develbranch_6/visualization/nviz/scripts/widgets.tcl 2008-12-26 06:50:22 UTC (rev 35027)
@@ -407,7 +407,7 @@
}
incr j
}
-
+
return $P
}
@@ -580,7 +580,7 @@
set name [Nget_current $type]
if {[llength $list] == 0} {
- set name "None Loaded"
+ set name "None Loaded "
} else {
set n [lsearch $list $name]
set list [lreplace $list $n $n]
More information about the grass-commit
mailing list