#!/usr/bin/wish

# shc.tcl
# Graficke rozhrani SHC (shcnox).
# Miroslav Broz (miroslav.broz@email.cz), Jul 17th 2007

## global variables

set version "1. 5. 2017"

set LIBSRC "/usr/local/lib/shc"

set ndate_option { "0" "3" "7" }
set t_SEC_option { "prav slunen" "korigovan o dlku na SE" }
set gnomon_option { "polos" "gnmon" }
set t_prodluz_option { "ne" "k polosu" "k okraji" "oboj" }
set t_analema_option { "dn" "pro 12 h" "pro kadou rysku" }
set cast_analemy_option { "cel" "letn" "zimn" }

set font_rm "-*-helvetica-medium-r-*-*-12-*-*-*-*-*-*-2"
set font_bf "-*-helvetica-bold-r-*-*-12-*-*-*-*-*-*-2"
set font_tt "-*-fixed-medium-r-*-*-12-*-*-*-*-*-*-*"
set font_rm_small "-*-helvetica-medium-r-*-*-10-*-*-*-*-*-*-2"
set font_tt_small "-*-fixed-medium-r-*-*-10-*-*-*-*-*-*-*"
set font_title "-*-helvetica-bold-r-*-*-18-*-*-*-*-*-*-2"
set font $font_rm

set filetypes {
  {{SHC soubory} {.shc}}
  {{Vechny soubory} {*}}
}

# add also radiobuttons!
set data_file {
  "analema_prumet.dat"
  "azimut_rysky.dat"
  "ciselnik.dat"
  "datum_prumet.dat"
  "hodin_prumet.dat"
  "hodin_rysky.dat"
  "horiz_rysky.dat"
  "korekce.dat"
  "nodus.dat"
  "popisky.dat"
  "temporal_rysky.dat"
  "vychod_rysky.dat"
  "vyska_prumet.dat"
  "zapad_rysky.dat"
}

set sites_file "$LIBSRC/shc.dat"
set nSites 0

set image_file "$LIBSRC/shc.gif"
set image_xsize 320
set image_ysize 35

set freewrap 0
if { [ catch { set freewrap $::freewrap::progname } ] == 0 } {
  set freewrap 1
}

# encodings issues and platform dependent variables

if { $freewrap == 1 } {
  lappend auto_path /tcl/encoding
  encoding system /tcl/encoding/cp1250
  set readme_file "$LIBSRC/README.txt"
} else {
  if { $tcl_platform(platform) == "windows" } {
    encoding system cp1250
    set readme_file "$LIBSRC/README.txt"
  } else {
    if { [ package vcompare [ package provide Tcl ] 8.1 ] >= 0 } {
      encoding system iso8859-2
    }
    set readme_file "$LIBSRC/README"
  }
}

# WGnuplot 4 (PNG terminal) searches this path for fonts:
set env(GDFONTPATH) $LIBSRC
set env(GNUPLOT_DRIVER_DIR) $LIBSRC

#if ([ info exist env(SystemRoot) ]) { set env(GDFONTPATH) [ $env(SystemRoot) "/Fonts" ] } else { set env(GDFONTPATH) "c:/WINDOWS/Fonts" }

########################################################################

## encoding of source files!

proc enc { s } {
  global freewrap

  if { $freewrap == 1 } {
    return [ encoding convertfrom $s ]
  } else {
    if { [ package vcompare [ package provide Tcl ] 8.1 ] >= 0 } {
      return [ encoding convertfrom $s ]
    } else {
      return $s
    }
  }
}

########################################################################

## default config values

proc default_values {} {
  global \
    phi lambda az ht x1 y1 x2 y2 d_nodus dt dvz dd daz dht dah ndate gnomon t_horiz t_hodin t_SEC t_letni t_prodluz t_delkadne t_vychod t_zapad t_temporal t_analema cast_analemy t_azimut t_vyska t_date1 l_date1 \
    date time azimut vyska

  set phi "50:10:38"
  set lambda "15:50:21"
  set az 0
  set ht 0
  set x1 -100
  set y1 -150
  set x2 100
  set y2 10
  set d_nodus 40
  set dt "1:0:0"
  set dvz "1:0:0"
  set dd "0:10:0"
  set daz 10
  set dht 10
  set dah 2
  set ndate 7
  set gnomon 0
  set t_horiz 0
  set t_hodin 1
  set t_SEC 0
  set t_letni 0
  set t_prodluz 1
  set t_delkadne 0
  set t_vychod 0
  set t_zapad 0
  set t_analema 0
  set cast_analemy 0
  set t_temporal 0
  set t_date1 0
  set l_date1 0

# ??? current date and time
  set date [ clock format [ clock seconds ] -format "%Y/%m/%d" -gmt true ]
  set time [ clock format [ clock seconds ] -format "%H:%M:%S" -gmt true ]
  set azimut ""
  set vyska ""
}

########################################################################

## call shc program

proc shc {} {
  global LIBSRC tcl_platform \
    phi lambda az ht x1 y1 x2 y2 d_nodus dt dvz dd daz dht dah ndate gnomon t_horiz t_hodin t_SEC t_letni t_prodluz t_delkadne t_vychod t_zapad t_temporal t_analema cast_analemy t_azimut t_vyska t_date1 l_date1

  exec shcnox $phi $lambda $az $ht $x1 $y1 $x2 $y2 $d_nodus $dt $dvz $dd $daz $dht $dah $ndate $gnomon $t_horiz $t_hodin $t_SEC $t_letni $t_prodluz $t_delkadne $t_vychod $t_zapad $t_temporal $t_analema $cast_analemy $t_azimut $t_vyska $t_date1 $l_date1 > shc.out
  disp_data

  if { $tcl_platform(platform) == "unix" } {
# Linux version
    exec $LIBSRC/gnuplot $LIBSRC/shc.plt
    exec shc_eps.awk < shc.tmp > shc.eps
    exec shc_A4.awk < shc_A4.tmp > shc_A4.ps
    exec popisky.awk < popisky.dat > popisky.ps
    exec xterm -geometry 26x3 -e $LIBSRC/gnuplot $LIBSRC/shc.plt $LIBSRC/shc_x11.plt &
  } else {
# Windows version
    exec wgnuplot shc.plt
    exec gawk -f shc_eps.awk < shc.tmp > shc.eps
    exec gawk -f shc_A4.awk < shc_A4.tmp > shc_A4.ps
    exec gawk -f popisky.awk < popisky.dat > popisky.ps
    exec wgnuplot shc_win.plt &
  }
  exec zip -q shc.zip \
	analema.dat analema_prumet.dat \
	azimut_prumet.dat azimut_rysky.dat \
	ciselnik.dat ciselnik.plt \
	datum.dat datum_prumet.dat \
	hodin.dat hodin_okraj.dat hodin_prumet.dat hodin_rysky.dat \
	horiz.dat horiz_rysky.dat \
	korekce.dat nodus.dat \
	temporal_prumet.dat temporal_rysky.dat \
	vychod_prumet.dat vychod_rysky.dat \
	vyska_prumet.dat \
	zapad_prumet.dat zapad_rysky.dat \
	popisky.plt popisky.dat popisky.ps \
	shc.in shc.out shc.png shc.ps shc.eps shc_A4.ps &
}

########################################################################

## write config file

proc write_config { config_file } {
  global version \
    phi lambda az ht x1 y1 x2 y2 d_nodus dt dvz dd daz dht dah ndate gnomon t_horiz t_hodin t_SEC t_letni t_prodluz t_delkadne t_vychod t_zapad t_temporal t_analema cast_analemy t_azimut t_vyska t_date1 l_date1

  set id [ open $config_file w ]
  puts $id "# shc config file, vers. $version"
  puts $id "# parameters: phi lambda az ht x1 y1 x2 y2 d_nodus dt dvz dd daz dht dah ndate gnomon t_horiz t_hodin t_SEC t_letni t_prodluz t_delkadne t_vychod t_zapad t_temporal t_analema cast_analemy t_azimut t_vyska t_date1 l_date1"
  puts $id $phi
  puts $id $lambda
  puts $id "$az $ht"
  puts $id "$x1 $y1"
  puts $id "$x2 $y2"
  puts $id $d_nodus
  puts $id $dt
  puts $id $dvz
  puts $id $dd
  puts $id $daz
  puts $id $dht
  puts $id $dah
  puts $id $ndate
  puts $id $gnomon
  puts $id $t_horiz
  puts $id $t_hodin
  puts $id $t_SEC
  puts $id $t_letni
  puts $id $t_prodluz
  puts $id $t_delkadne
  puts $id $t_vychod
  puts $id $t_zapad
  puts $id $t_temporal
  puts $id $t_analema
  puts $id $cast_analemy
  puts $id $t_azimut
  puts $id $t_vyska
  puts $id $t_date1
  puts $id $l_date1
  close $id
  return
}

########################################################################

## read paramters from config file

proc read_config { config_file } {
  global phi lambda az ht x1 y1 x2 y2 d_nodus dt dvz dd daz dht dah ndate gnomon t_horiz t_hodin t_SEC t_letni t_prodluz t_delkadne t_vychod t_zapad t_temporal t_analema cast_analemy t_azimut t_vyska

  set id [ open $config_file r ]
# skip comments
  gets $id phi
  while { [ regexp "^#.*" $phi ] } {
    gets $id phi
  }
  gets $id lambda
  gets $id azht
  gets $id x1y1
  gets $id x2y2
  gets $id d_nodus
  gets $id dt
  gets $id dvz
  gets $id dd
  gets $id daz
  gets $id dht
  gets $id dah
  gets $id ndate
  gets $id gnomon
  gets $id t_horiz
  gets $id t_hodin
  gets $id t_SEC
  gets $id t_letni
  gets $id t_prodluz
  gets $id t_delkadne
  gets $id t_vychod
  gets $id t_zapad
  gets $id t_temporal
  gets $id t_analema
  gets $id cast_analemy
  gets $id t_azimut
  gets $id t_vyska
  gets $id t_date1
  gets $id l_date1
  close $id

  set l [ split $azht " " ]
  set az [ lindex $l 0 ]
  set ht [ lindex $l 1 ]
  set l [ split $x1y1 " " ]
  set x1 [ lindex $l 0 ]
  set y1 [ lindex $l 1 ]
  set l [ split $x2y2 " " ]
  set x2 [ lindex $l 0 ]
  set y2 [ lindex $l 1 ]
}

########################################################################

## save configuration to a file

proc save_config {} {
  global filetypes

  set filename [ tk_getSaveFile -filetypes $filetypes ]
  if { [ expr [ string length $filename ] > 0 ] } {
    if { ![ string match "*.shc" $filename ] } {
      set filename "$filename.shc"
    }
    write_config $filename
  }
}

########################################################################

## open an existing config file

proc open_config {} {
  global filetypes

  set filename [ tk_getOpenFile -filetypes $filetypes ]
  if { $filename != "" } {
    read_config $filename
  }
}

########################################################################

## about box

proc help {} {
  global readme_file version font contents

  if { [ catch { set id [ open $readme_file r ] } ] } {
    set contents [ enc "Nenalezen soubor $readme_file" ]
  } else {
    set contents [ read $id ]
    close $id
  }

  destroy .help
  toplevel .help
  wm title .help [ enc "SHC | Npovda" ]
  wm minsize .help 1 1

  frame .help.f1
  button .help.f1.b1 -text [ enc "Zavt" ] -font $font -command { destroy .help }
  button .help.f1.b2 -text [ enc "Tisk" ] -font $font -command { data_print $readme_file }
  frame .help.f2
  scrollbar .help.f2.s1 -command ".help.f2.t1 yview"
  text .help.f2.t1 -font $font -width 72 -yscrollcommand ".help.f2.s1 set" -wrap word

  pack .help.f1.b1 -side left
  pack .help.f1.b2 -side left
  pack .help.f1 -fill x -expand 1
  pack .help.f2.s1 -side right -fill y
  pack .help.f2.t1 -side top -expand 1 -fill both
  pack .help.f2 -side top -expand 1 -fill both

  bind .help <KeyPress-Return> { destroy .help }
  bind .help <Control-KeyPress-q> { destroy .help }
  bind .help <Control-KeyPress-x> { kill_gnuplot; quit }

  focus .help.f2.t1
  bind .help.f2.t1 <space> [ bind Text <Next> ]
  bind .help.f2.t1 <Delete> [ bind Text <Prior> ]
  bind .help.f2.t1 <BackSpace> [ bind Text <Prior> ]

  .help.f2.t1 insert 0.0 [ enc "O aplikaci SHC\n\nmiroslav.broz@email.cz\nhttp://www.astrohk.cz\nverze $version\n\n" ]
  .help.f2.t1 insert end $contents
  .help.f2.t1 configure -state disabled

}

########################################################################

## display all data files

proc disp_data {} {
  global tcl_platform \
    font font_tt font_bf data_file current_data_file current_data_menu

  destroy .data
  toplevel .data
  wm title .data [ enc "SHC | Datov soubory" ]

  set current_data_label ""

  frame .data.f1
  button .data.f1.b1 -text [ enc "Zavt" ] -font $font -command { destroy .data }
  button .data.f1.b2 -text [ enc "Uloit jako" ] -font $font -command { data_save $current_data_file }
  button .data.f1.b3 -text [ enc "Tisk" ] -font $font -command { data_print $current_data_file }

# see data_file above
  menubutton .data.f1.mb1 -textvariable current_data_label -menu .data.f1.mb1.m1 -relief raised -font $font -width 24
  menu .data.f1.mb1.m1 
  .data.f1.mb1.m1 add radiobutton -label [ lindex $data_file 0 ]  -command { data_read 0 } -font $font
  .data.f1.mb1.m1 add radiobutton -label [ lindex $data_file 1 ]  -command { data_read 1 } -font $font
  .data.f1.mb1.m1 add radiobutton -label [ lindex $data_file 2 ]  -command { data_read 2 } -font $font
  .data.f1.mb1.m1 add radiobutton -label [ lindex $data_file 3 ]  -command { data_read 3 } -font $font
  .data.f1.mb1.m1 add radiobutton -label [ lindex $data_file 4 ]  -command { data_read 4 } -font $font
  .data.f1.mb1.m1 add radiobutton -label [ lindex $data_file 5 ]  -command { data_read 5 } -font $font
  .data.f1.mb1.m1 add radiobutton -label [ lindex $data_file 6 ]  -command { data_read 6 } -font $font
  .data.f1.mb1.m1 add radiobutton -label [ lindex $data_file 7 ]  -command { data_read 7 } -font $font
  .data.f1.mb1.m1 add radiobutton -label [ lindex $data_file 8 ]  -command { data_read 8 } -font $font
  .data.f1.mb1.m1 add radiobutton -label [ lindex $data_file 9 ]  -command { data_read 9 } -font $font
  .data.f1.mb1.m1 add radiobutton -label [ lindex $data_file 10 ]  -command { data_read 10 } -font $font
  .data.f1.mb1.m1 add radiobutton -label [ lindex $data_file 11 ]  -command { data_read 11 } -font $font
  .data.f1.mb1.m1 add radiobutton -label [ lindex $data_file 12 ]  -command { data_read 12 } -font $font
  .data.f1.mb1.m1 add radiobutton -label [ lindex $data_file 13 ]  -command { data_read 13 } -font $font

  menubutton .data.f1.mb2 -text [ enc "PostScriptov obrzky" ] -menu .data.f1.mb2.m2 -relief raised -font $font -width 24
  menu .data.f1.mb2.m2 
  .data.f1.mb2.m2 add radiobutton -label [ enc "PS schma" ] -font $font  -command {
    if { $tcl_platform(platform) == "unix" } {
      exec gv shc.ps &
    } else {
      data_copy "shc.ps" ".ps" { {{PostScriptov obrzky} {.ps}} {{Vechny soubory} {*}} }
    }
  }
  .data.f1.mb2.m2 add radiobutton -label [ enc "EPS v mtku 1:1" ] -font $font  -command {
    data_copy "shc.eps" ".eps" { {{EPS obrzky} {.eps}} {{Vechny soubory} {*}} }
  }
  .data.f1.mb2.m2 add radiobutton -label [ enc "PS A4 (vcestrnkov)" ] -font $font  -command {
    if { $tcl_platform(platform) == "unix" } {
      exec gv shc_A4.ps &
    } else {
      data_copy "shc_A4.ps" ".ps" { {{PostScriptov soubory} {.ps}} {{Vechny soubory} {*}} }
    }
  }
  .data.f1.mb2.m2 add radiobutton -label [ enc "slice popisk rysek" ] -font $font  -command {
    if { $tcl_platform(platform) == "unix" } {
      exec gv popisky.ps &
    } else {
      data_copy "popisky.ps" ".ps" { {{PostScriptov soubory} {.ps}} {{Vechny soubory} {*}} }
    }
  }

  button .data.f1.b4 -text "ZIP archiv" -font $font -command { data_copy "shc.zip" ".zip" \
    { {{ZIP soubory} {.zip}} {{Vechny soubory} {*}} }
  }

  pack .data.f1.b1 -side left
  pack .data.f1.b2 -side left
  pack .data.f1.b3 -side left
  pack .data.f1.mb1 -side left
  pack .data.f1.mb2 -side left
  pack .data.f1.b4 -side left
  pack .data.f1 -fill x

  frame .data.f3
  frame .data.f3.f1
  scrollbar .data.f3.f1.s1 -orient vertical -command ".data.f3.f1.t1 yview"
  scrollbar .data.f3.s2 -orient horizontal -command ".data.f3.f1.t1 xview"
  text .data.f3.f1.t1 -font $font_tt -yscrollcommand ".data.f3.f1.s1 set" -xscrollcommand ".data.f3.s2 set" -wrap none

  pack .data.f3.f1.s1 -side right -fill y -expand 0
  pack .data.f3.f1.t1 -side top -expand 1 -fill both
  pack .data.f3.s2 -side bottom -fill x
  pack .data.f3.f1 -fill both -expand 1
  pack .data.f3 -fill both -expand 1

  focus .data.f3.f1.t1
  bind .data.f3.f1.t1 <space> [ bind Text <Next> ]
  bind .data.f3.f1.t1 <Delete> [ bind Text <Prior> ]
  bind .data.f3.f1.t1 <BackSpace> [ bind Text <Prior> ]

  bind .data <KeyPress-Return> { destroy .help }
  bind .data <Control-KeyPress-q> { destroy .data }
  bind .data <Control-KeyPress-x> { kill_gnuplot; quit }

  bind .data <KeyPress-F1> { help }
  bind .data <Control-KeyPress-n> {
    incr current_data_menu
    if { [ expr $current_data_menu > ( [ llength $data_file ] ) ] } {
      set current_data_menu 1
    }
    .data.f1.mb1.m1 invoke $current_data_menu
  }
  bind .data <Control-KeyPress-p> {
    incr current_data_menu -1
    if { [ expr $current_data_menu < 1 ] } {
      set current_data_menu [ llength $data_file ]
    }
    .data.f1.mb1.m1 invoke $current_data_menu
  }
  bind .data.f1.b2 <Control-KeyPress-s> { data_save $current_data_file }
  bind .data.f1.b2 <KeyPress-F2> { data_save $current_data_file }
  bind .data <Control-KeyPress-t> { data_print $current_data_file }
  bind .data.f3.f1.t1 <Control-KeyPress-t> { data_print $current_data_file }

  set current_data_menu 6
  .data.f1.mb1.m1 invoke $current_data_menu
}

########################################################################

## read *.dat file

proc data_read { no } {
  global data_file current_data_file current_data_label

  set current_data_file [ lindex $data_file $no ]
  set current_data_label [ enc "Soubor $current_data_file" ]
  if { [ catch { set id [ open $current_data_file r ] } ] } {
    set contents [ enc "Chyba pi otvrn souboru `$current_data_file'." ]
  } else {
    set contents [ read $id ]
    close $id
  }

  .data.f3.f1.t1 delete 0.0 end
  .data.f3.f1.t1 insert 0.0 $contents
}

########################################################################

## save *.dat file

proc data_save { filename } {

  set contents [ .data.f3.f1.t1 get 0.0 end ]

  set filetypes {
    {{Datov soubory} {.dat}}
    {{Vechny soubory} {*}}
  }

  set filename [ tk_getSaveFile -initialfile $filename -filetypes $filetypes ]

  if { $filename != "" } {
    if { ![ string match "*.dat" $filename ] } {
      set filename "$filename.dat"
    }
    set id [ open $filename w ]
    puts $id $contents
    close $id
  }
}

########################################################################

##  save as output file

proc data_copy { filename extension filetypes } {
 
  set filename_save [ tk_getSaveFile -initialfile $filename -filetypes $filetypes -defaultextension $extension ]

  if { $filename_save != "" } {
    if { [ string compare $filename_save $filename ] != 0} {
      set id1 [ open $filename r ]
      set id2 [ open $filename_save w ]
      fconfigure $id1 -translation binary
      fconfigure $id2 -translation binary
      fcopy $id1 $id2
      close $id1
      close $id2
    }
  }
}

########################################################################

##  print text file

proc data_print { filename } {
  global font printcmd tcl_platform

  if { $tcl_platform(platform) == "windows" } {
    data_print_windows $filename
    return
  }

  destroy .print
  toplevel .print
  wm title .print [ enc "SHC | Tisk souboru" ]

  set printcmd "mpage -1 $filename | lpr"
  entry .print.e1 -textvariable printcmd -width 48 -font $font
  button .print.b1 -text [ enc "Tisk" ] -font $font -command { cmd $printcmd; destroy .print }
  button .print.b2 -text [ enc "Zavt" ] -font $font -command { destroy .print }

  pack .print.e1 -side left -fill x -expand 1
  pack .print.b1 -side left
  pack .print.b2 -side left

  bind .print <Control-KeyPress-q> { destroy .print }
  bind .print <KeyPress-Escape> { destroy .print }
  bind .print <KeyPress-Return> { cmd $printcmd; destroy .print }
}

########################################################################

## print txt file with windows' notepad

proc data_print_windows { filename } {

  exec notepad /p $filename &
  return
}

########################################################################

## load sites from file

proc loadsites { file } {
  global Sitelines nSites iSite

  if { $nSites == 0 } {
    set id [ open $file ]
    set i 0
    while { ! [ eof $id ] } {
      gets $id line
      set Sitelines($i) $line
      incr i
    }
    set nSites [ expr $i - 1 ]
    close $id
    set iSite 0
  }
}

########################################################################

## set site by its name

proc setsitebyname { Site } {
  global Sitelines nSites
  set i 0
  while { $i < $nSites && [ string first $Site $Sitelines($i) ] < 0 } { incr i }
  if { [ string first $Site $Sitelines($i) ] > -1 } {
    setsitebyindex $i
  }
}

########################################################################

## set site by the menu index

proc setsitebyindex { isite } {
  global phi lambda Sitelines iSite
  set iSite $isite
  set l [ split $Sitelines($iSite) "	" ]
  set phi [ lindex $l 1 ]
  set lambda [ lindex $l 2 ]
}

########################################################################

## search site by a substring

proc SiteSearch { search } {
  global Sitelines nSites iSite

  set searchstr [ strcon $search ] 
  set i 0
  set j [ expr $iSite + 1 ]
  if { $j >= $nSites } { set j 0 }
  while { $i < $nSites && [ string first $searchstr [ strcon [ lindex [ split $Sitelines($j) "	" ] 0 ] ] ] < 0 } {
    incr i
    incr j
    if { $j >= $nSites } { set j 0 }
  }
  if { $i < $nSites } {
    setsitebyindex $j
    .site.list selection clear 0 $nSites
    .site.list selection set $j
    .site.list see $j
  }
}

proc strcon { s } {
  set s_ [ string tolower $s ]
  regsub -all " +" $s_ "" s__
  return $s__
}

########################################################################

## site selection dialog

proc SiteSelection {} {
  global Sitelines nSites iSite site_ysize font font_rm_small

  destroy .site
  toplevel .site
  wm title .site [ enc "SHC | vbr stanovit" ]

  frame .site.f0
  label .site.l0 -text [ enc "stanovit (stt, jin jmno) (zem. ka, dlka, nadm. vka)" ] -font $font
  frame .site.f1
  frame .site.f2
  scrollbar .site.sb1 -orient vertical -command ".site.list yview"
  scrollbar .site.sb2 -orient horizontal -command ".site.list xview"
  set site_ysize 30
  listbox .site.list -yscrollcommand ".site.sb1 set" -xscrollcommand ".site.sb2 set" -selectmode single -width 35 -height $site_ysize -font $font_rm_small
  for { set i 0 } { $i < $nSites } { incr i } {
    set l [ split $Sitelines($i) "	" ]
    set name [ lindex $l 0 ]
    set lat [ lindex $l 1 ]
    set lng [ lindex $l 2 ]
    set alt [ lindex $l 3 ]
    .site.list insert end "$name ($lat, $lng, $alt)"
  }
  .site.list see $iSite
  .site.list selection set $iSite
  entry .site.e1 -textvariable searchSite -width 15 -font $font
  button .site.b1 -text [ enc "Hledat" ] -command { SiteSearch $searchSite } -font $font
  button .site.b2 -text [ enc "Zavt" ] -command { destroy .site } -font $font

  pack .site.l0 -in .site.f0 -side left
  pack .site.f0 -side top -fill x
  pack .site.e1 -in .site.f2 -side left -fill x -expand 1
  pack .site.b1 -in .site.f2 -side left
  pack .site.b2 -in .site.f2 -side left
  pack .site.f2 -side bottom -fill x -expand 0
  pack .site.sb2 -side bottom -fill x -expand 0
  pack .site.sb1 -in .site.f1 -side right -fill y -expand 0
  pack .site.list -in .site.f1 -side top -fill both -expand 1
  pack .site.f1 -fill both -expand 1

  bind .site <Key-Up> {
    .site.list selection clear $iSite
    incr iSite -1
    if { [ expr $iSite < 0 ] } { set iSite 0 }
    .site.list see $iSite
    .site.list selection set $iSite
    setsitebyindex $iSite
  }

  bind .site <Key-Down> {
    .site.list selection clear $iSite
    incr iSite
    if { [ expr $iSite > $nSites ] } { set iSite $nSites }
    .site.list see $iSite
    .site.list selection set $iSite
    setsitebyindex $iSite
  }

  bind .site <Key-Prior> {
    .site.list selection clear $iSite
    incr iSite -$site_ysize
    if { [ expr $iSite < 0 ] } { set iSite 0 }
    .site.list see $iSite
    .site.list selection set $iSite
    setsitebyindex $iSite
  }

  bind .site <Key-Next> {
    .site.list selection clear $iSite
    incr iSite $site_ysize
    if { [ expr $iSite > $nSites ] } { set iSite [ expr $nSites - 1 ] }
    .site.list see $iSite
    .site.list selection set $iSite
    setsitebyindex $iSite
  }

  bind .site <Control-Key-Home> {
    .site.list selection clear $iSite
    set iSite 0
    .site.list see $iSite
    .site.list selection set $iSite
    setsitebyindex $iSite
  }

  bind .site <Control-Key-End> {
    .site.list selection clear $iSite
    set iSite [ expr $nSites - 1 ]
    .site.list see $iSite
    .site.list selection set $iSite
    setsitebyindex $iSite
  }

  bind .site <Key-Return> { setsitebyindex $iSite }

  bind .site.list <Button-1> {
    set iSite [ .site.list nearest %y ]
    setsitebyindex $iSite
  }

  bind .site.e1 <Key-Return> { SiteSearch $searchSite }

  bind .site <Control-Key-q> { destroy .site }
  bind .site <Control-Key-x> { kill_gnuplot; quit
  }
}

########################################################################

## exec command string

proc cmd { cmd } {
  eval exec $cmd
}

########################################################################

## quit

proc quit {} {
  exit 0
}

########################################################################

proc kill_gnuplot {} {
  global tcl_platform

  if { $tcl_platform(platform) == "unix" } {
    catch [ exec killall gnuplot ]
  }
}

########################################################################

## call sunah program

proc sunah {} {
  global \
    phi lambda date time azimut vyska

  set dt_sunah "1:0:0"
  set nsteps 1
  set precession 1
  set nutation 0
  set refraction 0

  set id [ open "sunah.in" w ]
  puts $id $phi
  puts $id $lambda
  puts $id $date
  puts $id $time
  puts $id $dt_sunah
  puts $id $nsteps
  puts $id $precession
  puts $id $nutation
  puts $id $refraction
  puts $id ""
  close $id

  exec sunah < sunah.in > sunah.out

  set id [ open "sunah.out" r ]
  gets $id s
  while { [ regexp "^#.*" $s ] } {
    gets $id s
  }
  close $id

  regsub -all " +" $s " " s
  set l [ split $s " " ]
  set azimut [ format "%6.2f" [ expr [ lindex $l 7 ] + 0 ] ]
  set vyska  [ format "%6.2f" [ expr [ lindex $l 8 ] + 0 ] ]
}

proc sunah_input {} {
  global \
    phi lambda date time azimut vyska \
    font font_bf

  destroy .sunah
  toplevel .sunah
  wm title .sunah [ enc "SHC | Efemerida slunce" ]

  frame .sunah.f1
  label .sunah.date_label -text [ enc "datum \[RRRR/MM/DD\]" ] -font $font
  entry .sunah.date -textvariable date -font $font -width 10

  frame .sunah.f2
  label .sunah.time_label -text [ enc "svtov as \[HH:MM:SS\]" ] -font $font
  entry .sunah.time -textvariable time -font $font -width 10

  frame .sunah.f5

  frame .sunah.f3
  label .sunah.azimut_label -text [ enc "azimut slunce \[stupn\]:" ] -font $font
  label .sunah.azimut -textvariable azimut -font $font -width 8

  frame .sunah.f4
  label .sunah.vyska_label -text [ enc "vka \[stupn\]:" ] -font $font
  label .sunah.vyska -textvariable vyska -font $font -width 8

  frame .sunah.f6

  frame .sunah.f8
  button .sunah.run -text [ enc "Spotat efemeridu" ] -font $font -command { sunah }
  button .sunah.close -text [ enc "Zavt" ] -font $font -command { destroy .sunah }

  pack .sunah.date -side right -in .sunah.f1
  pack .sunah.date_label -side right -in .sunah.f1
  pack .sunah.f1 -fill x -in .sunah

  pack .sunah.time -side right -in .sunah.f2
  pack .sunah.time_label -side right -in .sunah.f2
  pack .sunah.f2 -fill x -in .sunah

  pack .sunah.f5 -pady 1

  pack .sunah.azimut -side right -in .sunah.f3
  pack .sunah.azimut_label -side right -in .sunah.f3
  pack .sunah.f3 -fill x -in .sunah

  pack .sunah.vyska -side right -in .sunah.f4
  pack .sunah.vyska_label -side right -in .sunah.f4
  pack .sunah.f4 -fill x -in .sunah

  pack .sunah.f6 -pady 1

  pack .sunah.run -side left -in .sunah.f8
  pack .sunah.close -side right -in .sunah.f8
  pack .sunah.f8 -fill x -in .sunah

  bind .sunah <Control-KeyPress-Return> { sunah }
  bind .sunah.run <ButtonRelease-1> { sunah }
  bind .sunah.run <Key-Return> { sunah }

  bind .sunah <Control-KeyPress-q> { destroy .sunah }
  bind .sunah <Control-KeyPress-x> { kill_gnuplot; quit }
}

########################################################################

## main

default_values

########################################################################

## widgets

wm title . [ enc "SHC" ]

frame .fleft

frame .f0
button .reset -text [ enc "Nov" ] -font $font
button .open -text [ enc "Otevt" ] -font $font
button .save -text [ enc "Uloit" ] -font $font
button .help_button -text [ enc "Npovda" ] -font $font

frame .f21

frame .f1
label .phi_label -text [ enc "zempisn ka stanovit \[DD:MM:SS\]" ] -font $font
entry .phi -textvariable phi -width 10 -font $font

frame .f2
label .lambda_label -text [ enc "zempisn dlka \[+HH:MM:SS, kladn na V\]" ] -font $font
entry .lambda -textvariable lambda -width 10 -font $font

frame .f14
button .siteselection -text [ enc "Vbr stanovit podle jmna" ] -font $font -command { loadsites $sites_file; SiteSelection }

button .sunah_button -text [ enc "Efemerida slunce" ] -font $font -command { sunah_input }

frame .f3
label .azht_label -text [ enc "azimut a vka normly ke stn \[stupn\]" ] -font $font
entry .az -textvariable az -width 5 -font $font
entry .ht -textvariable ht -width 5 -font $font

frame .f4
label .x1y1_label -text [ enc "lev doln roh selnku x, y \[cm\]" ] -font $font
entry .x1 -textvariable x1 -width 5 -font $font
entry .y1 -textvariable y1 -width 5 -font $font

frame .f5
label .x2y2_label -text [ enc "prav horn roh x, y \[cm\]" ] -font $font
entry .x2 -textvariable x2 -width 5 -font $font
entry .y2 -textvariable y2 -width 5 -font $font

frame .f6
label .d_nodus_label -text [ enc "vzdlenost nodu od paty ukazatele \[cm\] *" ] -font $font
entry .d_nodus -textvariable d_nodus -width 5 -font $font

label .d_nodus_note_label -text [ enc "* tj. dlka ukazatele; pro gnmon vzdlenost od roviny selnku" ] -justify left -font $font_rm_small

frame .f7
label .dt_label -text [ enc "interval hodinovch rysek \[HH:MM:SS\]" ] -font $font
entry .dt -textvariable dt -width 10 -font $font

frame .f16
label .dvz_label -text [ enc "interval hodin od V/Z slunce \[HH:MM:SS\]" ] -font $font
entry .dvz -textvariable dvz -width 10 -font $font

frame .f8
label .dd_label -text [ enc "interval datovch kivek \[HH:MM:SS\]" ] -font $font
entry .dd -textvariable dd -width 10 -font $font

frame .f26
label .daz_label -text [ enc "kroky: azimutu \[stupn\]" ] -font $font
entry .daz -textvariable daz -width 3 -font $font
label .dht_label -text [ enc "vky" ] -font $font
entry .dht -textvariable dht -width 3 -font $font
label .dah_label -text [ enc "v. krunic" ] -font $font
entry .dah -textvariable dah -width 3 -font $font

frame .f24

frame .f13
button .run -text [ enc "Spotat a zobrazit hodiny" ] -font $font
button .quit -text [ enc "Konec" ] -font $font

frame .fspace
frame .fright

frame .f28
label .title -text [ enc "Nvrh selnku slunench hodin" ] -font $font_title

canvas .c1 -width $image_xsize -height $image_ysize
if { [ catch { image create photo .i1 -file $image_file -width $image_xsize -height $image_ysize } ] == 0 } then {
  .c1 create image [ expr $image_xsize / 2] [ expr $image_ysize / 2] -image .i1
}

frame .f9
label .ndate_label -text [ enc "poet datovch kivek:" ] -font $font
for { set i 0 } { $i < [ llength $ndate_option ] } { incr i } {
  set j [ lindex $ndate_option $i ]
  label .ndate_label_$j -text $j -font $font
  radiobutton .ndate_button_$j -variable ndate -value "$j"
}
.ndate_button_$ndate invoke

frame .f10
label .gnomon_label -text [ enc "typ ukazatele:" ] -font $font
for { set i 0 } { $i < [ llength $gnomon_option ] } { incr i } {
  label .gnomon_label_$i -text [ enc [ lindex $gnomon_option $i ] ] -font $font
  radiobutton .gnomon_button_$i -variable gnomon -value $i
}
.gnomon_button_$gnomon invoke

frame .f22
label .t_horiz_label -text [ enc "neskuten ry pod horizontem" ] -font $font
checkbutton .t_horiz -variable t_horiz

frame .f11
label .t_SEC_label -text [ enc "as:" ] -font $font
for { set i 0 } { $i < [ llength $t_SEC_option ] } { incr i } {
  label .t_SEC_label_$i -text [ enc [ lindex $t_SEC_option $i ] ] -font $font
  radiobutton .t_SEC_button_$i -variable t_SEC -value "$i"
}
.t_SEC_button_$t_SEC invoke

frame .f12
label .t_letni_label -text [ enc "selnk pro letn as" ] -font $font
checkbutton .t_letni -variable t_letni

frame .f23
label .t_prodluz_label -text [ enc "protaen:" ] -font $font
for { set i 0 } { $i < [ llength $t_prodluz_option ] } { incr i } {
  label .t_prodluz_label_$i -text [ enc [ lindex $t_prodluz_option $i ] ] -font $font
  radiobutton .t_prodluz_button_$i -variable t_prodluz -value "$i"
}
.t_prodluz_button_$t_prodluz invoke

frame .f20
label .t_delkadne_label -text [ enc "datov kivky pro celoseln dlky trvn dne" ] -font $font
checkbutton .t_delkadne -variable t_delkadne

frame .f17
label .rysky_label -text [ enc "rysky:" ] -font $font
label .t_hodin_label -text [ enc "hodinov" ] -font $font
checkbutton .t_hodin -variable t_hodin

label .t_temporal_label -text [ enc "temporln" ] -font $font
checkbutton .t_temporal -variable t_temporal

frame .f15
label .t_vychod_label -text [ enc "od V slunce" ] -font $font
checkbutton .t_vychod -variable t_vychod
label .t_zapad_label -text [ enc "od Z pedchozho dne" ] -font $font
checkbutton .t_zapad -variable t_zapad

frame .f18
label .t_analema_label -text [ enc "analema:" ] -font $font
for { set i 0 } { $i < [ llength $t_analema_option ] } { incr i } {
  label .t_analema_label_$i -text [ enc [ lindex $t_analema_option $i ] ] -font $font
  radiobutton .t_analema_button_$i -variable t_analema -value "$i"
}
.t_analema_button_$t_analema invoke

frame .f19
label .cast_analemy_label -text [ enc "st:" ] -font $font
for { set i 0 } { $i < [ llength $cast_analemy_option ] } { incr i } {
  label .cast_analemy_label_$i -text [ enc [ lindex $cast_analemy_option $i ] ] -font $font
  radiobutton .cast_analemy_button_$i -variable cast_analemy -value "$i"
}
.cast_analemy_button_$cast_analemy invoke

frame .f27
label .t_azimut_label -text [ enc "azimutln seky" ] -font $font
checkbutton .t_azimut -variable t_azimut
label .t_vyska_label -text [ enc "vkov kivky" ] -font $font
checkbutton .t_vyska -variable t_vyska

frame .f29
checkbutton .t_date1 -variable t_date1
label .t_date1_label -text [ enc "dodaten datov kivka - ekliptikln dlka \[stupe\]" ] -font $font
entry .l_date1 -textvariable l_date1 -width 3 -font $font

frame .f25

## pack it!

pack .reset -side left -in .f0
pack .open -side left -in .f0
pack .save -side left -in .f0
pack .help_button -side right -in .f0
pack .f0 -fill both -in .fleft

pack .f21 -pady 2 -fill y -expand 1 -in .fleft

pack .phi -side right -in .f1
pack .phi_label -side right -in .f1
pack .f1 -fill x -in .fleft

pack .lambda -side right -in .f2
pack .lambda_label -side right -in .f2
pack .f2 -fill x -in .fleft

pack .siteselection -side left -in .f14
pack .sunah_button -side right -in .f14
pack .f14 -fill both -pady 3 -in .fleft -expand 1

pack .ht -side right -in .f3
pack .az -side right -in .f3
pack .azht_label -side right -in .f3
pack .f3 -fill x -in .fleft

pack .y1 -side right -in .f4
pack .x1 -side right -in .f4
pack .x1y1_label -side right -in .f4
pack .f4 -fill x -in .fleft

pack .y2 -side right -in .f5
pack .x2 -side right -in .f5
pack .x2y2_label -side right -in .f5
pack .f5 -fill x -in .fleft

pack .d_nodus -side right -in .f6
pack .d_nodus_label -side right -in .f6
pack .f6 -fill x -in .fleft
pack .d_nodus_note_label -in .fleft

pack .dt -side right -in .f7
pack .dt_label -side right -in .f7
pack .f7 -fill x -in .fleft

pack .dvz -side right -in .f16
pack .dvz_label -side right -in .f16
pack .f16 -fill x -in .fleft

pack .dd -side right -in .f8
pack .dd_label -side right -in .f8
pack .f8 -fill x -in .fleft

pack .dah -side right -in .f26
pack .dah_label -side right -in .f26
pack .dht -side right -in .f26
pack .dht_label -side right -in .f26
pack .daz -side right -in .f26
pack .daz_label -side right -in .f26
pack .f26 -fill x -in .fleft

pack .f24 -in .fleft -pady 2 -fill y -expand 1

pack .run -side left -in .f13
pack .quit -side right -in .f13
pack .f13 -fill x -in .fleft

pack .fleft -side left -fill y -expand 1
pack .fspace -padx 5 -side left

pack .f28 -pady 1 -fill y -expand 1 -in .fright
pack .title -in .fright -pady 0
pack .c1 -in .fright -pady 1 -expand 1

pack .ndate_label -side left -in .f9
for { set i 0 } { $i < [ llength $ndate_option ] } { incr i } {
  set j [ lindex $ndate_option $i ]
  pack .ndate_label_$j -side left -in .f9
  pack .ndate_button_$j -side left -in .f9
}
pack .f9 -in .fright

pack .gnomon_label -side left -in .f10
for { set i 0 } { $i < [ llength $gnomon_option ] } { incr i } {
  pack .gnomon_label_$i -side left -in .f10
  pack .gnomon_button_$i -side left -in .f10
}
pack .f10 -in .fright

pack .t_horiz_label -side left -in .f22
pack .t_horiz -side left -in .f22
pack .f22 -in .fright

pack .t_SEC_label -side left -in .f11
for { set i 0 } { $i < [ llength $t_SEC_option ] } { incr i } {
  pack .t_SEC_label_$i -side left -in .f11
  pack .t_SEC_button_$i -side left -in .f11
}
pack .f11 -in .fright

pack .t_letni_label -side left -in .f12
pack .t_letni -side left -in .f12
pack .f12 -in .fright

pack .t_prodluz_label -side left -in .f23
for { set i 0 } { $i < [ llength $t_prodluz_option ] } { incr i } {
  pack .t_prodluz_label_$i -side left -in .f23
  pack .t_prodluz_button_$i -side left -in .f23
}
pack .f23 -in .fright

pack .t_delkadne_label -side left -in .f20
pack .t_delkadne -side left -in .f20
pack .f20 -in .fright

pack .rysky_label -side left -in .f17
pack .t_hodin_label -side left -in .f17
pack .t_hodin -side left -in .f17
pack .t_temporal_label -side left -in .f17
pack .t_temporal -side left -in .f17
pack .f17 -in .fright

pack .t_vychod_label -side left -in .f15
pack .t_vychod -side left -in .f15
pack .t_zapad_label -side left -in .f15
pack .t_zapad -side left -in .f15
pack .f15 -in .fright

pack .t_analema_label -side left -in .f18
for { set i 0 } { $i < [ llength $t_analema_option ] } { incr i } {
  pack .t_analema_label_$i -side left -in .f18
  pack .t_analema_button_$i -side left -in .f18
}
pack .f18 -in .fright

pack .cast_analemy_label -side left -in .f19
for { set i 0 } { $i < [ llength $cast_analemy_option ] } { incr i } {
  pack .cast_analemy_label_$i -side left -in .f19
  pack .cast_analemy_button_$i -side left -in .f19
}
pack .f19 -in .fright

pack .t_azimut_label -side left -in .f27
pack .t_azimut -side left -in .f27
pack .t_vyska_label -side left -in .f27
pack .t_vyska -side left -in .f27
pack .f27 -in .fright

pack .t_date1 -side left -in .f29
pack .t_date1_label -side left -in .f29
pack .l_date1 -side left -in .f29
pack .f29 -in .fright

pack .f25 -in .fright -expand 1

pack .fright -side left -fill y -expand 1

## bindigs

bind . <Control-KeyPress-Return> { shc }
bind .run <ButtonRelease-1> { shc }
bind .run <Key-Return> { shc }

bind . <Control-KeyPress-n> { default_values }
bind .reset <ButtonRelease-1> { default_values }
bind .reset <Key-Return> { default_values }

bind . <Control-KeyPress-o> { open_config }
bind . <KeyPress-F3> { open_config }
bind .open <ButtonRelease-1> { open_config }
bind .open <Key-Return> { open_config }

bind . <Control-KeyPress-s> { save_config }
bind . <KeyPress-F2> { save_config }
bind .save <ButtonRelease-1> { save_config }
bind .save <Key-Return> { save_config }

bind . <Control-KeyPress-q> { quit }
bind . <Control-KeyPress-x> { kill_gnuplot; quit }
bind .quit <ButtonRelease-1> { kill_gnuplot; quit }
bind .quit <Key-Return> { quit }

bind . <KeyPress-F1> { help }
bind .help_button <KeyPress-Return> { help }
bind .help_button <ButtonRelease-1> { help }

bind . <Control-KeyPress-e> { sunah_input }

########################################################################

