#!/bin/sh # # This program is free software under the GPL (>=v2) # Read the COPYING file that comes with GRASS for details. # the next line restarts using wish \ exec $GRASS_WISH "$0" "$@" lappend auto_path $env(GISBASE)/bwidget package require -exact BWidget 1.2.1 if {[info exists env(OS)] && $env(OS) == "Windows_NT"} { set mingw "1" } else { set mingw "0" } # Include the select dialog code because it defines scroll bindings source $env(GISBASE)/etc/gtcltk/select.tcl source $env(GISBASE)/etc/gtcltk/gmsg.tcl # setting environment variables set env(GISDBASE) [exec g.gisenv get=GISDBASE] set env(LOCATION_NAME) [exec g.gisenv get=LOCATION_NAME] set env(MAPSET) [exec g.gisenv get=MAPSET] #home directory set env(HOME) [exec printenv HOME] #name for temporary files set env(TMP) [pid] #name of configuration file set env(CONF) "" #name of raster map to use set env(RASTER) "" #name of vector map to overlay set env(VECTOR) "" #name of site file to overlay set env(SITE) "" #X coordinate in cells of sampling frame set env(SF_X) "" #Y coordinate in cells of sampling frame set env(SF_Y) "" #length in rows of sampling frame set env(SF_RL) "" #length in columns of sampling frame set env(SF_CL) "" #raster map north-south resolution set env(SF_NSRES) "" #raster map easth-west resolution set env(SF_EWRES) "" #north boundary of sampling frame set env(SF_N) "" #south boundary of sampling frame set env(SF_S) "" #easth boundary of sampling frame set env(SF_E) "" #west boundary of sampling frame set env(SF_W) "" #path of r.li source directory set env(F_PATH) $env(GISBASE)/etc/r.li.setup #length in rows of keyboard setted circle set env(CIR_RL) "" #lenght in columns of keyboard setted circle set env(CIR_CL) "" #file for map browsing source $env(GISBASE)/etc/gtcltk/select.tcl #procedures source $env(F_PATH)/r.li.setup.procedures.tcl #other windows source $env(F_PATH)/r.li.windows.tcl #Create sampling area window proc setupSamplingArea {widget} { global env global win set win $widget frame $widget.samplingArea #wm title .samplingArea "\[r.li.setup\] Setup sampling area" #wm minsize .samplingArea 350 200 pack $widget.samplingArea #insert top label label $widget.samplingArea.topLabel -text "Define sampling areas" pack $widget.samplingArea.topLabel -side top -pady 10 #choice selection frame $widget.samplingArea.choice pack $widget.samplingArea.choice set selection "" radiobutton $widget.samplingArea.choice.whole -text "Whole maplayer" -relief flat -variable selection -value whole -width 40 -anchor w radiobutton $widget.samplingArea.choice.regions -text "Regions" -relief flat -variable selection -value regions -width 40 -anchor w radiobutton $widget.samplingArea.choice.units -text "Sample units" -relief flat -variable selection -value units -width 40 -anchor w radiobutton $widget.samplingArea.choice.window -text "Moving window" -relief flat -variable selection -value window -width 40 -anchor w set vectorAreas [exec cat $env(TMP).set | grep "SAMPLINGFRAME" | tail -n 1 | cut -f2 -d " "] if { $vectorAreas == "0|0|1|1"} then { #inserting select areas from the overlayed vector map radiobutton $widget.samplingArea.choice.vector -text "Select areas from the overlayed vector map" -relief flat -variable selection -value vector -width 40 -anchor w pack $widget.samplingArea.choice.whole $widget.samplingArea.choice.regions $widget.samplingArea.choice.units $widget.samplingArea.choice.window $widget.samplingArea.choice.vector } else { pack $widget.samplingArea.choice.whole $widget.samplingArea.choice.regions $widget.samplingArea.choice.units $widget.samplingArea.choice.window } $widget.samplingArea.choice.whole select # buttons frame $widget.samplingArea.buttons -relief flat pack $widget.samplingArea.buttons button $widget.samplingArea.buttons.ok -text "Ok" -command { defineSamplingArea $selection $win.samplingArea $win.samplingArea.buttons.ok configure -state disabled } pack $widget.samplingArea.buttons.ok } #Create sampling frame window proc setupSamplingFrame {widget} { global win set win $widget frame $widget.samplingFrame #wm title .samplingFrame "\[r.li.setup\] Setup sampling frame" #wm minsize .samplingFrame 350 200 pack $widget.samplingFrame #insert top label label $widget.samplingFrame.topLabel -text "Define a sampling frame (region for analysis)" pack $widget.samplingFrame.topLabel -side top -pady 10 frame $widget.samplingFrame.choice -relief flat pack $widget.samplingFrame.choice # choice selection set selection "" radiobutton $widget.samplingFrame.choice.whole -text "Whole maplayer" -relief flat -variable selection -value whole -width 25 -anchor w radiobutton $widget.samplingFrame.choice.keyboard -text "Keyboard setting" -relief flat -variable selection -value keyboard -width 25 -anchor w radiobutton $widget.samplingFrame.choice.mouse -text "Draw the sampling frame" -relief flat -variable selection -value mouse -width 25 -anchor w pack $widget.samplingFrame.choice.whole $widget.samplingFrame.choice.keyboard $widget.samplingFrame.choice.mouse $widget.samplingFrame.choice.whole select # buttons frame $widget.samplingFrame.buttons -relief flat pack $widget.samplingFrame.buttons button $win.samplingFrame.buttons.ok -text "Ok" -command { defineSamplingFrame $selection $win.samplingFrame.buttons.ok set en [$win.samplingFrame.buttons.ok cget -state] if { $en == "disabled" } then { $win.buttons.s_area configure -state normal } } pack $widget.samplingFrame.buttons.ok } #Create new configuration file window proc createNewConfiguration {} { global env # new popup window toplevel .newConf wm title .newConf "\[r.li.setup\] Create new Configuration" bind .newConf { exec rm -f $env(TMP).set exec rm -f *.tmp destroy .newConf openDir .files "~/.r.li/history" } # insert top label label .newConf.topLabel -text "Insert new sampling area settings" pack .newConf.topLabel -side top # frame with config file name, raster map, vector and site to overlay frame .newConf.frame -relief flat pack .newConf.frame -side top -fill y -anchor center set names {{} {Configuration file name:} {Raster map to use to select areas:} {[Vector map to overlay:]}\ {[Site file to overlay:]} } label .newConf.frame.label1 -text [lindex $names 1] -anchor e entry .newConf.frame.entry1 -width 35 -textvariable env(CONF) grid .newConf.frame.label1 .newConf.frame.entry1 -sticky ew -pady 2 -padx 1 label .newConf.frame.label2 -text [lindex $names 2] -anchor e entry .newConf.frame.entry2 -width 35 -textvariable env(RASTER) button .newConf.frame.button2 -text "Browse" -command { set env(RASTER) [GSelect cell] } grid .newConf.frame.label2 .newConf.frame.entry2 .newConf.frame.button2 -sticky ew -pady 2 -padx 1 label .newConf.frame.label3 -text [lindex $names 3] -anchor e entry .newConf.frame.entry3 -width 35 -textvariable env(VECTOR) button .newConf.frame.button3 -text "Browse" -command { set env(VECTOR) [GSelect vector] } grid .newConf.frame.label3 .newConf.frame.entry3 .newConf.frame.button3 -sticky ew -pady 2 -padx 1 label .newConf.frame.label4 -text [lindex $names 4] -anchor e entry .newConf.frame.entry4 -width 35 -textvariable env(SITE) button .newConf.frame.button4 -text "Browse" -command { set env(SITE) [GSelect vector] } grid .newConf.frame.label4 .newConf.frame.entry4 .newConf.frame.button4 -sticky ew -pady 2 -padx 1 # insert buttons frame .newConf.buttons -relief flat pack .newConf.buttons -side bottom -anchor center -pady 2 button .newConf.buttons.save -text "Save settings" -state disabled -command { saveSettings .newConf } button .newConf.buttons.s_area -text "Setup sampling areas" -state disabled -command { setupSamplingArea .newConf .newConf.buttons.save configure -state active .newConf.buttons.s_area configure -state disabled } button .newConf.buttons.s_frame -text "Setup sampling frame" -command { setupSamplingFrame .newConf .newConf.buttons.s_frame configure -state disabled } grid .newConf.buttons.s_frame .newConf.buttons.s_area .newConf.buttons.save -pady 20 } #procedure to set sampling units proc setSampleUnits {widget} { global setSampleUnits set setSampleUnits $widget #new popup windows frame $widget.newUni pack $widget.newUni #new labels label $widget.newUni.toplabel -text "Select an option : " pack $widget.newUni.toplabel -side top #new frame for load an existing map frame $widget.newUni.frame pack $widget.newUni.frame -fill both -anchor center #new frame buttons frame $widget.newUni.button pack $widget.newUni.button -side left -anchor w #buttons button $widget.newUni.button.b2 -text " Use keyboard to enter sampling units dimension " -width 50 -command { setKeyboardUnit $setSampleUnits.newUni.button.b2 configure -state disabled $setSampleUnits.newUni.button.b3 configure -state disabled } pack $widget.newUni.button.b2 -side top -padx 3 -pady 3 button $widget.newUni.button.b3 -text " Use mouse to draw sampling units " -width 50 -command { setMouseUnits $setSampleUnits $setSampleUnits.newUni.button.b2 configure -state disabled $setSampleUnits.newUni.button.b3 configure -state disabled } pack $widget.newUni.button.b3 -side top -padx 3 } #procedure to set moving windows proc setMovWindow {widget} { global setMovWindow set setMovWindow $widget #new popup windows frame $widget.newWin pack $widget.newWin #new labels label $widget.newWin.toplabel -text "Select an option : " pack $widget.newWin.toplabel -side top #new frame for load an existing map frame $widget.newWin.frame pack $widget.newWin.frame -fill both -anchor center #new frame buttons frame $widget.newWin.button pack $widget.newWin.button -side left -anchor w #buttons button $widget.newWin.button.b2 -text " Use keyboard to enter moving window dimension " -width 50 -command { setKeyboardWindow $setMovWindow.newWin.button.b2 configure -state disabled $setMovWindow.newWin.button.b3 configure -state disabled } pack $widget.newWin.button.b2 -side top -padx 3 -pady 3 button $widget.newWin.button.b3 -text " Use mouse to draw the moving windows " -width 50 -command { setMouseWindow $setMovWindow $setMovWindow.newWin.button.b2 configure -state disabled $setMovWindow.newWin.button.b3 configure -state disabled } pack $widget.newWin.button.b3 -side top -padx 3 } #draw sampling regions proc setSampleRegions {widget} { global globWin set globWin $widget frame $widget.regions pack $widget.regions frame $widget.regions.grid pack $widget.regions.grid label $widget.regions.grid.lnumber -text "Enter the number of region to draw" entry $widget.regions.grid.enumber -width 10 -textvariable number grid $widget.regions.grid.lnumber $widget.regions.grid.enumber frame $widget.regions.buttons pack $widget.regions.buttons button $widget.regions.buttons.ok -text Ok -command { if { [catch { exec printf %i $number } ] } then { tk_messageBox -message "Please type an integer value for the number of regions" -icon error -type ok } else { drawRegions $number $globWin.regions.buttons.ok configure -state disabled } } pack $widget.regions.buttons.ok } ################################################## #MAIN WINDOW ################################################## # create directories catch { exec mkdir $env(HOME)/.r.li } catch { exec mkdir $env(HOME)/.r.li/history } bind . { exec rm -f $env(TMP).set destroy . } bind . { exec rm -f $env(TMP).set destroy . } # create tree label label .filesLabel -text "Available sampling area configuration files" pack .filesLabel -side top # create history tree view listbox .files -selectmode single pack .files -side right -expand 1 -fill both -padx 7 -pady 7 # show configuration files in ~/.r.li/history openDir .files "~/.r.li/history" #create load button button .l -text "Load" -width 8 -command { set selection [.files get active ] if { $selection != "" } then { loadConfiguration $selection } } pack .l #create new button button .new -text "New" -width 8 -command { createNewConfiguration } pack .new # create remove button button .r -text "Remove" -width 8 -command { global env set selection [.files get active] if { $selection =="" } then { tk_messageBox -message "No file to remove." -type ok -icon error} else { # new popup windows toplevel .removeconf wm title .removeconf "\[r.li.setup\] Remove Window" # new top label label .removeconf.topLabel -text "Are You sure to remove the ' $selection ' file ?" pack .removeconf.topLabel -side top # create new frame frame .removeconf.buttons -relief flat pack .removeconf.buttons -side top -fill y -anchor center # create yes button button .removeconf.buttons.y -text "Yes" -width 8 -command { if { [ catch { exec rm $env(HOME)/.r.li/history/$selection } ] } then { tk_messageBox -message "'$selection' Not deleted" -type ok -icon error} else { tk_messageBox -message "$selection deleted" -type ok openDir .files "~/.r.li/history" destroy .removeconf} } # create no button button .removeconf.buttons.n -text "No" -width 8 -command { destroy .removeconf openDir .files "~/.r.li/history"} grid .removeconf.buttons.y .removeconf.buttons.n } } pack .r #create help button button .h -text "Help" -width 8 -command { if { $mingw == "1" } { exec -- $env(GRASS_HTML_BROWSER) file://$env(GISBASE)/docs/html/r.li.setup.html &; } else { exec -- $env(GRASS_HTML_BROWSER) file://$env(GISBASE)/docs/html/r.li.setup.html >@stdout 2>@stderr &; } } pack .h #create close button button .c -text "Close" -width 8 -command { destroy . } pack .c