#!/usr/bin/wish ## ## $Id: hypermap,v 1.3 2003-01-08 15:25:35 dron Exp $ ## ## Copyright (C) 1997, Victor Wagner ## Copyright (C) 2002, Andrey Kiselev ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation; either version 2, or (at your option) ## any later version. ## ## This program is distributed in the hope that it will be useful, ## but WITHOUT ANY WARRANTY; without even the implied warranty of ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ## GNU General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, ## USA. package require Fgis proc loadfile {file} { global basename namestack if [info exist basename] { set file [file join [file dirname $basename] $file] if [info exist namestack] { set namestack [concat [list $basename] $namestack] } else { set namestack [list $basename] } } if [file exist $file] { set f [open $file] set text [read $f] close $f set basename $file return $text } else { return "File not found\

File not found

File $file cannot be\ read" } } proc hyper_window {text} { if {[wm state .hyperleg] != "normal"} { wm deiconify .hyperleg } else { raise .hyperleg } HMreset_win .hyperleg.t HMparse_html $text "HMrender .hyperleg.t" } proc show_hyper {planchet x y} { global main_layer basename namestack catch { unset basename} catch {unset namestack} set value [$main_layer value [$planchet mapx $x] [$planchet mapy $y] -raw] if [string length $value] { hyper_window [loadfile $value] } else { hyper_window "\n\ No info avalable\n\ \n\

No info avalable

\n\ There is no information on this point\n\ \n\ " } } set planchet .map option add *font $gui_font frame .menu -relief raised -bd 2 menubutton .menu.file -text "File" -menu [set m .menu.file.m] menu $m #$m add command -label "Open..." -command add_layer #$m add command -label "Save..." -state disabled -command {save_layer [select_layer]} #$m add command -label "Close..." -state disabled -command {close_layer [select_layer]} #$m add separator $m add command -label "Print..." -command [list fgisPrintDialog $planchet] $m add separator $m add command -label "Quit" -command confirmExit menubutton .menu.layer -text "Layer" -menu [set m .menu.layer.m] menu $m $m add command -label "Show..." -command {show_layer [select_layer] } -state disabled $m add command -label "Look..." -command select_layers -state disabled #$m add command -label "Properties..." -command {edit_layer [select_layer]} -state disabled pack .menu.file .menu.layer -side left pack .menu -side top -expand y -fill x label .status -anchor w planchet $planchet -width 640 -height 480 -status .status toolbar .tool $planchet pack .tool -expand y -fill x pack $planchet pack .status -expand y -fill x button .tool.layer -text "?" -command add_layer pack .tool.layer -side left -before .tool.scale wm protocol . WM_DELETE_WINDOW confirmExit toplevel .hyperleg text .hyperleg.t -wrap word -width 80 -height 40 -yscrollcommand\ ".hyperleg.y set" scrollbar .hyperleg.y -orient vert -command ".hyperleg.t yview" grid .hyperleg.t .hyperleg.y -sticky news wm protocol .hyperleg WM_DELETE_WINDOW {wm withdraw .hyperleg} wm withdraw .hyperleg HMinit_win .hyperleg.t bind $planchet {show_hyper $planchet %x %y} # # Define callbacks for html library. Should be done here # when html library alderady loaded proc HMlink_callback {win href} { HMreset_win $win HMparse_html [loadfile $href ] "HMrender $win" } proc HMset_image {win handle src} { global basename if [info exist basename] { set src [file join [file dirname $basename] $src] } if [file exists $src] { set img [image create photo -file $src] HMgot_image $handle $img } } proc hyper_layer {file legend} { global main_layer if ![file exists $file] { if [file exists $file.epp] { append file .epp } else { tk_messageBox -message "File $filename doesn't exists" -type ok return } } if ![file exists $legend] { if [file exists $legend.leg] { append legend .leg } else { tk_messageBox -message "File $legend doesn't exists" -type ok return } } set main_layer [layer create raster -file $file -legfile $legend] } source [lindex $argv 0]