[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