6 global basename namestack
7 if [info exist basename] {
8 set file [file join [file dirname $basename] $file]
9 if [info exist namestack] {
10 set namestack [concat [list $basename] $namestack]
12 set namestack [list $basename]
15 if [file exist $file] {
22 return "<HTML><HEAD><TITLE>File not found</TITLE></HEAD>\
23 <BODY><H1>File not found</H1>File $file cannot be\
27 proc hyper_window {text} {
28 if {[wm state .hyperleg] != "normal"} {
29 wm deiconify .hyperleg
33 HMreset_win .hyperleg.t
34 HMparse_html $text "HMrender .hyperleg.t"
37 proc show_hyper {planchet x y} {
38 global main_layer basename namestack
39 catch { unset basename}
40 catch {unset namestack}
41 set value [$main_layer value [$planchet mapx $x] [$planchet mapy $y] -raw]
42 if [string length $value] {
43 hyper_window [loadfile $value]
45 hyper_window "<HTML>\n\
46 <HEAD><TITLE>No info avalable</TITLE></HEAD>\n\
48 <H1>No info avalable</H1>\n\
49 There is no information on this point\n\
57 option add *font -cronyx-times-bold-r-normal--10-*
58 frame .menu -relief raised -bd 2
59 menubutton .menu.file -text "File" -menu [set m .menu.file.m]
61 #$m add command -label "Open..." -command add_layer
62 #$m add command -label "Save..." -state disabled -command {save_layer [select_layer]}
63 #$m add command -label "Close..." -state disabled -command {close_layer [select_layer]}
65 $m add command -label "Print..." -command [list fgisPrintDialog $planchet]
67 $m add command -label "Quit" -command confirmExit
68 menubutton .menu.layer -text "Layer" -menu [set m .menu.layer.m]
70 $m add command -label "Show..." -command {show_layer [select_layer] } -state disabled
71 $m add command -label "Look..." -command select_layers -state disabled
72 #$m add command -label "Properties..." -command {edit_layer [select_layer]} -state disabled
73 pack .menu.file .menu.layer -side left
74 pack .menu -side top -expand y -fill x
75 label .status -anchor w
76 planchet $planchet -width 640 -height 480 -status .status
77 toolbar .tool $planchet
78 pack .tool -expand y -fill x
80 pack .status -expand y -fill x
83 button .tool.layer -text "?" -command add_layer
84 pack .tool.layer -side left -before .tool.scale
85 wm protocol . WM_DELETE_WINDOW confirmExit
88 text .hyperleg.t -wrap word -width 80 -height 40 -yscrollcommand\
90 scrollbar .hyperleg.y -orient vert -command ".hyperleg.t yview"
91 grid .hyperleg.t .hyperleg.y -sticky news
92 wm protocol .hyperleg WM_DELETE_WINDOW {wm withdraw .hyperleg}
94 HMinit_win .hyperleg.t
95 bind $planchet <Button-1> {show_hyper $planchet %x %y}
98 # Define callbacks for html library. Should be done here
99 # when html library alderady loaded
100 proc HMlink_callback {win href} {
102 HMparse_html [loadfile $href ] "HMrender $win"
104 proc HMset_image {win handle src} {
106 if [info exist basename] {
107 set src [file join [file dirname $basename] $src]
109 if [file exists $src] {
110 set img [image create photo -file $src]
111 HMgot_image $handle $img
115 proc hyper_layer {file legend} {
117 if ![file exists $file] {
118 if [file exists $file.epp] {
121 tk_messageBox -message "File $filename doesn't exists" -type ok
125 if ![file exists $legend] {
126 if [file exists $legend.leg] {
129 tk_messageBox -message "File $legend doesn't exists" -type ok
133 set main_layer [layer create raster -file $file -legfile $legend]
136 source [lindex $argv 0]