#!/bin/sh
# the next line restarts with wish \
exec wish "$0" "$@"
##
## xtherion --
##
##     Therion user interface.
##
## Copyright (C) 2002 Stacho Mudrak
## 
##
## -------------------------------------------------------------------- 
## 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 of the License, or
## 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
## -------------------------------------------------------------------- 








set xth(debug) 0
set xth(about,ver) 0.3.7







set xth(about,nvr) {}
set xth(about,session) [list]

proc xth_ivc {} {
  global xth
  set newver {}
  catch {
    
    package require http 2.0
    
    # proxy configuration
    set httpproxy {}
    global tcl_platform env
    set winregkey [join {
         HKEY_CURRENT_USER
         Software Microsoft Windows
         CurrentVersion "Internet Settings"
    } \\]
    if {[info exists env(http_proxy)]} {
        set httpproxy $env(http_proxy)
    } else {
        if {$tcl_platform(platform) == "windows"} {
            package require registry 1.0
            array set reg {ProxyEnable 0 ProxyServer "" ProxyOverride {}}
            catch {
                set reg(ProxyEnable) [registry get $winregkey "ProxyEnable"]
                set reg(ProxyServer) [registry get $winregkey "ProxyServer"]
            }
            if {![string is bool $reg(ProxyEnable)]} {
                set reg(ProxyEnable) 0
            }
            if {$reg(ProxyEnable)} {
               if { [string first ";" $reg(ProxyServer)] == -1 } {
                   set httpproxy $reg(ProxyServer)
               } else {
                  foreach tmp [split $reg(ProxyServer) ";"] {
                      if { [string match "http=*" $tmp] } {
                          set httpproxy [string range $tmp 5 end]
                          break
                      }
                  }
                  unset tmp
               }
            }
		if {[string length $httpproxy] == 0} {
			set reg_auto {}
			catch {
				set reg_auto [registry get $winregkey "AutoConfigURL"]
				if {[string length $reg_auto] > 0} {
    					set token [::http::geturl $reg_auto]
				      upvar #0 $token pxs
					regexp -all -nocase {proxy\s+([^\:]+\:\d+)} $pxs(body) dum httpproxy
				}
			}
		}
        }
    }

    if {[string length $httpproxy] > 0} {
        if {![regexp {\w://.*} $httpproxy]} {
            set httpproxy "http://$httpproxy"
        }
        if {[regexp {\w://(.*)\:(\d*)} $httpproxy dum proxyhost proxyport]} {
          ::http::config -proxyhost $proxyhost -proxyport $proxyport
          set xth(proxy) "$proxyhost:$proxyport"
        }
    }
    
    set token [::http::geturl "http://therion.speleo.sk/update.php" -query [::http::formatQuery version $xth(about,ver) therion 1]]
    upvar #0 $token state
    if {[regexp {^(\d+)\.(\d+)\.(\d+)} $xth(about,ver) dump mv1 mv2 mv3]} {
      if {[regexp {th\_version\s+(\d+)\.(\d+)\.(\d+)} $state(body) dump nv1 nv2 nv3]} {
        if {($mv1 < $nv1) || (($mv1 == $nv1) && ($mv2 < $nv2)) || (($mv1 == $nv1) && ($mv2 == $nv2) && ($mv3 < $nv3))} {
          set newver "$nv1.$nv2.$nv3"
        }
      }
    }
  }
  set xth(about,nvr) $newver
}











set xth(destroyed) 0
set xth(prj,name) "therion"
set xth(prj,title) "therion user interface"
set xth(gui,main) ".xth"
set xth(gui,about) ".xth_about"
set xth(gui,bacw) ".xth_bac"
set xth(gui,dbg) ".xth_dbg"
set xth(gui,help) ".xth_help"
set xth(gui,message) ".xthmsg"
set xth(gui,minsize) {480 300}

set xth(kb_control) Control
set xth(kb_meta) Meta
set xth(gui,compshow) 0
set xth(gui,compcmd) "therion"
set xth(gui,auto_save) 0

set xth(encodings) { iso8859-1 iso8859-2 iso8859-5 iso8859-7 utf-8 }
set xth(kbencodings) {utf-8 iso8859-1 iso8859-2 cp1250 macCentEuro unicode}
set xth(length_units) {m cm in ft yd}
set xth(angle_units) {deg min grad}
set xth(point_types) {}
set xth(line_types) {}
set xth(scrap_projections) {plan elevation extended none}
set xth(app,te,filetypes) {    
  {{Therion files}       {.th}}    
  {{2D therion files}       {.th2}}    
  {{All files}       {*}}    
}
set xth(app,te,fileext) {.th}

set xth(app,me,filetypes) {    
  {{Therion 2D files}       {.th2}}    
  {{Therion files}       {.th}}    
  {{All files}       {*}}    
}

set xth(app,cp,filetypes) {    
  {{Therion config files}       {thconfig*}}    
  {{All files}       {*}}    
}

set xth(app,mv,filetypes) {    
  {{Therion models}       {.thm}}    
  {{All files}       {*}}    
}

set xth(icmds) {survey}
set xth(cmds) {scrap centerline grade line area map layout}
set dfs {8s}                    
set dfss {8s}                    
set dfuf {8.2fx {-}}             
set dfdf {+8.2fx {-}}            
set dfcf {8.2fx {-}}             
set dfccf {8.2f {-}}            
set dfgf {{8.2fx} {up down -}} 
set xth(datafmts) [list \
  "unknown      $dfs" \
  "station      $dfss" \
  "from         $dfss" \
  "to           $dfss" \
  "compass      $dfuf" \
  "backcompass  $dfuf" \
  "bearing      $dfuf" \
  "backbearing  $dfuf" \
  "tape         $dfcf" \
  "length       $dfcf" \
  "count        $dfccf" \
  "counter      $dfccf" \
  "fromcount    $dfccf" \
  "tocount      $dfccf" \
  "fromcounter  $dfccf" \
  "tocounter    $dfccf" \
  "gradient     $dfgf" \
  "clino        $dfgf" \
  "backgradient $dfgf" \
  "backclino    $dfgf" \
  "depth        $dfdf" \
  "fromdepth    $dfdf" \
  "todepth      $dfdf" \
  "depthchange  $dfdf" \
  "dx           $dfcf" \
  "dy           $dfcf" \
  "dz           $dfcf" \
  "northing     $dfcf" \
  "easting      $dfcf" \
  "altitude     $dfcf" \
]

set xth(gui,initdir) [pwd]
set xth(app,active) ""
set xth(app,list) {}
set xth(app,all,relw) -1
set xth(app,all,wmwd) 180
set xth(app,all,wpsw) 1

set xth(app,fencoding) utf-8
set xth(app,sencoding) iso8859-2

# autodetect some options
frame .def
scrollbar .def.scrollbar
text .def.text
if {[catch {.def.text configure -undo 1}]} {
  set xth(gui,text_undo) 0;
} else {
  set xth(gui,text_undo) 1;
}
label .def.label

set xth(gui,sbwidth) [.def.scrollbar cget -width]
set xth(gui,sbwidthb) [.def.scrollbar cget -borderwidth]
set xth(gui,lfont) [.def.label cget -font]
set xth(gui,efont) [.def.text cget -font]
set xth(gui,ecolorbg) black
set xth(gui,ecolorfg) green
set xth(gui,escolorbg) black
set xth(gui,escolorfg) red
set xth(gui,ecolorselbg) green
set xth(gui,ecolorselfg) black
set xth(gui,selfg) white
set xth(gui,selbg) darkBlue
set xth(gui,etabsize) 2
set xth(gui,controlk) Ctrl

set xth(gui,me,nozoom) 1

destroy .def
# end of options autodetection

# map editor settings


# SCRAP
# size of scrap scaling square
set xth(gui,me,scrap,psize) 4


# POINT
# size of point
set xth(gui,me,point,psize) 4

# LINE
# size of line point
set xth(gui,me,line,psize) 4
# line width
set xth(gui,me,line,width) 3
# size of line control point
set xth(gui,me,line,cpsize) 4
# width of line between point and control point
set xth(gui,me,line,clwidth) 2
# size of start line tick
set xth(gui,me,line,ticksize) 15
# width of start line tick
set xth(gui,me,line,tickwidth) 3

set xth(gui,me,activefill) red
set xth(gui,me,pasivefill) blue
set xth(gui,me,controlfill) blue
set xth(gui,me,highlightfill) cyan

set xth(gui,me,typelistwidth) 16

set xth(gui,bindinsdel) 1

# platform dependend settings
case $tcl_platform(platform) {
  unix {
    set xth(gui,sbwidth) 9
    set xth(gui,sbwidthb) 1
    set xth(gui,efont) {fixed -20}
    set xth(gui,platform) unix
    set xth(gui,cursor) top_left_arrow
    set xth(gui,compshow) 1
  }
  windows {
    package require registry
    catch {
      set xth(gui,compcmd) "\"[file join [registry get {HKEY_LOCAL_MACHINE\SOFTWARE\Therion} InstallDir] therion.exe]\""
    }
    regsub -all {\/} $xth(gui,compcmd) {\\\\} xth(gui,compcmd)
    set xth(gui,efont) "Courier 16 roman bold"
    set xth(gui,platform) windows
    set xth(gui,cursor) arrow
    set xth(app,sencoding) cp1250
    set xth(gui,bindinsdel) 0
    if {[catch {
      set fid [open "|cmd.exe /c" r]
      read $fid;
      close $fid
    }]} {
      set xth(gui,compcmd) "command.com /c $xth(gui,compcmd)"
    } else {
      set xth(gui,compcmd) "cmd.exe /c $xth(gui,compcmd)"
    }
  }
  macintosh {
    set xth(kb_meta) Meta
    set xth(kb_control) Alt
    set xth(gui,controlk) Cmd
    set xth(gui,platform) macintosh
    set xth(gui,cursor) arrow
    set xth(gui,bindinsdel) 0
    set xth(app,sencoding) utf-8
  }
}
# end of platform dependend settings

set xth(about,image_data) {
R0lGODlhwACQAOcAAAAAAAAAVQAAqgAA/wAkAAAkVQAkqgAk/wBJAABJVQBJ
qgBJ/wBtAABtVQBtqgBt/wCSAACSVQCSqgCS/wC2AAC2VQC2qgC2/wDbAADb
VQDbqgDb/wD/AAD/VQD/qgD//yQAACQAVSQAqiQA/yQkACQkVSQkqiQk/yRJ
ACRJVSRJqiRJ/yRtACRtVSRtqiRt/ySSACSSVSSSqiSS/yS2ACS2VSS2qiS2
/yTbACTbVSTbqiTb/yT/ACT/VST/qiT//0kAAEkAVUkAqkkA/0kkAEkkVUkk
qkkk/0lJAElJVUlJqklJ/0ltAEltVUltqklt/0mSAEmSVUmSqkmS/0m2AEm2
VUm2qkm2/0nbAEnbVUnbqknb/0n/AEn/VUn/qkn//20AAG0AVW0Aqm0A/20k
AG0kVW0kqm0k/21JAG1JVW1Jqm1J/21tAG1tVW1tqm1t/22SAG2SVW2Sqm2S
/222AG22VW22qm22/23bAG3bVW3bqm3b/23/AG3/VW3/qm3//5IAAJIAVZIA
qpIA/5IkAJIkVZIkqpIk/5JJAJJJVZJJqpJJ/5JtAJJtVZJtqpJt/5KSAJKS
VZKSqpKS/5K2AJK2VZK2qpK2/5LbAJLbVZLbqpLb/5L/AJL/VZL/qpL//7YA
ALYAVbYAqrYA/7YkALYkVbYkqrYk/7ZJALZJVbZJqrZJ/7ZtALZtVbZtqrZt
/7aSALaSVbaSqraS/7a2ALa2Vba2qra2/7bbALbbVbbbqrbb/7b/ALb/Vbb/
qrb//9sAANsAVdsAqtsA/9skANskVdskqtsk/9tJANtJVdtJqttJ/9ttANtt
Vdttqttt/9uSANuSVduSqtuS/9u2ANu2Vdu2qtu2/9vbANvbVdvbqtvb/9v/
ANv/Vdv/qtv///8AAP8AVf8Aqv8A//8kAP8kVf8kqv8k//9JAP9JVf9Jqv9J
//9tAP9tVf9tqv9t//+SAP+SVf+Sqv+S//+2AP+2Vf+2qv+2///bAP/bVf/b
qv/b////AP//Vf//qv///yH+CHh0aGVyaW9uACwAAAAAwACQAAAI/gABCBxI
sKDBgwgTKlzIsKHDhxAjSpxIsaLFixgzatzIsaPHjyBDihxJsqTJkyhTqlzJ
sqXLjyRiloj5sqbNlDJJlJg586bPnxx1liiSpKjRJD2BKl0KUWfRNm0kQW1T
lCbTq1gL6kSSJI4kSbZsfaWaxGpWADFJoD1rk0SKJG7AapurS6wbpGrPOsWb
Ny9bnDvbOLKlbdu/bXPFIi3BtsTRpGv/ooyZJKotw/8yI7ZF1S/TvVOL7pzp
WXJHx5bDFtb2LbPrw9tsRSqblUTluF/dkC1b2jTHymB1bdu27zXmf/sQz+7t
U2iSSGHDSooUOilz3xOfgr083Hhh19rE/raB/FMm8NXRx3ZOq/Y69oW2K0cF
ixmha8RSyd/MCXy4YYH/jHUUUmXp915C8UHVyHaFCSSTQbBpI0sTBrbl2Hn/
DTTdXVJBZRRp7h0IgFHzbdfdQsOFJwleTJXAFVRz/WOQdtOFJppZ73n2FG6q
+ScJQaX9s5olbhAR4kt7JVHYNm0cVCBY6lXF2FU4akUQjWH5t81C2mgW3l1H
1uQcd0kglFds4lG1k1lhmrQXZOwBAIJAqEkiC2HbfJOhmSV4KV4RbMl0mTYM
babYYjrR1CZJSVaV00xzoiWfXMP5k5lCBJDgp5qSkaAaoe0d5MZm+ZHAlWNr
IplgG414KNpO/gAUAAABddoi3Gs/IlhcYdbkR4BpX3G3TSQLiXcUWUUsGhJq
uEXp6EC1XqZZsd5JVVYAps3HnYzFdqhbaL09mlZkHNUZnHQexhSpbaxaguel
C7nWmja6SNJEsr5Nyh1D0gUroH6NLpaqRjqlhp4turEYa63dwauQa8mFpeav
pkW75UJtRKdxwnBeGFUbbnxrVJUSsZvxZfvoGZu1UwLgWBpyyCJccf80Ga+f
kqSRgrLlAXfZQ4Ou3JlWwG2Xq40kO6RTE45YYs02ugh0i9BI0VlUXMI+dJ+x
LfvGLn0QwSYxbQRFS6iGkiRMdlNPZcmtQCqS9evXtjz9dkOH7ROe/iP38vxT
rWc75A9icZcJpM8NDqTNLVxHFJ+JewIgtJrsNuLuiVqTymmOTkUV3kNtaNb4
QHRHTrh4FR7UuYmZGS7QytY+ZZlw3zTykGHfaEPk2ti15zNmNjdEmCWbO4jh
3RFauyjdgx5UOInB2vKQJPcV7rdSpbsGkfWk/4682CvybmZRkdB3sUHGlrVj
WGG7pg/VFIvocmXv3l1o+uYdT5BmVIfp2FdLst9AGhefOMisfZlJzIqutxSG
Ra5QKxtQ25Z0pcOEhzPiMwjDtHcQWVhLICCwTSRkETy8ZUZPEhqa/Ixnmfrc
Dk1qKwrMZDacg1xGMalDSwnSYD4Ooi8O/uuJz0Tu078VDgRxDmuIoahToKIE
axv+QIjQUkcZzx1HgAKJnXMo4j6oWStSK4yJZb4TNlKxqHSBK4iQMNi1giDu
igiJHRIuxEXk6OkW1opfGJ+zLYi0AT93mVLBzIeQJESwQqhxm2tcVxAg8uYt
bZDDEP/Rmm30ajxG7B50pDWR6VRlfkmg1ELSlkGn9FB6CqGcpMZYQoZUazwM
bCBcCNMliqwICWlJJGEYUiqitTCJCOFUCH93PhPuql4qNKJj3NDHiahydYlT
CMv8YkpJfAeLbiRb6YrpSvCkMAlglN82sTnK4pWOX7HjiXa2xU0nWeeNEIkE
JcWWTHG+kZwH/mlDYjaXKcQxREWxuw19WANMJ5EgUoDDZ0IMo6KqKfOeEEmR
bIY2EwwVSoEbKt+2fJiQsoCAVuuMZkQKg7o25giiLwxLwvryu24aKjqIuaJC
R9Qej4HlaRRJji6I51B7WrGgCiFVIHvCMIYkIUIxvaalMoMEo/KEKPqay0Tk
qaJ76fE9y5TE1IC6UGvgr6ItRcluUHU1awJvImMzqW/qdM3tGQuX5hljO0fi
KhL8yoFcRWdnwmkap0CnrUDTIrTgiRLBWi1jdpupFI2VNL2UoA3QialiBSKW
8HlmmykRSxPWRjcyTsQNhcshVv4nrbwO5I+hJd38omK3zE6ThfQx/q3wWNa7
xzKzYa7UXNd2Ih88RREljD3oKmM7WYWIJwW9I6ZsAWBB2RSFdDZt5kkIWMXL
eWMfGFEpI/8COBcGlWq0AatlpvZAkozuQuYrr0Qi6LXH/nWpMz3M6EAKFeIK
CSXasBZcGebZiqRoRV7zHkftMxflda++tHzNPxiJBH44+MFNBdKDHxwmr7aq
KG9BXJeKW5DQNRfAndrggA+iOc4WDU8b5uiEJ1yQFT/4n4ciUCglkVgO749/
zq0Y+d7l3YUW8bBYC9prCOJiB7e4yPzaHWmIIGAbD6R6UiFCX+nH45pB0C5V
G2YS0lBfdxWGZndDB5IJImYXF4uxDnos/qUsNZHjxC2WK3mcLcibxniZ0XDx
kZ2JUkwQcPgZHyzu858DbRBNlTgvtGoCpdSbEA9nJjlf6mltEglYh4BvPRcq
ClfishqO+tnPhBbIp8ER6htv5i4o6Itt4mArzFnaO6iDM2DkymatkbRDEpyj
gCM36lL3+sUH8ROYBgICtkKRw4+m5KnLctWrkHZbrcSYkCa35dBARaMNuy8A
gPFpQD8YGwMBBwA+TQ4HXyeB2yBl17KHbCI6V7TN6W5j+WUXqkxlKk+8poL3
ve8EiNvSwwmuQPrJWlc3JGUSNTB3MSRpiUQJ3+VbNL8nvm+I5E5o+CJdEVpY
a4egUEWR0Blf/rFSOoWhNaDa6pFMKT7xiCqw4cWOCu04vA1vALSeeqFfuh1U
kYkmAZIGI05rWM7y7Rp3jSQUnym/Y/SEHMxD8C4PaqxEkfQJlD6oFImhp61Z
I2lFzbJ4yFEpqTc0B7iV8+5W7KCCtTqDxEuxSbpdvx6V9n1DH9qwhpJz9Ni0
Ay1N0PsZSbwUnjborDQBYFfWjXlrqhzIZG5QLUUyJgk5dMZniw8Jzp5FTZ+1
73QKX2vRciXrLJKlvmApyYcDGam7yjlqWlN2aEuvks7FpSNq01ZJTtcICnmm
2Fdz2lwTYseAW8vrfU0QWHiSEVc9J/UkOfSs6EQCorRw+PbZhzcs/mkJ5dG+
9lj6PgBYVl9ZWCL6DS2BHnkrh4E2nfgfJov4QeIec+Ep2g7vEMg0+inEvAb/
6xVplxUtE/ENehMbVJFxnJMaBld1XyEVEBg9KDZ0TuY8+TVsaZYEirZLBYh3
Zsc5JIBgnHQR/aJ/JdIjlWYR3EN9wCEcXFRi4lRF14d9DnEyAiIfbsB/2ZYR
nhJ6mDVEjZdB2BFd+uYaADhKKMd2YHELXVJLG0E5mUIUN8VoDOEPejI2OxNG
kqKDnbZccWQtuwEyXhZTHbEbIUUcXIRCGPR+yQUy24FiVKh2dYVgS0KDnQQV
aqAtKQgRxXFqaQAomeQUOSiBSeVMlUUd/vYWFe7CHW5nEf2yiP7nhcGWcA0n
Py5SGVc3KEbYSQ9YIm84F8PBhi4XFrqwJBRYR7fWBHOXSTrEFViib1VXWV8R
CY4QPYXRGhmRIgGkYFyUHPDDikCyOnjSY24lHZGAiAzYcRZxQsixchRRSVRT
AiPHiuN0GJ9lKPqlXBnRJxQnig+DY3chhKyIBHLVJWclEdIRSHDRQxxxDa9h
DRfRRYwlK8B4Jc83jIchiehTI5UxQsKhD9jFEUMWj1DmCEmggPW4WnsmWbEo
FRFXPx0xkMsoL4UzjYHoRLboH43IEG1QF7ZwJ1mCGXYYERJZEWMXIRg0f9iz
IxnZHUfoEN8B/l8LlhEleRHasA8RMzEJSTqgAVkMQowTQTMUWIEQMmLLaHxt
kIU7GYyBFyMj2U0VhxE1GY+584FLCSR4hRGONpUTwY1qVRGhgx/Fc5XZtIRx
OFJcCRRjo5I5dzJnSZJGqRQ8ZZFXqXgxIpBxqZZUQZc7WTCR9ZYIZI1YYSxk
eRBZuRET540hcZIK9l/jQQDYUpiDxUxbRZT20XIrQXHbd0nqJ5kHRin6aEL8
xhKakTd68g+Dg0NsuRRqsU6YoZgQwZhpORLmCBtJlRgYWJigEVmZ1xEpFpoY
cVQMRThzUZzoIo712DmbtJF4mZcfAXcXpDGy4EHr4ZkVdX2DN5sf/rEPg5MY
shgXIdMZX5mQcsaII6FgzOmbFhQ3riJ/q0klTpQlKcZIsjmTk7RvsJkdJ5Qn
KhKO7OF3fSliHIWZEkFxb0d4Y7M2BNBsnqlDcmUYkWMczvmNo/mcyIF3vWJZ
ZdOgCNFdoHg2vwmhiKGfFaqezXUo1EQuHIqVmBceHwqhq1GcSRVT3bENivmb
v3Ef3YlH1bmi8IEa9cV/cBidGqMx1lCHiqWdBQoxQmVyPooglCE7PKIa6ZEb
DxhxP/kNommZwZaPiLELlhAHn/SkStMoPtkvU9EE98ZlbmgivVmUCaQRG5Zw
OYOcZIogpEEj6WQbp7ITL6ItT1Oj9jkQ/iuXnzNyQtqHjWlgp3fKEKtyI2mW
KDqUYQw4HCpTEEM5ofCHoJLgSADaqHh6FFWCI3ElFy+KqaWpqfZhgOhhLcny
np4pFFFXNi1KpQO0ctq2PYQnIJ8Kqo6qojyHIC/ygMSakfqQmEaFqKvxFc+i
ELDqq8YjH/eGb1MIoVFJoQk3G0oJrS6RaZrGFS/Sdohxd0PZTYmqO42QBLjE
rTWRKeNCAB9VqrZwDf7Bi0H1aJthkLPKriWRNAVTqdugDwaITWNngGooFdvK
ry8Br+NzYviITcaxGUk3ngrbM7cxQnjiDRBLHNuXd5ZgkM9asRzhro6hpj3U
iOhmPSErsh0hfxNNIAchuSSMVHOWhD8se3af6B8EQSpMtDMMerMkBxwgWZwE
ETebta9AWx5/Gj1eRVnB9bNJS3JQpaYplx69h5BR21fq9BRYGgm6gbRZCxTj
Any3kaaVGLZsEUIMazVHMUe9irZZQbJCMS5wq4WlsbJ1m7d6u7d827d++7dk
GRAAOw==
====
}

proc xth_incr_station_name {oname iii} {
  if {[regexp {^(\S+)(\@\S+)$} $oname dumm stname svname]} {
    set oname $stname
  } else {
    set svname {}
  }
  if {[regexp {^\d+$} $oname]} {
    incr oname $iii
    return "$oname$svname"
  } elseif {[regexp {^(.*\D)(\d+)$} $oname dumm s1 s2]} {
    incr s2 $iii
    return "$s1$s2$svname"
  } elseif {[regexp {^(\d+)(\D.*)$} $oname dumm s2 s1]} {
    incr s2 $iii
    return "$s2$s1$svname"
  } else {
    return "$oname$svname"
  }
}







set xth(point_types) {
	air-draught
	altitude
	anastomosis
	anchor
	aragonite
	archeo-material
	bedrock
	blocks
	breakdown-choke
	bridge
	camp
	cave-pearl
	clay
	continuation
	crystal
	curtain
	date
	debris
	disk
	entrance
	fixed-ladder
	flowstone
	flowstone-choke
	flute
	gradient
	guano
	gypsum
	gypsum-flower
	height
	helictite
	ice
	karren
	label
	low-end
	moonmilk
	narrow-end
	no-equipment
	paleo-material
	passage-height
	pebbles
	pillar
	popcorn
	raft
	raft-cone
	remark
	rimstone-dam
	rimstone-pool
	root
	rope
	rope-ladder
	sand
	scallop
	section
	sink
	snow
	soda-straw
	spring
	stalactite
	stalagmite
	station
	station-name
	steps
	traverse
	vegetable-debris
	wall-calcite
	water
	water-flow
}

set xth(line_types) {
	arrow
	border
	ceiling-meander
	ceiling-step
	chimney
	contour
	floor-meander
	floor-step
	flowstone
	gradient
	label
	overhang
	pit
	rock-border
	rock-edge
	section
	slope
	survey
	wall
	water-flow
}

set xth(area_types) {
	blocks
	clay
	debris
	ice
	pebbles
	sand
	snow
	sump
	water
}








set xth(about,image_id) [image create photo -data $xth(about,image_data)]
set xth(about,infotime) 2500

after 0 {
  xth_ivc
  if {[string length $xth(about,nvr)] > 0} {
    bell
    if {[winfo exists $xth(gui,about)]} {
      xth_about_nvr
    } else {
      # show about window for some time seconds
      xth_about_show 0
      after $xth(about,infotime) xth_about_hide
    }
  }
}

proc xth_about_status {str} {
    global xth
    set xth(about,status) "$str"
    catch {
      $xth(gui,about).i2 configure -text "VERSION $xth(about,nvr) AVAILABLE"
    }
    update idletasks
}


proc xth_about_nvr {} {
  global xth
  if {[string length $xth(about,nvr)] == 0} {
    return
  }
  if {![winfo exists $xth(gui,about)]} {
    return
  }
  set w $xth(gui,about)
  label $w.i2 -bd 0 -relief sunken -background black -fg red -text "VERSION $xth(about,nvr) AVAILABLE" \
    -font $xth(gui,lfont) -anchor center
  pack $w.i2 -after $w.i1 -side top -expand 1 -fill both -pady 5
  update idletasks
}


proc xth_about_show {btnid} {
    global xth
    if {[winfo exists $xth(gui,about)]} xth_about_hide
    xth_about_status ""
    set w $xth(gui,about)
    toplevel $w -relief raised -bg black -bd 3 -cursor $xth(gui,cursor)
    wm transient $w
    wm withdraw $w
    set sw [winfo screenwidth .]
    set sh [winfo screenheight .]
    wm overrideredirect $w 1
    label $w.image -bd 0 -relief sunken -background black -fg white -image $xth(about,image_id)
    pack $w.image -side top -expand 1 -fill both
    label $w.status -relief flat -background black -foreground white \
    	-textvariable xth(about,status) -font $xth(gui,lfont) -anchor center
    pack $w.status -side top -expand 1 -fill both
    label $w.i1 -bd 0 -relief sunken -background black -fg white -text "xtherion\n$xth(about,ver)" \
      -font $xth(gui,lfont) -anchor center
    pack $w.i1 -side top -expand 1 -fill both -pady 5
    if {$btnid} {
      button $w.close -text "Close" -font $xth(gui,lfont) -anchor center \
        -command xth_about_hide -width 5
      pack $w.close -side top -fill none -anchor center -pady 5
      focus $w.close
    }
    xth_about_nvr
    wm geometry $xth(gui,about) -$sw-$sh
    wm deiconify $xth(gui,about)
    update idletasks
    set x [expr {($sw - [winfo width $xth(gui,about)])/2}]
    set y [expr {($sh - [winfo height $xth(gui,about)])/2}]
    wm geometry $xth(gui,about) +$x+$y
    $w configure -bg black
    $w.image configure -image $xth(about,image_id)
    $w.i1 configure -text "xtherion $xth(about,ver)\n\u00A9 2002-2004 Stacho Mudrak"
    update idletasks
}


proc xth_about_hide {} {
  global xth
  destroy $xth(gui,about)
  focus $xth(gui,main)
}








# prepare the syntax commands
foreach cmd $xth(icmds) {
  set xth(cmd,$cmd) 2
  set xth(endcmd,$cmd) end$cmd
  set xth(endcmd,end$cmd) ""
  set xth(cmd,end$cmd) -2
}

foreach cmd $xth(cmds) {
  set xth(cmd,$cmd) 1
  set xth(endcmd,$cmd) end$cmd
  set xth(endcmd,end$cmd) ""
  set xth(cmd,end$cmd) -1
}

foreach datafmt $xth(datafmts) {
  set qt [lindex $datafmt 0]
  set xth(datafmt,$qt,format) [lindex $datafmt 1]
  set xth(datafmt,$qt,special) [lindex $datafmt 2]
}







package require BWidget

if {[catch {set imgver [package require Img]}]} {
  set xth(gui,imgfiletypes) {
           { {Pictures} {.gif .pnm .ppm} }
           { {All Files}               * }
         } 
} else {
  set xth(gui,imgfiletypes) {
           { {Pictures} {.png .jpeg .jpg .gif .pnm .ppm} }
           { {All Files}                                               * }
         } 
}

# read xtherion.ini file from THERION directory
set idir {}
if {[catch {set idir $env(THERION)}]} {
  if {![catch {set idir $env(HOME)}]} {
    append idir "/.therion"
    if {[string equal $xth(gui,platform) windows]} {
      append idir ";"
    } else {
      append idir ":"
    }
  }
  if {[string equal $xth(gui,platform) windows]} {
    if {[catch {
        append idir [registry get {HKEY_LOCAL_MACHINE\SOFTWARE\Therion} InstallDir]
        }]} {
      append idir "C:/WINDOWS;C:/WINNT;C:/Program files/Therion"
    }
  } else {
    append idir "/etc:/usr/etc:/usr/local/etc"
  }
}
if {[string equal $xth(gui,platform) windows]} {
  set idirs [split $idir ";"]
} else {
  set idirs [split $idir ":"]
}

set inok 1
foreach idir $idirs {
  if {![catch {source [file join $idir xtherion.ini]}]} {
    set inok 0
    break
  }
}
if {$inok} {
  catch {source xtherion.ini}
}

# create xth window
wm withdraw .
xth_about_show 0
toplevel $xth(gui,main)
wm withdraw $xth(gui,main)
wm protocol $xth(gui,main) WM_DELETE_WINDOW "xth_exit"
wm title $xth(gui,main) $xth(prj,name)
wm geometry $xth(gui,main) [format "%dx%d+0+0" [lindex $xth(gui,minsize) 0] \
  [lindex $xth(gui,minsize) 1]]
wm minsize $xth(gui,main) [lindex $xth(gui,minsize) 0] \
  [lindex $xth(gui,minsize) 1]
update idletasks
bind $xth(gui,main) <Configure> { 
  catch {xth_app_place $xth(app,active)}
}

set xth(gui,clock) "00:00"

# redefine some public key bindigs
bind Text <$xth(kb_control)-Key-o> "#"
bind Text <$xth(kb_control)-Key-a> "#"
bind Text <$xth(kb_control)-Key-i> "#"
bind Text <$xth(kb_control)-Key-s> "#"
bind Text <$xth(kb_control)-Key-w> "#"
bind Text <$xth(kb_control)-Key-q> "#"
bind Text <$xth(kb_control)-Key-x> "#"
bind Text <$xth(kb_control)-Key-n> "#"
bind Text <$xth(kb_control)-Key-p> "#"
bind Text <$xth(kb_control)-Key-c> "#"
bind Text <$xth(kb_control)-Key-v> "#"
bind Text <$xth(kb_control)-Key-f> "#"
bind Text <$xth(kb_control)-Key-h> "#"
bind Text <$xth(kb_control)-Key-z> "#"
bind Text <$xth(kb_control)-Key-y> "#"
bind Text <$xth(kb_control)-Key-d> "#"
bind Text <$xth(kb_control)-Key-k> "#"
bind Text <$xth(kb_control)-Key-r> "#"

bind Entry <$xth(kb_control)-Key-d> "#"
bind Entry <$xth(kb_control)-Key-k> "#"

set xth(gui,bind,text_tab) [bind Text <Tab>]
set xth(gui,bind,text_return) [bind Text <Return>]
bind Text <Tab> "#"
bind Text <Return> "#"









proc xth_status_bar {aname widg stext} {

  global xth
  set sbar $xth(gui,$aname).sf.sbar
  set xth(gui,sbar,$widg,exp) 0  
  bind $widg <FocusIn> "+ if {\$xth(gui,sbar,$widg,exp) == 0} {set xth(gui,sbar,$widg,exp) 1; set xth(gui,sbar,$widg,otext) \[$sbar cget -text\]; $sbar configure -text \"$stext\"}"
  bind $widg <Enter> "+ if {\$xth(gui,sbar,$widg,exp) == 0} {set xth(gui,sbar,$widg,exp) 1; set xth(gui,sbar,$widg,otext) \[$sbar cget -text\]; $sbar configure -text \"$stext\"}"
  bind $widg <FocusOut> "+ if {\$xth(gui,sbar,$widg,exp) == 1} {$sbar configure -text \$xth(gui,sbar,$widg,otext); set xth(gui,sbar,$widg,exp) 0}"
  bind $widg <Leave> "+ if {\$xth(gui,sbar,$widg,exp) == 1} {$sbar configure -text \$xth(gui,sbar,$widg,otext); set xth(gui,sbar,$widg,exp) 0}"
  
}

proc xth_status_bar_push aname {
  global xth
  set sbar $xth(gui,$aname).sf.sbar
  if {![info exists xth(gui,sbar,$aname)]} {
    set xth(gui,sbar,$aname) [$sbar cget -text]
  } else {
    set xth(gui,sbar,$aname) [lappend $xth(gui,sbar,$aname) [$sbar cget -text]]
  }
}


proc xth_status_bar_pop aname {
  global xth
  set sbar $xth(gui,$aname).sf.sbar
  if {! [info exists xth(gui,sbar,$aname)]} {
    set xth(gui,sbar,$aname) ""
  } else {
    $sbar configure -text [lindex $xth(gui,sbar,$aname) 0]
    set xth(gui,sbar,$aname) [lreplace $xth(gui,sbar,$aname) 0 0]
  }
}


proc xth_status_bar_status {aname txt} {
  global xth
  set sbar $xth(gui,$aname).sf.sbar
  $sbar configure -text $txt
  update idletasks
}









proc xth_scroll_showcmd {sbar cmd} {
  global xth
  set xth(scroll,$sbar,show) $cmd
  set xth(scroll,$sbar,open) 0
}

proc xth_scroll_hidecmd {sbar cmd} {
  global xth
  set xth(scroll,$sbar,hide) $cmd
  set xth(scroll,$sbar,open) 0
}

proc xth_scroll {sbar first last} {
  global xth
  if {[expr $first == 0.0] && [expr $last == 1.0]} {
    if {$xth(scroll,$sbar,open) == 1} {
      set xth(scroll,$sbar,open) 0
      eval $xth(scroll,$sbar,hide)
      update idletasks
    }
  } else {
    if {$xth(scroll,$sbar,open) == 0} {
      set xth(scroll,$sbar,open) 1
      eval $xth(scroll,$sbar,show)
      update idletasks
    }
    $sbar set $first $last
  }
}







set hm "$xth(gui,main).hmenu"
set xth(gui,menu,help) $hm

menu $hm -tearoff 0
$hm add command -label "Control..." -underline 0 -font $xth(gui,lfont) \
  -command xth_help_control_show
$hm add command -label "BAC calculator..." -underline 0 -font $xth(gui,lfont) \
  -command xth_bac_init
$hm add command -label "About..." -underline 0 -font $xth(gui,lfont) \
  -command {
    xth_about_show 1
    xth_about_status $xth(prj,title)
  }

proc xth_help_control_show {} {
  global xth
  if {[winfo exists $xth(gui,main).help_control]} {
    focus $xth(gui,main).help_control
  } else {
    xth_help_control_init
  }
}

proc xth_help_control_search {} {
}

proc xth_help_control_init {} {

  global xth
  
  set f $xth(gui,main).help_control
  toplevel $f
  wm transient $f $xth(gui,main)
  wm title $f "Xtherion control"

  set ff $f.lf
  frame $ff
  Entry $ff.se -font $xth(gui,lfont)
  Button $ff.sb -text "Search" -anchor center -font $xth(gui,lfont) \
  -command xth_help_control_search -width 8
  Button $ff.cb -text "Close" -anchor center -font $xth(gui,lfont) \
  -command "destroy $f" -width 8
  grid columnconf $ff 2 -weight 1
#  grid columnconf $ff 0 -weight 1
#  grid columnconf $ff 1 -weight 0
#  grid columnconf $ff 1 -weight 0
#  grid $ff.se -column 0 -row 0 -sticky news
#  grid $ff.sb -column 1 -row 0 -sticky news
  grid $ff.cb -column 2 -row 0 -sticky news


  set txb $f.tf
  frame $txb
  text $txb.txt -wrap none -font $xth(gui,lfont) \
    -relief sunken -state disabled \
    -selectbackground $xth(gui,ecolorselbg) \
    -selectforeground $xth(gui,ecolorselfg) \
    -selectborderwidth 0 \
    -yscrollcommand "$txb.sv set" \
    -xscrollcommand "$txb.sh set" 
  scrollbar $txb.sv -orient vert  -command "$txb.txt yview" \
    -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
  scrollbar $txb.sh -orient horiz  -command "$txb.txt xview" \
    -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
  grid columnconf $txb 0 -weight 1
  grid rowconf $txb 0 -weight 1
  grid $txb.txt -column 0 -row 0 -sticky news
  grid $txb.sv -column 1 -row 0 -sticky news
  grid $txb.sh -column 0 -row 1 -sticky news

  grid rowconf $f 0 -weight 1
  grid columnconf $f 0 -weight 1
  grid rowconf $f 1 -weight 0
  grid $txb -column 0 -row 0 -sticky news
  grid $ff -column 0 -row 1 -sticky news
  
 
  set sw [winfo screenwidth .]
  set sh [winfo screenheight .]
  update idletasks
  wm geometry $f +0+0
  wm geometry $f 640x480
  wm minsize $f 320 240
  set x [expr {($sw - [winfo width $f])/2}]
  set y [expr {($sh - [winfo height $f])/2}]
  wm geometry $f +$x+$y
  update idletasks
  
  $txb.txt configure -state normal
  $txb.txt insert end {MAP EDITOR SHORTCUTS
  
General shortcuts
 * Ctrl+Z = undo
 * Ctrl+Y = redo
 * F9 = compile current project
 * to select object in the listbox using keyboard:
    switch using "Tab" into desired listbox;
    move with underlined cursor to desired object;
    press "Space"

Drawing area and background images
 * RightClick = scroll drawing area
 * Double RightClick on the image = move the image
 
Inserting scrap
 * press "Ctrl-r" or "Edit" > "Insert" > "scrap" to insert new scrap
 * new scrap is inserted just after the current one

Inserting point
 * Ctrl+P = switch to `insert point' mode
 * LeftClick = insert point at given position
 * Ctrl+LeftClick = insert point very close to existing point (normally it
    will be inserted right above the closest point)
 * Esc = escape from the `inset point' mode

Editing point
 * LeftClick + drag = move point
 * Ctrl+LeftClick + drag = move point close to the existing
    point (normally it is moved right above closest existing point)
 * LeftClick + drag on point arrows = change point orientation or
    sizes (according to given switches in Point cotrol panel)

Inserting line
 * Crtl+L = insert new line and enter an `insert line point' mode
 * LeftClick = insert line point (without control points)
 * Ctrl+LeftClick = insert line point very close to existing point 
    (normally it's inserted right above closest existing point)
 * LeftClick + drag = insert line point (with control points)
 * hold Ctrl while dragging = fix the distance of previous control point
 * LeftClick + drag on the control point = move its position
 * RightClick on one of the previous points = selects the previous point while 
    in insert mode (useful if you want to change also the direction of
    previous control point)
 * Esc or LeftClick on the last point = end the line insertion
 * LeftClick on the first line point = close the line and end line insertion

Editing line
 * LeftClick + drag = move line point
 * Ctrl+LeftClick + drag = move line point close to the existing
    point (normally it is moved right above closest existing point)
 * LeftClick on control point + drag = move control point

Adding line point
 * select the point before which you want to insert points;
    insert required points;
    press Esc or left-click on the point you selected at the begining
  
Deleting line point
 * select the point you want to delete;
    press "Edit line" > "Delete point" in the Line control panel
    
Splitting line
 * select the point at which you want to split the line;
    press "Edit line" > "Split line" in the Line control panel
    
Inserting area
 * press "Ctrl-a" or "Edit" > "Insert" > "area" to switch to 
    the "insert area border" mode
 * RightClick on the lines, that suround desired area
 * Esc to finish area border lines insertion

Editing area
 * select area you want to edit
 * pres "Insert" in the area control to insert other border lines
    at current cursor position
 * pres "Insert ID" to insert border with given ID at current cursor position
 * pres "Delete" to remove selected area border line
    
Selecting an existing object
 * LeftClick = select object on the top
 * RightClick = select object right below the top object (useful when several
    points lie above each other)

} 
    
     
  $txb.txt configure -state disabled
 
}










set xth(ctrl,all,number) 0

proc xth_ctrl_create {aname} {

  global xth
  
  set cf $xth(gui,$aname).af.ctrl  
    
  canvas $cf.c -yscrollcommand "xth_scroll $cf.sv" \
    -highlightthickness 0
  scrollbar $cf.sv -orient vert  -command "$cf.c yview" -takefocus 0 \
    -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)

  grid columnconf $cf 0 -weight 1
  grid rowconf $cf 0 -weight 1
  xth_scroll_showcmd $cf.sv "grid $cf.sv -row 0 -column 1 -sticky nsew; update idletasks; xth_ctrl_reshape te"
  xth_scroll_hidecmd $cf.sv "grid forget $cf.sv; update idletasks; xth_ctrl_reshape te"
  grid $cf.c -row 0 -column 0 -sticky nsew
  
  set xth(ctrl,$aname,number) 0
  set xth(ctrl,$aname,list) {}
}

proc xth_ctrl_add {aname cname title} {
  
  global xth
  
  incr xth(ctrl,$aname,number)
  incr xth(ctrl,all,number)
  lappend xth(ctrl,$aname,list) $cname
  set cn $xth(ctrl,$aname,number)
  set cf $xth(gui,$aname).af.ctrl  
  
  set ccf $cf.cf$cn
  frame $ccf
  frame $ccf.f 
  set cid [$cf.c create window 0 0 -window $ccf -anchor nw]
  set xth(ctrl,$aname,$cname) $ccf.f
  set xth(ctrl,$aname,$cname,frm) $ccf
  set xth(ctrl,$aname,$cname,pos) $cn
  set xth(ctrl,$aname,$cname,max) 1
  set xth(ctrl,$aname,$cname,menu) .xth_popup$xth(ctrl,all,number)
  set xth(ctrl,$aname,$cn) $cid 
  
  menu .xth_popup$xth(ctrl,all,number) -tearoff 0
  button $ccf.rb -text "$title" -command "xth_ctrl_minmax $aname $cname" \
    -font $xth(gui,lfont) -bg #aaaaaa \
    -fg white -bg darkBlue -activebackground lightBlue \
    -anchor w -relief flat \
    -takefocus 0
  bind $ccf.rb <Button-3> "tk_popup .xth_popup$xth(ctrl,all,number) %X %Y"
  xth_status_bar $aname $ccf.rb "Show or hide this control panel"
  
  pack $ccf.rb -side top -fill x -expand 1
  pack $ccf.f -expand yes -fill both

  xth_ctrl_reshape $aname
}


proc xth_ctrl_finish {aname} {

  global xth  

  foreach ct $xth(ctrl,$aname,list) {
    set cmn $xth(ctrl,$aname,$ct,menu)
    foreach oct $xth(ctrl,$aname,list) {
      if {[string compare $ct $oct] != 0} {
        $cmn add command -label [$xth(ctrl,$aname,$oct,frm).rb cget -text] \
          -command "xth_ctrl_replace $aname $ct $oct" -font $xth(gui,lfont)
      }
    }
  }

}


proc xth_ctrl_reshape {aname} {
  
  global xth
  set cn $xth(ctrl,$aname,number)
  set cnv $xth(gui,$aname).af.ctrl.c  
  
  # position the windows
  set height 0
  set width [winfo width $cnv]
  for {set i 1} {$i <= $cn} {incr i} {
    set cid $xth(ctrl,$aname,$i)
    set cw [$cnv itemcget $cid -window]
    $cnv coord $cid 0 $height
    $cnv itemconfigure $cid -width $width
    incr height [winfo height $cw]
  }

  $cnv configure -scrollregion "0 0 $width $height"
}

proc xth_ctrl_minmax {aname cname} {

  global xth

  set cmm $xth(ctrl,$aname,$cname,max)
  if {$cmm == 1} {
    pack forget $xth(ctrl,$aname,$cname)
    $xth(ctrl,$aname,$cname,frm).rb configure -relief raised
    set cmm 0
  } else {
    pack $xth(ctrl,$aname,$cname) -expand yes -fill both
    $xth(ctrl,$aname,$cname,frm).rb configure -relief flat
    set cmm 1
  }
  set xth(ctrl,$aname,$cname,max) $cmm
  
  update idletasks
  xth_ctrl_reshape $aname
}

proc xth_ctrl_replace {aname ccname dcname} {
  
  global xth

  set cnv $xth(gui,$aname).af.ctrl.c
  set p1 $xth(ctrl,$aname,$ccname,pos)
  set p2 $xth(ctrl,$aname,$dcname,pos)
  
  set xth(ctrl,$aname,$ccname,pos) $p2
  set xth(ctrl,$aname,$dcname,pos) $p1
  $cnv itemconfigure $xth(ctrl,$aname,$p1) \
    -window $xth(ctrl,$aname,$dcname,frm)
  $cnv itemconfigure $xth(ctrl,$aname,$p2) \
    -window $xth(ctrl,$aname,$ccname,frm)
    
  update idletasks
  xth_ctrl_reshape $aname
  
}

proc xth_ctrl_minimize {aname cname} {
  global xth
  set xth(ctrl,$aname,$cname,max) 1
  xth_ctrl_minmax $aname $cname
}

proc xth_ctrl_maximize {aname cname} {
  global xth
  set xth(ctrl,$aname,$cname,max) 0
  xth_ctrl_minmax $aname $cname
}

proc xth_ctrl_scroll_to {aname cname} {
  global xth
  set cf $xth(gui,$aname).af.ctrl
  set sr [$cf.c cget -scrollregion]
  set wp [$cf.c coord $xth(ctrl,$aname,[expr [lsearch $xth(ctrl,$aname,list) [lindex $xth(ctrl,$aname,list) [expr $xth(ctrl,$aname,$cname,pos) - 1]]] + 1])]
#  set wp [$cf.c coord $xth(ctrl,$aname,[expr [lsearch $xth(ctrl,$aname,list) $cname] + 1])]
  $cf.c yview moveto [expr [lindex $wp 1] / ([lindex $sr 3] - [lindex $sr 1])]   
}









proc xth_app_move_panel {aname xx} {
  global xth
  if {$xth(app,$aname,wpsw) == 1} {
    set xth(app,$aname,relw) [expr [winfo width $xth(gui,main)] - $xx + $xth(app,$aname,wrtx)]; 
  } else {
    set xth(app,$aname,relw) [expr $xx - $xth(app,$aname,wrtx)]; 
  }
  xth_app_place $aname
}


proc xth_app_create {aname title} {
  
  global xth
  
  set aw "$xth(gui,main).$aname"
  set xth(gui,$aname) $aw
  set xth(app,list) [concat $xth(app,list) $aname]
  if {![info exists xth(app,$aname,relw)]} {
    set xth(app,$aname,relw) $xth(app,all,relw)
  }
  if {![info exists xth(app,$aname,wpsw)]} {
    set xth(app,$aname,wpsw) $xth(app,all,wpsw)
  }
  if {![info exists xth(app,$aname,wmwd)]} {
    set xth(app,$aname,wmwd) $xth(app,all,wmwd)
  }
  
  # create and configure application frames
  frame $aw
  frame $aw.af
  frame $aw.af.apps
  frame $aw.af.ctrl
  frame $aw.af.lrhn -borderwidth 2 -relief raised -cursor sb_h_double_arrow
  xth_status_bar $aname $aw.af.lrhn "Drag to resize control panel."

  frame $aw.sf
  set sbar $aw.sf.sbar
  label $sbar -text "" -anchor w -relief sunken -font $xth(gui,lfont)
  pack $sbar -side left -fill both -expand 1
  
  bind $aw.af.lrhn <Configure> "set xth(app,$aname,wwid) \[winfo width $xth(gui,main)\]; set xth(app,$aname,wrtx) \[winfo rootx $xth(gui,main)]; xth_ctrl_reshape $aname"
  bind $aw.af.lrhn <B1-Motion> "xth_app_move_panel $aname %X"
  
  set amn $aw.menu
  menu $amn -tearoff 0
  set xth($aname,menu) $amn
  
  set fmn $amn.file
  menu $fmn -tearoff 0
  $amn add cascade -label "File" -underline 0 -menu $fmn -font $xth(gui,lfont)
  set xth($aname,menu,file) $fmn
  
  set xth($aname,title) $title
  set xth($aname,wtitle) [string tolower $title]

  pack $aw.af -expand yes -fill both
  pack $aw.sf -side bottom -fill x

  set fr $xth(app,$aname,relw)
  set minfr $xth(app,$aname,wmwd)
  set lrhny [expr [winfo height $xth(gui,main)] - 64]
  if {$fr < $minfr} {
    set fr $minfr
  } elseif {$fr > ([winfo width $xth(gui,main)] - $xth(app,$aname,wmwd))} {
    set fr [expr {([winfo width $xth(gui,main)] - $xth(app,$aname,wmwd))}]
  }
  set xth(app,$aname,relw) $fr
  set fr [expr 1.0 - $fr / double([winfo width $xth(gui,main)])]
  
  if {$xth(app,$aname,wpsw) == 1} {
    place $aw.af.apps -relx 0 -rely 0 -relheight 1 -relwidth $fr
    place $aw.af.ctrl -relx $fr -rely 0 -relheight 1 -relwidth [expr 1.0 - $fr]
    place $aw.af.lrhn -relx $fr -y $lrhny -width 8 -height 8 -anchor center
  } else {
    place $aw.af.ctrl -relx 0 -rely 0 -relheight 1 -relwidth $fr
    place $aw.af.apps -relx $fr -rely 0 -relheight 1 -relwidth [expr 1.0 - $fr]
    place $aw.af.lrhn -relx $fr -y $lrhny -width 8 -height 8 -anchor center
  }
  
  xth_ctrl_create $aname
  
}


proc xth_app_clock {} {
  global xth
  set xth(gui,clock) [clock format [clock seconds] -format "%H:%M"]
  after 15000 xth_app_clock
}


proc xth_app_place {aname} {
  
  global xth
  set aw "$xth(gui,main).$aname"

  set fr $xth(app,$aname,relw)
  set minfr $xth(app,$aname,wmwd)
  if {$fr < $minfr} {
    set fr $minfr
  } elseif {$fr > ([winfo width $xth(gui,main)] - $xth(app,$aname,wmwd))} {
    set fr [expr {([winfo width $xth(gui,main)] - $xth(app,$aname,wmwd))}]
  }
  set xth(app,$aname,relw) $fr
  set fr [expr 1.0 - $fr / double([winfo width $xth(gui,main)])]

  set lrhny [expr [winfo height $xth(gui,main)] - 64]
  
  if {$xth(app,$aname,wpsw) == 1} {
    place configure $aw.af.apps -relx 0 -relwidth $fr
    place configure $aw.af.ctrl -relx $fr -relwidth [expr 1.0 - $fr]
    place configure $aw.af.lrhn -relx $fr -y $lrhny
  } else {
    place configure $aw.af.apps -relx [expr 1.0 - $fr] -relwidth $fr
    place configure $aw.af.ctrl -relx 0 -relwidth [expr 1.0 - $fr]
    place configure $aw.af.lrhn -relx [expr 1.0 - $fr] -y $lrhny
  }

  xth_ctrl_reshape $aname   
}

proc xth_app_switch {} {

  global xth
  
  set aname $xth(app,active)
  
  if {$xth(app,$aname,wpsw) == 1} {
    set xth(app,$aname,wpsw) 0
  } else {
    set xth(app,$aname,wpsw) 1
  }
  
  xth_app_place $aname
}


proc xth_app_finish {} {

  global xth
  
  # add Window menu to each menu
  set m "$xth(gui,main).wmenu"
  menu $m -tearoff 0
  set i 0
  
  set xth(gui,menu,window) $m

  foreach aname $xth(app,list) {

    if {[llength $xth(app,list)] > 1} {
      set i [expr $i + 1]
      $m add command -label $xth($aname,title) -accelerator "F$i" \
        -command "xth_app_show $aname" -font $xth(gui,lfont)
      bind $xth(gui,main) <F$i> "xth_app_show $aname"
    }
    
    # add clock to aname
    set clockbar $xth(gui,$aname).sf.clockbar
    label $clockbar -textvariable xth(gui,clock) -anchor center \
      -relief sunken -font $xth(gui,lfont) -width 5
    pack $clockbar -side left

  }
  if {[llength $xth(app,list)] > 1} {
    $m add separator
  }
  $m add command -label "Maximize" -underline 1 \
      -command "xth_app_maximize" -font $xth(gui,lfont)
  $m add command -label "Normalize" -underline 1 \
      -command "xth_app_normalize" -font $xth(gui,lfont)
  $m add command -label "Switch panels" -underline 1 \
      -command "xth_app_switch" -font $xth(gui,lfont)
  $m add separator
  
  menu $m.kbes -tearoff 0
  set encnames [encoding names]
  set xth(encoding_system) [encoding system]
  foreach ecd [lsort $xth(kbencodings)] {
    if {[lsearch $encnames $ecd] >= 0} {
      $m.kbes add radiobutton -label $ecd \
        -command "encoding system $ecd\nset xth(encoding_system) \[encoding system\]" -font $xth(gui,lfont) \
        -variable xth(encoding_system) -value $ecd
    }
  }
  $m add cascade -label "KBD encoding" -menu $m.kbes
  

  if {$xth(debug)} {
    set dm "$xth(gui,main).dmenu"
    menu $dm -tearoff 0
  
    $dm add command -label "Refresh procs" -underline 0 -command {
      source global.tcl
      source sbar.tcl
      source cp_procs.tcl
      source te_sdata.tcl
      source me_imgs.tcl
      source me_cmds.tcl
      source me_cmds2.tcl
      source me_ss.tcl
      source bac.tcl
      source mv_procs.tcl
    } -font $xth(gui,lfont)
    $dm add command -label "Screen dump" -underline 0 -command {
      after 5000 {xwd -out screendump -frame}
    } -font $xth(gui,lfont)
    $dm add separator
    $dm add command -label "Show command console" -underline 1 \
      -command "wm deiconify $xth(gui,dbg); wm transient $xth(gui,dbg) $xth(gui,main)" -font $xth(gui,lfont)
    $dm add command -label "Hide command console" -underline 1 \
      -command "wm withdraw $xth(gui,dbg)" -font $xth(gui,lfont)
  }

  bind $xth(gui,main) <$xth(kb_control)-Key-q> "xth_exit"
  bind $xth(gui,main) <$xth(kb_control)-Key-o> xth_app_control_o 
  bind $xth(gui,main) <$xth(kb_control)-Key-r> xth_app_control_r 
  bind $xth(gui,main) <$xth(kb_control)-Key-w> xth_app_control_w
  bind $xth(gui,main) <$xth(kb_control)-Key-s> xth_app_control_s 
  bind $xth(gui,main) <$xth(kb_control)-Key-z> xth_app_control_z
  bind $xth(gui,main) <$xth(kb_control)-Key-y> xth_app_control_y 
  bind $xth(gui,main) <$xth(kb_control)-Key-p> xth_app_control_p 
  bind $xth(gui,main) <$xth(kb_control)-Key-l> xth_app_control_l 
  bind $xth(gui,main) <$xth(kb_control)-Key-d> xth_app_control_d
  bind $xth(gui,main) <$xth(kb_control)-Key-a> xth_app_control_a
  bind $xth(gui,main) <Prior> xth_app_pgup
  bind $xth(gui,main) <Next> xth_app_pgdn
  bind $xth(gui,main) <Shift-Prior> xth_app_shift_pgup
  bind $xth(gui,main) <Shift-Next> xth_app_shift_pgdn
  bind $xth(gui,main) <Key-Escape> xth_app_escape 
  bind $xth(gui,main) <F9> xth_app_make
  foreach aname $xth(app,list) {
    $xth($aname,menu) add cascade -label "Window" -menu $m -underline 0 \
      -font $xth(gui,lfont)
    if $xth(debug) {
      $xth($aname,menu) add cascade -label "Debug" -menu $dm -underline 0 \
        -font $xth(gui,lfont)
    }
    $xth($aname,menu,file) add separator
    $xth($aname,menu,file) add command -label "Compile" -underline 0 \
      -command "xth_app_make" -font $xth(gui,lfont) \
      -accelerator "F9"
    $xth($aname,menu,file) add command -label "Quit" -underline 0 \
      -command "xth_exit" -font $xth(gui,lfont) \
      -accelerator "$xth(gui,controlk)-q"
    $xth($aname,menu) add cascade -label "Help" -menu $xth(gui,menu,help) \
      -underline 0  -font $xth(gui,lfont)
  }  

}

proc xth_app_title {aname} {
  
  global xth
  
  # set the application menu
  set ofn ""
  if {[info exists xth($aname,open_file)]} {
    set ofn $xth($aname,open_file)
  }
  if {[string length $xth($aname,wtitle)] > 0} {
    set atit " $xth($aname,wtitle)"
  } else {
    set atit ""
  }
  if {[string equal $aname me] && ([string length $xth(me,curscrap)] > 0)} {
    set sname " - $xth(me,curscrap)"
  } else {
    set sname ""
  }
  if {[string length $ofn] > 0} {
    wm title $xth(gui,main) "$xth(prj,name)$atit - $xth($aname,open_file)$sname"
  } else {
    wm title $xth(gui,main) "$xth(prj,name)$atit$sname"
  }
}

proc xth_app_control_o {} {

  global xth

  # puts $xth(app,active)  
  switch $xth(app,active) {
    te  {xth_te_open_file 1 {} 1}
    me  {xth_me_open_file 1 {} 1}
    cp  {
      set xth(cp,updcf) 0
      xth_cp_open_file {}
    }
    mv {xth_mv_open_file {}}
  }
}  


proc xth_app_pgup {} {
  global xth
  switch $xth(app,active) {
    te  {}
    me  {
      $xth(gui,main).me.af.ctrl.c yview scroll -1 pages
    }
    cp  {}
    mv {}
  }
}

proc xth_app_pgdn {} {
  global xth
  switch $xth(app,active) {
    te  {}
    me  {
      $xth(gui,main).me.af.ctrl.c yview scroll 1 pages
    }
    cp  {}
    mv {}
  }
}

proc xth_app_shift_pgup {} {
  global xth
  switch $xth(app,active) {
    te  {}
    me  {
      $xth(ctrl,me,cmds).cl.l yview scroll -1 pages
    }
    cp  {}
    mv {}
  }
}


proc xth_app_shift_pgdn {} {
  global xth
  switch $xth(app,active) {
    te  {}
    me  {
      $xth(ctrl,me,cmds).cl.l yview scroll 1 pages
    }
    cp  {}
    mv {}
  }
}


proc xth_app_control_a {} {

  global xth

  # puts $xth(app,active)  
  switch $xth(app,active) {
    te  {}
    me  {
      xth_me_cmds_create_area {} 1 "" "" ""
      xth_ctrl_scroll_to me ac
      xth_ctrl_maximize me ac
    }
    cp  {}
    mv {}
  }
}  


proc xth_app_control_r {} {

  global xth

  # puts $xth(app,active)  
  switch $xth(app,active) {
    te  {}
    me  {
      xth_me_cmds_create_scrap {} 1 "" ""
      xth_ctrl_scroll_to me scrap
      xth_ctrl_maximize me scrap
    }
    
    cp  {}
    mv {xth_mv_reload_file}
  }
}  


proc xth_app_control_w {} {

  global xth

  # puts $xth(app,active)  
  switch $xth(app,active) {
    me  {xth_me_close_file}
    cp  {xth_cp_close_file}
  }
}  

proc xth_app_control_s {} {

  global xth

  # puts $xth(app,active)  
  switch $xth(app,active) {
    me  {xth_me_save_file 0}
  }
}  


proc xth_app_control_z {} {

  global xth

  # puts $xth(app,active)  
  switch $xth(app,active) {
    me  {xth_me_unredo_undo}
  }
  
}  

proc xth_app_control_y {} {

  global xth

  # puts $xth(app,active)  
  switch $xth(app,active) {
    me  {xth_me_unredo_redo}
  }
}  

proc xth_app_control_p {} {
  global xth
  switch $xth(app,active) {
    me  {xth_me_cmds_set_mode 1}
  }
}  


proc xth_app_control_d {} {
  global xth
  switch $xth(app,active) {
    me  {xth_me_cmds_delete {}}
  }
}  


proc xth_app_control_l {} {
  global xth
  switch $xth(app,active) {
    me  {
      xth_me_cmds_create_line {} 1 "" "" ""
      xth_ctrl_scroll_to me line
      xth_ctrl_maximize me line
      xth_ctrl_maximize me linept
    }
  }
}  


proc xth_app_escape {} {
  global xth
  switch $xth(app,active) {
    me  {xth_me_cmds_set_mode 0}
  }
}


proc xth_app_show {aname} {

  global xth
  
  if {[string equal $xth(app,active) $aname]} {
    return;
  }
  
  if {![string equal $xth(app,active) ""]} {
    pack forget $xth(gui,$xth(app,active))
  }

  set xth(app,active) $aname
  pack $xth(gui,$aname) -expand yes -fill both

  xth_app_title $aname

  $xth(gui,main) configure -menu $xth($aname,menu)
  
  regexp {([0-9]+)x([0-9]+)} [winfo geometry $xth(gui,main)] geom xsize ysize

  if {($xsize < [lindex $xth(gui,minsize) 0]) || \
      ($ysize < [lindex $xth(gui,minsize) 1])} {
    if {($xsize < [lindex $xth(gui,minsize) 0])} {
      set xsize [lindex $xth(gui,minsize) 0]
    }
    if {($ysize < [lindex $xth(gui,minsize) 1])} {
      set ysize [lindex $xth(gui,minsize) 1]
    }
    set ogeom [winfo geometry $xth(gui,main)]
    regsub $geom $ogeom [format "%sx%s" $xsize $ysize] ngeom
    wm geometry $xth(gui,main) $ngeom
  }

  update idletasks  
  xth_ctrl_reshape $aname
}


proc xth_exit {} {

  global xth

  # save all open text editor files
  if {![info exists xth(te,flist)]} {
    set xth(te,flist) {}
  }
  
  foreach cfid $xth(te,flist) {
    if {[xth_te_before_close_file $cfid yesnocancel] == 0} {
      return
    }
  }
  
  if {[info exists xth(me,fopen)]} {
    if {$xth(me,fopen) == 1} {
      if {[xth_me_before_close_file yesnocancel] == 0} {
        return
      }
    }
  }

  if {[info exists xth(cp,fopen)]} {
    xth_cp_close_file
  }
  
  destroy $xth(gui,main)
  update
  destroy .    
  
}


proc xth_app_maximize {} {
  global xth
  set swd [winfo screenwidth $xth(gui,main)]
  set shg [winfo screenheight $xth(gui,main)]
  wm geometry $xth(gui,main) [format "%dx%d+0+0" $swd $shg]
  update idletasks
  regexp {([0-9]+)x([0-9]+)\+([0-9]+)\+([0-9]+)} [winfo geometry $xth(gui,main)] geom xsize ysize xshft yshft
  wm geometry $xth(gui,main) [format "%dx%d+0+0" [expr $swd - $xshft] [expr $shg - $yshft]]
  update idletasks
}

proc xth_app_normalize {} {
  global xth
  set twd [expr int(0.8 * [winfo screenwidth $xth(gui,main)])]
  if {$twd < [lindex $xth(gui,minsize) 0]} {
    set twd [lindex $xth(gui,minsize) 0]
  }
  set thg [expr int(0.8 * [winfo screenheight $xth(gui,main)])]
  if {$thg < [lindex $xth(gui,minsize) 1]} {
    set thg [lindex $xth(gui,minsize) 1]
  }
  set tpx [expr int(0.5 * ([winfo screenwidth $xth(gui,main)] - $twd))]
  set tpy [expr int(0.5 * ([winfo screenheight $xth(gui,main)] - $thg))]
  wm geometry $xth(gui,main) [format "%dx%d+%d+%d" $twd $thg $tpx $tpy]
  update idletasks
  regexp {([0-9]+)x([0-9]+)\+([0-9]+)\+([0-9]+)} [winfo geometry $xth(gui,main)] geom xsize ysize xshft yshft
  wm geometry $xth(gui,main) [format "%dx%d+%d+%d" [expr $twd - $xshft + $tpx] \
    [expr $thg - $yshft + $tpy] $tpx $tpy]
  update idletasks
}

proc xth_app_clipboard {ev} {
  global xth
  set w [focus -lastfor $xth(gui,main)]
  if {[winfo ismapped $w]} {
    switch $ev {
      cut {
         event generate $w <<Cut>>
      }
      copy {
         event generate $w <<Copy>>
      }
      paste {
         event generate $w <<Paste>>
      }
      undo {
         event generate $w <<Undo>>
      }
      redo {
         event generate $w <<Redo>>
      }
    }
  }
}


proc xth_app_check_text_undo_redo {} {
  global xth
  catch {
    set w [focus -lastfor $xth(gui,main)]
    if {[winfo ismapped $w]} {
      catch {
        $w edit separator
      }
    }
  }
  after idle {after 1000 xth_app_check_text_undo_redo}
}

if {$xth(gui,text_undo)} {
  after idle {after 1000 xth_app_check_text_undo_redo}
}


proc xth_app_make {} {
  global xth
  set oactive $xth(app,active)
  xth_te_save_all
  xth_me_save_file 0
  switch $oactive {
    cp {}
    default {
      set xth(cp,updcf) 0
      xth_app_show cp
    }
  }
  if {!$xth(cp,fopen)} {
    xth_cp_open_file {}
  }
  update idletasks
  if {[xth_cp_compile]} {
    if {[string equal $xth(gui,platform) windows]} {
      xth_app_show te
      xth_app_show me
      xth_app_show cp
    }
    if {![string equal $oactive cp]} {
      xth_app_show $oactive
    }
  }
}


proc xth_app_autosave_schedule {} {
  global xth
  if $xth(gui,auto_save) {
    set xth(gui,auto_save,id) [after 60000 xth_app_autosave]
  } else {
    catch {
      after cancel $xth(gui,auto_save,id)
    }
  }
}

proc xth_app_autosave {} {
  global xth
  switch $xth(app,active) {
    me {xth_me_save_file 0}
    te {xth_te_save_all}
  }
  xth_app_autosave_schedule
}










xth_about_status "loading text editor ..."

if {[string equal -nocase $xth(prj,name) svxedit]} {
  xth_app_create te {}
} else {
  xth_app_create te "Text Editor"
}

xth_ctrl_add te files "Files"
xth_ctrl_add te sdata "Data table"
xth_ctrl_add te sr "Search & Replace"
xth_ctrl_finish te

set xth(te,open_file_encoding) $xth(app,fencoding)

set xth(te,bind,text_tab) {
  if { [string equal [%W cget -state] "normal"] } {
    xth_te_insert_tab %W
    break
  }
}

set xth(te,bind,text_return) {
  regexp {(\d+)\.} [%W index insert] dum cln
  set spcs ""
  regexp {^\s+} [%W get $cln.0 $cln.end] spcs
  set spcsc [string length $spcs]
  set indct [string length [xth_te_get_indent %W $cln.0 1]]
  if {$spcsc == $indct} {
  } elseif {$spcsc > $indct} {
    %W delete $cln.0 $cln.[expr $spcsc - $indct]
  } elseif {$spcsc < $indct} {
    %W insert $cln.0 [format \x25[expr $indct - $spcsc]s " "]
  }
  xth_te_insert_text %W "\n[xth_te_get_indent %W [expr $cln + 1].0 0]"
}


proc xth_te_insert_text {w s} {
    if {[string equal $s ""] || [string equal [$w cget -state] "disabled"]} {
	return
    }
    set compound 0
    catch {
	if {[$w compare sel.first <= insert] \
		&& [$w compare sel.last >= insert]} {
            set oldSeparator [$w cget -autoseparators]
            if { $oldSeparator } {
                $w configure -autoseparators 0
                $w edit separator
                set compound 1
            }
	    $w delete sel.first sel.last
	}
    }
    $w insert insert $s
    $w see insert
    if { $compound && $oldSeparator } {
        $w edit separator
        $w configure -autoseparators 1
    }
}


proc xth_te_insert_tab W {
  global xth
  regexp {\.(\d+)} [$W index insert] dum col
  set nsp [expr $xth(gui,etabsize) - ($col % $xth(gui,etabsize))]
  xth_te_insert_text $W  [format \x25$nsp\s " "]
  focus $W
}


proc xth_te_sdata_enable {w} {
  global xth
  if {[string length $w] < 1} {
    set w $xth(ctrl,te,sdata)
  }
  set chlist [winfo children $w]
  if {[llength $chlist] > 0} {
    foreach sdw $chlist {
      catch {$sdw configure -state normal}
      catch {xth_te_sdata_enable $sdw}
    }
  }
}

proc xth_te_sdata_disable {w} {
  global xth
  if {[string length $w] < 1} {
    set w $xth(ctrl,te,sdata)
  }
  set chlist [winfo children $w]
  if {[llength $chlist] > 0} {
    foreach sdw $chlist {
      catch {$sdw configure -state disabled}
      catch {xth_te_sdata_disable $sdw}
    }
  }
}


set xth(te,flist) {}
set xth(te,fcurr) -1
set xth(te,fltid) 0

# create position bar
set pbar $xth(gui,te).sf.pbar
label $pbar -text "2.0" -width 8 -relief sunken -font $xth(gui,lfont)
pack $pbar -side left


# file control
frame $xth(ctrl,te,files).fl
set flbox $xth(ctrl,te,files).fl.flbox 
listbox $flbox -height 6 -selectmode single -takefocus 1 \
  -yscrollcommand "xth_scroll $xth(ctrl,te,files).fl.sv" \
  -xscrollcommand "xth_scroll $xth(ctrl,te,files).fl.sh" \
  -font $xth(gui,lfont) -exportselection no \
  -selectborderwidth 1

scrollbar $xth(ctrl,te,files).fl.sv -orient vert  -command "$flbox yview" \
  -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
scrollbar $xth(ctrl,te,files).fl.sh -orient horiz  -command "$flbox xview" \
  -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
frame $xth(ctrl,te,files).ef

  
bind $flbox <<ListboxSelect>> "xth_te_show_file \[lindex \[%W curselection\] 0\]"

grid columnconf $xth(ctrl,te,files).fl 0 -weight 1
grid rowconf $xth(ctrl,te,files).fl 0 -weight 1
grid $flbox -column 0 -row 0 -sticky news
xth_scroll_showcmd $xth(ctrl,te,files).fl.sv "grid $xth(ctrl,te,files).fl.sv -column 1 -row 0 -sticky news"
xth_scroll_hidecmd $xth(ctrl,te,files).fl.sv "grid forget $xth(ctrl,te,files).fl.sv"
xth_scroll_showcmd $xth(ctrl,te,files).fl.sh "grid $xth(ctrl,te,files).fl.sh -column 0 -row 1 -sticky news"
xth_scroll_hidecmd $xth(ctrl,te,files).fl.sh "grid forget $xth(ctrl,te,files).fl.sh"
xth_status_bar te $flbox "Switch open files."
grid columnconf $xth(ctrl,te,files) 0 -weight 1
grid $xth(ctrl,te,files).fl -column 0 -row 0 -sticky news
if {![string equal -nocase $xth(prj,name) svxedit]} {
grid $xth(ctrl,te,files).ef -column 0 -row 1 -sticky news
}
Label $xth(ctrl,te,files).ef.ecl -text Encoding -anchor e -font $xth(gui,lfont) -state disabled
ComboBox $xth(ctrl,te,files).ef.ecb -values $xth(encodings) \
  -textvariable xth(te,open_file_encoding) \
  -font $xth(gui,lfont) -height 4 -command xth_te_set_encoding \
  -state disabled
Button $xth(ctrl,te,files).ef.chb -text "Change to" -anchor e -font $xth(gui,lfont) -padx 1 -state disabled -command xth_te_set_encoding
Label $xth(ctrl,te,files).ef.cel -text "" -anchor w -padx 2 -font $xth(gui,lfont) -state disabled
#grid columnconf $xth(ctrl,te,files).ef 0 -weight 0
grid columnconf $xth(ctrl,te,files).ef 1 -weight 1
grid $xth(ctrl,te,files).ef.ecl -column 0 -row 0 -sticky news
grid $xth(ctrl,te,files).ef.cel -column 1 -row 0 -sticky news
grid $xth(ctrl,te,files).ef.chb -column 0 -row 1 -sticky news
grid $xth(ctrl,te,files).ef.ecb -column 1 -row 1 -sticky ew
xth_status_bar te $xth(ctrl,te,files).ef "To set file encoding, type encoding name and press <Change> button."

frame $xth(gui,te).af.apps.ff -bg $xth(gui,ecolorbg)
pack $xth(gui,te).af.apps.ff -fill both -expand yes



# table control
Button $xth(ctrl,te,sdata).sfb -text "Scan data format" \
  -font $xth(gui,lfont) -state disabled
xth_status_bar te $xth(ctrl,te,sdata).sfb \
  "Scan data format and rebuild centerline data insertion tool."

checkbutton $xth(ctrl,te,sdata).sfs -text "Enter station names" -anchor w \
  -font $xth(gui,lfont) -variable xth(te,sdata,es) -state disabled
xth_status_bar te $xth(ctrl,te,sdata).sfs \
  "Check if you want to insert station names for each shot."

frame $xth(ctrl,te,sdata).sdf

button $xth(ctrl,te,sdata).taf -text "Auto format selection" \
  -font $xth(gui,lfont) -state disabled
xth_status_bar te $xth(ctrl,te,sdata).taf "Format selection to given table."

grid columnconf $xth(ctrl,te,sdata) 0 -weight 1
grid $xth(ctrl,te,sdata).sfb -column 0 -row 0 -sticky nsew
grid $xth(ctrl,te,sdata).sdf -column 0 -row 1 -sticky nsew
grid $xth(ctrl,te,sdata).sfs -column 0 -row 2 -sticky nsew
grid $xth(ctrl,te,sdata).taf -column 0 -row 3 -sticky nsew




set sfm $xth(ctrl,te,sr)

set xth(ctrl,te,sr,selection_io) 0
set xth(ctrl,te,sr,search) ""
set xth(ctrl,te,sr,replace_io) 0
set xth(ctrl,te,sr,replace) ""
set xth(ctrl,te,sr,case_io) 0
set xth(ctrl,te,sr,regular_io) 0
set xth(ctrl,te,sr,selection_io) 0

set xth(ctrl,te,sr,selection_start) {}
set xth(ctrl,te,sr,selection_end) {}
set xth(ctrl,te,sr,search_end) end

Label $sfm.seal -text "search" -anchor w -font $xth(gui,lfont) -state disabled \
  -width 4
xth_status_bar te $sfm.seal "Search expression."
Entry $sfm.seae -font $xth(gui,lfont) -state disabled -width 4 \
  -textvariable xth(ctrl,te,sr,search)
xth_status_bar te $sfm.seae "Search expression."

checkbutton $sfm.replc -text replace -anchor w -font $xth(gui,lfont) \
  -state disabled -width 4 \
  -variable xth(ctrl,te,sr,replace_io) \
  -command {}
xth_status_bar te $sfm.replc "Check whether to replace found expression."
Entry $sfm.reple -font $xth(gui,lfont) -state disabled -width 4 \
  -textvariable xth(ctrl,te,sr,replace)
xth_status_bar te $sfm.reple "Replace expression."

checkbutton $sfm.ccase -text "case sensitive search" -anchor w -font $xth(gui,lfont) \
  -state disabled -width 0 \
  -variable xth(ctrl,te,sr,case_io) \
  -command {}
xth_status_bar te $sfm.ccase "Check if search should be case sensitive."

checkbutton $sfm.creg -text "regular expressions" -anchor w -font $xth(gui,lfont) \
  -state disabled -width 0 \
  -variable xth(ctrl,te,sr,regular_io) \
  -command {}
xth_status_bar te $sfm.creg "Check whether to evaluate search and replace as regular expressions."

checkbutton $sfm.csel -text "search selection only" -anchor w -font $xth(gui,lfont) \
  -state disabled -width 0 \
  -variable xth(ctrl,te,sr,selection_io) \
  -command {}
xth_status_bar te $sfm.csel "Check whether to do search only in selected text."

Button $sfm.bfirst -text "First" -anchor center -font $xth(gui,lfont) \
  -state disabled -width 4 -command te_sr_first
xth_status_bar te $sfm.bfirst "Search or replace first expression in the file."
Button $sfm.bnext -text "Next" -anchor center -font $xth(gui,lfont) \
  -state disabled -width 4 -command te_sr_next
xth_status_bar te $sfm.bnext "Search or replace next expression after the cursor in the file."
Button $sfm.ball -text "All" -anchor center -font $xth(gui,lfont) \
  -state disabled -width 4 -command te_sr_all
xth_status_bar te $sfm.ball "Search or replace all expressions in the file."
Button $sfm.bclear -text "Clear" -anchor center -font $xth(gui,lfont) \
  -state disabled -width 4 -command {
    te_sr_clear
    set xth(ctrl,te,sr,replace_io) 0
    update idletasks
  }
xth_status_bar te $sfm.bclear "Clear all highlights in the file."


grid columnconf $sfm 0 -weight 1
grid columnconf $sfm 1 -weight 1
grid $sfm.seal -row 0 -column 0 -sticky news
grid $sfm.seae -row 1 -column 0 -sticky news
grid $sfm.replc -row 0 -column 1 -sticky news
grid $sfm.reple -row 1 -column 1 -sticky news
grid $sfm.ccase -row 2 -column 0 -columnspan 2 -sticky news
grid $sfm.creg -row 3 -column 0 -columnspan 2 -sticky news
grid $sfm.csel -row 4 -column 0 -columnspan 2 -sticky news
grid $sfm.bfirst -row 5 -column 0 -sticky news
grid $sfm.bnext -row 5 -column 1 -sticky news
grid $sfm.ball -row 6 -column 0 -sticky news
grid $sfm.bclear -row 6 -column 1 -sticky news





proc xth_te_show_file {fidx} {

  global xth
  
  if {$xth(te,fcurr) >= 0} {
    pack forget $xth(te,[lindex $xth(te,flist) $xth(te,fcurr)],frame)
  }
  
  if {$fidx < 0} {
    set fidx 0
  }
  if {$fidx >= [llength $xth(te,flist)]} {
    set fidx [expr [llength $xth(te,flist)] - 1]
  }
  
  set xth(te,fcurr) $fidx
  if {$xth(te,fcurr) >= 0} {
    set cfid [lindex $xth(te,flist) $xth(te,fcurr)]
    pack $xth(te,$cfid,frame) -expand yes -fill both
    $xth(ctrl,te,files).fl.flbox delete $xth(te,fcurr)
    $xth(ctrl,te,files).fl.flbox insert $xth(te,fcurr) "[expr $xth(te,fcurr) + 1]. $xth(te,$cfid,name) ($xth(te,$cfid,path))"
    $xth(ctrl,te,files).fl.flbox see $fidx
    $xth(ctrl,te,files).fl.flbox selection clear 0 end
    $xth(ctrl,te,files).fl.flbox selection set $fidx $fidx
    focus $xth(te,[lindex $xth(te,flist) $xth(te,fcurr)],frame).txt
    set xth(te,open_file) $xth(te,$cfid,name)
    # set xth(te,open_file_encoding) $xth(te,$cfid,encoding)
    $xth(ctrl,te,files).ef.cel configure -text $xth(te,$cfid,encoding)
    $xth(ctrl,te,files).ef.ecl configure -state normal
    $xth(ctrl,te,files).ef.ecb configure -state normal
    $xth(ctrl,te,files).ef.chb configure -state normal
    $xth(ctrl,te,files).ef.cel configure -state normal
    $xth(te,menu) entryconfigure Edit -state normal
    $xth(te,menu,file) entryconfigure "Save" -state normal
    $xth(te,menu,file) entryconfigure "Save as" -state normal
    $xth(te,menu,file) entryconfigure "Save all" -state normal
    $xth(te,menu,file) entryconfigure "Auto save" -state normal
    $xth(te,menu,file) entryconfigure "Close" -state normal
    $xth(ctrl,te,sr).seal configure -state normal
    $xth(ctrl,te,sr).seae configure -state normal
    $xth(ctrl,te,sr).replc configure -state normal
    $xth(ctrl,te,sr).reple configure -state normal
    $xth(ctrl,te,sr).ccase configure -state normal
    $xth(ctrl,te,sr).creg configure -state normal
    $xth(ctrl,te,sr).csel configure -state normal
    $xth(ctrl,te,sr).bfirst configure -state normal
    $xth(ctrl,te,sr).bnext configure -state normal
    $xth(ctrl,te,sr).ball configure -state normal 
    $xth(ctrl,te,sr).bclear configure -state normal
    if {[llength $xth(te,flist)] > 1} {
      $xth(te,menu,file) entryconfigure "Next" -state normal
      $xth(te,menu,file) entryconfigure "Previous" -state normal
    } else {
      $xth(te,menu,file) entryconfigure "Next" -state disabled
      $xth(te,menu,file) entryconfigure "Previous" -state disabled
    }
    xth_te_sdata_enable ""
  } else {
    set xth(te,open_file) ""
    set xth(te,open_file_encoding) $xth(app,fencoding)
    $xth(te,menu,file) entryconfigure "Save" -state disabled
    $xth(te,menu,file) entryconfigure "Save as" -state disabled
    $xth(te,menu,file) entryconfigure "Save all" -state disabled
    $xth(te,menu,file) entryconfigure "Auto save" -state disabled
    $xth(te,menu,file) entryconfigure "Close" -state disabled
    $xth(te,menu,file) entryconfigure "Next" -state disabled
    $xth(te,menu,file) entryconfigure "Previous" -state disabled
    $xth(ctrl,te,files).ef.ecl configure -state disabled
    $xth(ctrl,te,files).ef.ecb configure -state disabled
    $xth(ctrl,te,files).ef.chb configure -state disabled
    $xth(ctrl,te,files).ef.cel configure -state disabled -text ""
    xth_te_sdata_disable ""
    $xth(te,menu) entryconfigure Edit -state disabled
    $xth(ctrl,te,sr).seal configure -state disabled
    $xth(ctrl,te,sr).seae configure -state disabled
    $xth(ctrl,te,sr).replc configure -state disabled
    $xth(ctrl,te,sr).reple configure -state disabled
    $xth(ctrl,te,sr).ccase configure -state disabled
    $xth(ctrl,te,sr).creg configure -state disabled
    $xth(ctrl,te,sr).csel configure -state disabled
    $xth(ctrl,te,sr).bfirst configure -state disabled
    $xth(ctrl,te,sr).bnext configure -state disabled
    $xth(ctrl,te,sr).ball configure -state disabled 
    $xth(ctrl,te,sr).bclear configure -state disabled
    xth_ctrl_minimize te sr
  }
  xth_app_title te
  
}


proc xth_te_set_encoding {} {

  global xth
 
  if {$xth(te,fcurr) >= 0} {
    # convert encoding into system's one
    set rxp "\\s+($xth(te,open_file_encoding))\\s+"
    if {[regexp -nocase $rxp $xth(encodings) dum temp]} {
      set xth(te,open_file_encoding) $temp
      set xth(te,[lindex $xth(te,flist) $xth(te,fcurr)],encoding) $temp
      $xth(ctrl,te,files).ef.cel configure -text $temp
    } else {
      MessageDlg $xth(gui,message) -parent $xth(gui,main) \
        -icon error -type ok \
        -message "uknown encoding -- $xth(te,open_file_encoding)" \
        -font $xth(gui,lfont)
    }
  }
}

proc xth_te_switch_file {fdr} {
  global xth
  set cf $xth(te,fcurr)
  if {$cf != -1} {
    incr cf $fdr
    if {$cf < 0} {
      set cf [expr [llength $xth(te,flist)] - 1]
    }
    if {$cf >= [llength $xth(te,flist)]} {
      set cf 0
    }
    xth_te_show_file $cf
  }
}


proc xth_te_create_file {} {

  global xth
  
  # create file variables
  incr xth(te,fltid)
  set cfid $xth(te,fltid)
  #set xth(te,$cfid,name) [format "noname%d$xth(app,te,fileext)" $cfid]
  set xth(te,$cfid,name) [format "(new file)" $cfid]
  set xth(te,$cfid,path) [file join $xth(gui,initdir) $xth(te,$cfid,name)]
  set xth(te,$cfid,newf) 1
  set xth(te,$cfid,mtime) 0
  set xth(te,$cfid,encoding) $xth(app,fencoding)
  set xth(te,$cfid,frame) $xth(gui,te).af.apps.ff.file$cfid
  set cfr $xth(te,$cfid,frame)

  # create the frame and bind the events
  set iac {if {[string equal $xth(app,active) te]} }
  frame $cfr
  text $cfr.txt  -font $xth(gui,efont) -bg $xth(gui,ecolorbg) \
    -fg $xth(gui,ecolorfg) -insertbackground $xth(gui,ecolorfg) \
    -yscrollcommand "$cfr.sv set" \
    -xscrollcommand "$cfr.sh set" \
    -relief sunken \
    -selectbackground $xth(gui,ecolorselbg) \
    -selectforeground $xth(gui,ecolorselfg) \
    -selectborderwidth 0 \
    -wrap none
  if {$xth(gui,text_undo)} {
    $cfr.txt configure -undo 1 -maxundo -1
  }
  set xth(te,$cfid,otext) [$cfr.txt get 1.0 end]
  scrollbar $cfr.sv -orient vert  -command "$cfr.txt yview" \
    -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
  scrollbar $cfr.sh -orient horiz  -command "$cfr.txt xview" \
    -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
  bind $cfr.txt <Tab> "$iac {$xth(te,bind,text_tab)}"
  bind $cfr.txt <Return> "$iac {$xth(te,bind,text_return)}"
  bind $cfr.txt <<xthPositionChange>> "xth_te_update_position $cfr.txt"
  bind $cfr.txt <Key> "+ $iac {event generate $cfr.txt <<xthPositionChange>> -when tail}"
  bind $cfr.txt <Button-1> "+ $iac {event generate $cfr.txt <<xthPositionChange>> -when tail}"
  bind $cfr.txt <$xth(kb_control)-Key-1> "$iac {xth_te_show_file 0}"
  bind $cfr.txt <$xth(kb_control)-Key-2> "$iac {xth_te_show_file 1}"
  bind $cfr.txt <$xth(kb_control)-Key-3> "$iac {xth_te_show_file 2}"
  bind $cfr.txt <$xth(kb_control)-Key-4> "$iac {xth_te_show_file 3}"
  bind $cfr.txt <$xth(kb_control)-Key-5> "$iac {xth_te_show_file 4}"
  bind $cfr.txt <$xth(kb_control)-Key-6> "$iac {xth_te_show_file 5}"
  bind $cfr.txt <$xth(kb_control)-Key-7> "$iac {xth_te_show_file 6}"
  bind $cfr.txt <$xth(kb_control)-Key-8> "$iac {xth_te_show_file 7}"
  bind $cfr.txt <$xth(kb_control)-Key-9> "$iac {xth_te_show_file 8}"
  bind $cfr.txt <$xth(kb_control)-Key-0> "$iac {xth_te_show_file 9}"
  bind $cfr.txt <$xth(kb_control)-Key-n> "$iac {xth_te_switch_file 1}"
  bind $cfr.txt <$xth(kb_control)-Key-p> "$iac {xth_te_switch_file -1}"
  bind $cfr.txt <$xth(kb_control)-Key-w> "$iac {xth_te_close_file}"
  bind $cfr.txt <$xth(kb_control)-Key-a> "$iac {xth_te_select_all}"
  bind $cfr.txt <$xth(kb_control)-Key-i> "$iac {xth_te_auto_indent}"
  bind $cfr.txt <$xth(kb_control)-Key-s> "$iac {xth_te_save_file 0 $cfid}"
  bind $cfr.txt <Destroy> "xth_te_before_close_file $cfid yesno"  
#  if {$xth(gui,bindclip) == 1} {
    bind $cfr.txt <$xth(kb_control)-Key-x> "$iac {tk_textCut $cfr.txt}"
    bind $cfr.txt <$xth(kb_control)-Key-c> "$iac {tk_textCopy $cfr.txt}"
    bind $cfr.txt <$xth(kb_control)-Key-v> "$iac {tk_textPaste $cfr.txt}"
    bind $cfr.txt <$xth(kb_control)-Key-z> "$iac {catch {$cfr.txt edit undo}}"
    bind $cfr.txt <$xth(kb_control)-Key-y> "$iac {catch {$cfr.txt edit redo}}"
  if {$xth(gui,bindinsdel)} {
    bind $cfr.txt <Shift-Key-Delete> "$iac {tk_textCut $cfr.txt}"
    bind $cfr.txt <$xth(kb_control)-Key-Insert> "$iac {tk_textCopy $cfr.txt}"
    bind $cfr.txt <Shift-Key-Insert> "$iac {tk_textPaste $cfr.txt}"
#    catch {
#      bind $cfr.txt <Shift-Key-KP_Decimal> "$iac {tk_textCut $cfr.txt}"
#      bind $cfr.txt <$xth(kb_control)-Key-KP_Insert> "$iac {tk_textCopy $cfr.txt}"
#      bind $cfr.txt <Shift-Key-KP_0> "$iac {tk_textPaste $cfr.txt}"
#    }
  }
#  }
    
  grid columnconf $cfr 0 -weight 1
  grid rowconf $cfr 0 -weight 1
  grid $cfr.txt -column 0 -row 0 -sticky news
  grid $cfr.sv -column 1 -row 0 -sticky news
  grid $cfr.sh -column 0 -row 1 -sticky news
  
  
  # add file to list and listbox
  set xth(te,flist) [linsert $xth(te,flist) end $cfid]
  $xth(ctrl,te,files).fl.flbox insert end "[llength $xth(te,flist)]. $xth(te,$cfid,name) ($xth(te,$cfid,path))"
  
  xth_te_show_file [expr [llength $xth(te,flist)] - 1]
}


# xth_te_read_file --
#
# return list containing
# {success name encoding text}

proc xth_te_read_file {pth} {

  global errorInfo xth

  set curenc utf-8
  set nm [file tail $pth]
  set encspc 0
  set flnn 0
  set success 1
  set txt ""
  if {[catch {set fid [open $pth r]}]} {
    set success 0
    set nm $errorInfo
    return [list $success $nm $curenc $txt]
  }
  fconfigure $fid -encoding $curenc
  while {[eof $fid] != 1} {
    gets $fid fln
    # replace tabs
    regsub -all {\t} $fln "  " fln
    incr flnn
    if {[regexp {^\s*encoding\s+(\S+)\s*$} $fln encln enc]} {
      if {$encspc} {
        set success 0
        set nm "$pth \[$flnn\] -- multiple encoding commands in file"
        break
      }
      set encspc 1
      set rxp "\\s+($enc)\\s+"
      set validenc [regexp -nocase $rxp $xth(encodings) dum curenc]
      if {$validenc == 0} {
        set success 0
        set nm "$pth \[$flnn\] -- unknown encoding -- $enc"
        break
      }
      fconfigure $fid -encoding $curenc
    } else {
#      if {$encspc == 0} {
#        if {[regexp {^\s*[^\#]+} $fln]} {
#          set success 0
#          set nm "$pth \[$flnn\] -- encoding command expected"
#          break
#        }
#      }
      append txt "$fln\n"
    }
  }
  close $fid
  return [list $success $nm $curenc $txt]
  
}  


# xth_te_write_file --
#
# return list containing
# {success name}

proc xth_te_write_file {pth enc txt} {

  global errorInfo xth

  set curenc utf-8
  set nm [file tail $pth]
  set success 1
  if {[catch {set fid [open $pth w]}]} {
    set success 0
    set nm $errorInfo
    return [list $success $nm]
  }
  
  fconfigure $fid -encoding $curenc -translation {auto lf}
  if {![string equal $xth(prj,name) svxedit]} {
    puts $fid "encoding  $enc"
  }
  fconfigure $fid -encoding $enc -translation {auto lf}
  puts -nonewline $fid $txt
  close $fid
  return [list $success $nm]
  
}


proc xth_te_destroy_file {} {

  global xth

  if {$xth(te,fcurr) >= 0} {
  

    # delete file from list and listbox and destroy windows
    set tempcurr $xth(te,fcurr)
    set cfid [lindex $xth(te,flist) $tempcurr]
    pack forget $xth(te,$cfid,frame)
    set xth(te,flist) [lreplace $xth(te,flist) $xth(te,fcurr) $xth(te,fcurr)]
    $xth(ctrl,te,files).fl.flbox delete $tempcurr    
    set xth(te,fcurr) -1

    # set other window to be active
    xth_te_show_file $tempcurr
    
    # destroy variable
    unset xth(te,$cfid,name)
    unset xth(te,$cfid,path)
    unset xth(te,$cfid,newf)
    unset xth(te,$cfid,encoding)
    unset xth(te,$cfid,frame)
    unset xth(te,$cfid,otext)
  }  
  
}


proc xth_te_open_file {dialogid fname fline} {

  global xth
  
  if {$dialogid} {
    set fname [tk_getOpenFile -filetypes $xth(app,te,filetypes) \
      -parent $xth(gui,main) \
      -initialdir $xth(gui,initdir) -defaultextension $xth(app,te,fileext)]
  }
  
  if {[string length $fname] == 0} {
    return 0
  } else {
    set xth(gui,initdir) [file dirname $fname]
  }
  
  # now let's open file fname
  
  # check if not open exists
  for {set fid 0} {$fid < [llength $xth(te,flist)]} {incr fid} {
    if {[string equal $fname $xth(te,[lindex $xth(te,flist) $fid],path)]} {
      xth_te_show_file $fid
      return 1
    }
  }
  
  # read the file
  xth_status_bar_push te
  xth_status_bar_status te "Opening $fname ..."
  
  set fdata [xth_te_read_file $fname]
  if {[lindex $fdata 0] == 0} {
      MessageDlg $xth(gui,message) -parent $xth(gui,main) \
        -icon error -type ok \
        -message [lindex $fdata 1] \
        -font $xth(gui,lfont)
      xth_status_bar_pop te
      return 0
  }
  
  # show the file
  xth_te_create_file
  set cfid [lindex $xth(te,flist) $xth(te,fcurr)]
  set xth(te,$cfid,name) [lindex $fdata 1]
  set xth(te,$cfid,path) $fname
  set xth(te,$cfid,newf) 0
  set xth(te,$cfid,mtime) [file mtime $fname]
  set xth(te,$cfid,encoding) [lindex $fdata 2]
  $xth(ctrl,te,files).ef.cel configure -text [lindex $fdata 2]
  regsub -all {\s*$} [lindex $fdata 3] "" ftext
  xth_te_insert_text $xth(te,$cfid,frame).txt "$ftext\n"
  catch {
    $xth(te,$cfid,frame).txt edit reset
  }
  set xth(te,$cfid,otext) [$xth(te,$cfid,frame).txt get 1.0 end]
  xth_te_show_file $xth(te,fcurr) 
  $xth(te,$cfid,frame).txt mark set insert "$fline.0"
  $xth(te,$cfid,frame).txt see insert
  if {$fline > 0} {
    $xth(te,$cfid,frame).txt tag remove sel 1.0 end
    $xth(te,$cfid,frame).txt tag add sel "$fline.0" "$fline.0 lineend"
  }
  
  xth_status_bar_pop te
  return 1
}

proc xth_te_before_close_file {cfid btns} {
  global xth
  if {
      [catch {winfo exists $xth(te,$cfid,frame).txt}] 
      || (![winfo exists $xth(te,$cfid,frame).txt])} {
    return 1
  }
  set ftext [$xth(te,$cfid,frame).txt get 1.0 end]
  if {[string compare $xth(te,$cfid,otext) $ftext] != 0} {    
    set wtd [MessageDlg $xth(gui,message) -parent $xth(gui,main) \
      -icon question -type $btns\
      -message "File $xth(te,$cfid,path) is not saved. Save it now?" \
      -font $xth(gui,lfont)]
    switch $wtd {
      0 {
        if {[xth_te_save_file 0 $cfid] == 0} {
          return 0
        }
      }
      1 {}
      default {return 0}
    }
  }
  return 1
}

proc xth_te_close_file {} {

  global xth
  
  if {$xth(te,fcurr) < 0} {
    return
  }
  set cfid [lindex $xth(te,flist) $xth(te,fcurr)]
  if {[xth_te_before_close_file $cfid yesnocancel]} {
    xth_te_destroy_file
    return 1
  } else {
    return 0
  }
  
}

proc xth_te_save_file {dialogid cfid} {

  global xth
  
  if {[llength $xth(te,flist)] == 0} {
    return 0
  }

  set fid [lsearch -exact $xth(te,flist) $cfid]
  if {$fid == -1} {
    return 0
  }
  
  set cfid [lindex $xth(te,flist) $fid]
  
  # let's check if we need to save
  set ftext [$xth(te,$cfid,frame).txt get 1.0 end]
  if {! $dialogid} {
    if {[string compare $xth(te,$cfid,otext) $ftext] == 0} {
        return 1
    }
  }
  
  xth_status_bar_push te
  
  if {$xth(te,$cfid,newf)} {
    set dialogid 1
  }

  set fname $xth(te,$cfid,path)
  set ofname $fname
  if {$dialogid} {
    set fname [tk_getSaveFile -filetypes $xth(app,te,filetypes) \
      -parent $xth(gui,main) \
      -initialfile [file tail $fname] -initialdir [file dirname $fname] \
      -defaultextension $xth(app,te,fileext)]
  }
  
  if {($xth(te,$cfid,mtime) > 0) && [file exists $fname] && \
    ([file mtime $fname] > $xth(te,$cfid,mtime))} {
    set forcesave [MessageDlg $xth(gui,message) -parent $xth(gui,main) \
      -icon warning -type yesno -default 1 \
      -message "File $fname was modified outside xtherion. Save it anyway?" \
      -font $xth(gui,lfont)]
    if {$forcesave != 0} {
      return 0
    }
  }
  
  if {[string length $fname] == 0} {
    return 0
  } else {
    set xth(gui,initdir) [file dirname $fname]
  }
  
  # save the file
  xth_status_bar_status te "Saving $fname ..."
  set fdata [xth_te_write_file $fname $xth(te,$cfid,encoding) $ftext]
  if {[lindex $fdata 0] == 0} {
      MessageDlg $xth(gui,message) -parent $xth(gui,main) \
        -icon error -type ok \
        -message [lindex $fdata 1] \
        -font $xth(gui,lfont)
      xth_status_bar_pop te
      return 0
  }
  
  set xth(te,$cfid,mtime) [file mtime $fname]
  set xth(te,$cfid,otext) $ftext
  set xth(te,$cfid,newf) 0
  
  # if SaveAs, then redisplay the file
  if {$dialogid} {
    if {[string compare $ofname $fname] != 0} {
      set xth(te,$cfid,name) [lindex $fdata 1]
      set xth(te,$cfid,path) $fname
      xth_te_show_file $fid
    }
  }  

  after 250 {xth_status_bar_pop te}
  return 1
    
}

proc xth_te_save_all {} {

  global xth
  set ocur $xth(te,fcurr)
  foreach cfid $xth(te,flist) {
    xth_te_save_file 0 $cfid
  }
  xth_te_show_file $ocur
  
}


proc xth_te_update_position {W} {
  global xth
  regexp {(\d+)\.(\d+)} [$W index insert] dum lns pos
  $xth(gui,te).sf.pbar configure -text [format "%d.%d" [expr $lns + 1] $pos]
}


proc xth_te_text_select_all {txt} {
    $txt tag add sel 1.0 end
}


proc xth_te_select_all {} {
  global xth
  if {$xth(te,fcurr) > -1} {
    set cfid [lindex $xth(te,flist) $xth(te,fcurr)]
    $xth(te,$cfid,frame).txt tag add sel 1.0 end
  }
}


$xth(te,menu,file) add command -label "New" -command xth_te_create_file \
  -font $xth(gui,lfont) -underline 0
$xth(te,menu,file) add command -label "Open" -underline 0 \
  -accelerator "$xth(gui,controlk)-o" \
  -font $xth(gui,lfont) -command {xth_te_open_file 1 {} 1}
$xth(te,menu,file) add command -label "Save" -underline 0 \
  -accelerator "$xth(gui,controlk)-s" -state disabled \
  -font $xth(gui,lfont) -command {
    if {$xth(te,fcurr) >= 0} {
      xth_te_save_file 0 [lindex $xth(te,flist) $xth(te,fcurr)]
    }
  }
$xth(te,menu,file) add command -label "Save as" -underline 5 \
  -font $xth(gui,lfont) -state disabled -command {
    if {$xth(te,fcurr) >= 0} {
      xth_te_save_file 1 [lindex $xth(te,flist) $xth(te,fcurr)]
    }
  }
$xth(te,menu,file) add command -label "Save all" -underline 6 \
  -font $xth(gui,lfont) -state disabled -command xth_te_save_all
$xth(te,menu,file) add checkbutton -label "Auto save" -underline 1 \
  -variable xth(gui,auto_save) -font $xth(gui,lfont) \
  -state disabled -command xth_app_autosave_schedule
$xth(te,menu,file) add command -state disabled -label "Close" -underline 0 \
  -accelerator "$xth(gui,controlk)-w" \
  -font $xth(gui,lfont) \
  -command "xth_te_close_file"

$xth(te,menu,file) add separator
$xth(te,menu,file) add command -state disabled -label "Next" \
  -accelerator "$xth(gui,controlk)-n" \
  -font $xth(gui,lfont) -command "xth_te_switch_file 1" -underline 2
$xth(te,menu,file) add command -state disabled -label "Previous" \
  -accelerator "$xth(gui,controlk)-p" \
  -font $xth(gui,lfont) -command "xth_te_switch_file -1" -underline 0
  
set xth(te,menu,edit) $xth(te,menu).edit
menu $xth(te,menu,edit) -tearoff 0
$xth(te,menu) add cascade -label "Edit" -state disabled \
  -font $xth(gui,lfont) -menu $xth(te,menu,edit) -underline 0
if {$xth(gui,text_undo)} {
  $xth(te,menu,edit) add command -label "Undo" -font $xth(gui,lfont) \
    -accelerator "$xth(gui,controlk)-z" -command "xth_app_clipboard undo"
  $xth(te,menu,edit) add command -label "Redo" -font $xth(gui,lfont) \
    -accelerator "$xth(gui,controlk)-y" -command "xth_app_clipboard redo"
  $xth(te,menu,edit) add separator
}
$xth(te,menu,edit) add command -label "Cut" -font $xth(gui,lfont) \
  -accelerator "$xth(gui,controlk)-x" -command "xth_app_clipboard cut"
$xth(te,menu,edit) add command -label "Copy" -font $xth(gui,lfont) \
  -accelerator "$xth(gui,controlk)-c" -command "xth_app_clipboard copy"
$xth(te,menu,edit) add command -label "Paste" -font $xth(gui,lfont) \
  -accelerator "$xth(gui,controlk)-v" -command "xth_app_clipboard paste"
$xth(te,menu,edit) add separator
$xth(te,menu,edit) add command -label "Select all" -font $xth(gui,lfont) \
  -accelerator "$xth(gui,controlk)-a" -command "xth_te_select_all"
$xth(te,menu,edit) add command -label "Auto indent" -font $xth(gui,lfont) \
  -command "xth_te_auto_indent" -accelerator "$xth(gui,controlk)-i"

proc xth_te_get_indent {w i cilc} {

  global xth
  set indls ""
  set cmdls ""
  set cmd0s ""
  set cmdl 0
  regexp {(\d+)\.} $i dum cln
  set line0 [$w get $cln.0 $cln.end]
  regexp {\S+} $line0 cmd0s
  if {[info exists xth(cmd,$cmd0s)]} {
    set cmd0 $xth(cmd,$cmd0s)
  } else {
    set cmd0 0
  }
  set sln [expr $cln - 1]
  set line1 [$w get $sln.0 $sln.end]
  set linel $line1
  set hasl 0
  set escan 0
  while {($sln > 1) && (! $hasl)} {
    incr sln -1
    if {[regexp {\S} $linel]} {
      set cline [$w get $sln.0 $sln.end]
      if {[regexp {\\\s*$} $cline]} {
        set linel $cline
      } else {
        set hasl 1
      }
    } else {
      set linel [$w get $sln.0 $sln.end]
    }
  }
  regexp {\S+} $linel cmdls
  if {[info exists xth(cmd,$cmdls)]} {
    set cmdl $xth(cmd,$cmdls)
    set endcmdls $xth(endcmd,$cmdls)
  } else {
    set cmdl 0
  }
  regexp {^\s+} $linel indls
  set indl [string length $indls]
  set bsl1 [regexp {\\\s*$} $line1]
  
  # preskenuje prikazy nad
  #puts "cilc |$cilc|\nindl |$indl|\ncmd0 |$cmd0|\ncmd0s |$cmd0s|\ncmdl |$cmdl|\ncmdls |$cmdls|\n"
  if {$cmdl == 1} {
#    puts "$cln. cilc |$cilc|"
    set cmdcomct 0
    set cmdcomctfi 1
    set enddetect 0
    set set_cmd_counts {
      regexp {\S+} $slns cmdcomx
#      puts "$cmdls ?? $cmdcomx"
      if {[string compare $endcmdls $cmdcomx] == 0} {
        set endscan 1
        set enddetect 1
      } elseif {[string compare $cmdls $cmdcomx] == 0} {
        if {! $cmdcomctfi} {
          if {$cmdcomct} {
            set endscan 1
          }
          incr cmdcomct
        } else {
          set cmdcomctfi 0
        }
      }
    }
    set sln [expr $cln - 1]
    set slns $line1
    set endscan 0
    while {($sln > 1) && (!$endscan)} {
      incr sln -1
      if {[regexp {\S} $slns]} {
        set clns [$w get $sln.0 $sln.end]
        if {[regexp {(.*)\\\s*$} $clns dum vlns]} {
          set slns "$vlns$slns"
        } else {
          eval $set_cmd_counts
          set slns $clns
        }
      } else {
        set slns [$w get $sln.0 $sln.end]
      }
    }
    if {!$enddetect} {
      eval $set_cmd_counts
    }
 #   puts $cmdcomct
    if {$cmdcomct > 0} {
      set cmdl 0
    }
  }
  # koniec scanovania
  
  if {$bsl1} {
    set ind [expr $indl + 2 * $xth(gui,etabsize)]
  } else {
    set ind $indl
    if {$cmdl > 0} {
      incr ind $xth(gui,etabsize)
    } 
    if {$cilc && ($cmd0 < 0)} {
      incr ind -$xth(gui,etabsize)
    } 
  }
  
  if {$ind > 0} {
    return [format %$ind\s " "]
  } else {
    return ""
  }
}

proc xth_te_auto_indent {} {

  global xth
  if {$xth(te,fcurr) < 0} {
    return
  }
  set cfid [lindex $xth(te,flist) $xth(te,fcurr)]
  set W $xth(te,$cfid,frame).txt
  set rngs [$W tag ranges sel]
  set fln 1
  set tln -1
  regexp {(\d+)\.} [lindex $rngs 0] dum fln
  regexp {(\d+)\.} [lindex $rngs 1] dum tln
  xth_status_bar_push te
  for {set cln $fln} {$cln < $tln} {incr cln} {
    xth_status_bar_status te "Processing line $cln ..."
    $W see $cln.0
    set spcs ""
    regexp {^\s+} [$W get $cln.0 $cln.end] spcs
    set spcsc [string length $spcs]
    set indct [string length [xth_te_get_indent $W $cln.0 1]]
    if {$spcsc == $indct} {
    } elseif {$spcsc > $indct} {
      $W delete $cln.0 $cln.[expr $spcsc - $indct]
    } elseif {$spcsc < $indct} {
      $W insert $cln.0 [format \x25[expr $indct - $spcsc]s " "]
    }
  }
  $W see insert
  # $W tag remove sel 1.0 end
  xth_status_bar_pop te
}


proc xth_te_text_auto_indent {W} {

  set rngs [$W tag ranges sel]
  set fln 1
  set tln -1
  regexp {(\d+)\.} [lindex $rngs 0] dum fln
  regexp {(\d+)\.} [lindex $rngs 1] dum tln
  for {set cln $fln} {$cln < $tln} {incr cln} {
    $W see $cln.0
    set spcs ""
    regexp {^\s+} [$W get $cln.0 $cln.end] spcs
    set spcsc [string length $spcs]
    set indct [string length [xth_te_get_indent $W $cln.0 1]]
    if {$spcsc == $indct} {
    } elseif {$spcsc > $indct} {
      $W delete $cln.0 $cln.[expr $spcsc - $indct]
    } elseif {$spcsc < $indct} {
      $W insert $cln.0 [format \x25[expr $indct - $spcsc]s " "]
    }
  }
  $W see insert
  
}

xth_ctrl_minimize te sr







proc xth_te_sdata_scan {} {

  global xth
  if {$xth(te,fcurr) < 0} {
    return [list [expr 2 * $xth(gui,etabsize)] {from to compass clino tape}]
  }
  
  set w $xth(te,[lindex $xth(te,flist) $xth(te,fcurr)],frame).txt  

  # let's find the index
  set seli [$w tag ranges sel]
  if {[llength $seli] > 0} {
    set i [lindex $seli 0]
  } else {
    set i [$w index insert]
  }
  
  regexp {(\d+)\.} $i dum cln
  incr cln
  set i [$w index $cln.0]
  regexp {(\d+)\.} $i dum cln
    
  set dind [format \x25[expr 2 * $xth(gui,etabsize)]s " "]
  set dqts {from to compass clino tape}
  set scan_data {
    if {[regexp {(\s*)data\s+\w+\s+(.*)} $slns dum dind dqts]} {
      set endscan 1
    }
  }
  set sln $cln
  set slns ""
  set endscan 0
  while {($sln > 1) && (!$endscan)} {
    incr sln -1
    if {[regexp {\S} $slns]} {
      set clns [$w get $sln.0 $sln.end]
      if {[regexp {(.*)\\\s*$} $clns dum vlns]} {
        set slns "$vlns$slns"
      } else {
        eval $scan_data
        set slns $clns
      }
    } else {
      set slns [$w get $sln.0 $sln.end]
    }
  }
  if {!$endscan} {
    eval $scan_data
  }
  
  return [list [string length $dind] $dqts]     
}


proc xth_te_sdata_buid {qts indc} {

  global xth
  set cf $xth(ctrl,te,sdata).sdf
  catch {destroy $cf}
  frame $cf 
  grid $cf -in $xth(ctrl,te,sdata) -column 0 -row 1 -sticky nsew
  grid columnconf $cf 0 -weight 0
  grid columnconf $cf 1 -weight 1
  grid columnconf $cf 2 -weight 0

  set nent 0
  set invd 0
  set sent 0
  set grow 0
  foreach qtt $qts {
    switch $qtt {
      newline {
        if {(!$invd) && ($nent > 0)} {
          frame $cf.nlf
          grid columnconf $cf.nlf 0 -weight 1
          grid columnconf $cf.nlf 1 -weight 1
          Button $cf.nlf.s$grow -text "Start series" -font $xth(gui,lfont)
          Button $cf.nlf.b$grow -text "Break series" -font $xth(gui,lfont)
          grid $cf.nlf.s$grow -column 0 -row 0 -sticky news
          grid $cf.nlf.b$grow -column 1 -row 0 -sticky news
          grid $cf.nlf -in $cf -column 0 -columnspan 3 -row $grow \
            -sticky news
          set xth(te,sdata,invd,ssb) $cf.nlf.s$grow
          set xth(te,sdata,invd,bsb) $cf.nlf.b$grow
          set xth(te,sdata,invd,ent) $nent
          set invd 1
          incr grow
        }
      }
      default {
        # zistime typ
        if {[info exists xth(datafmt,$qtt,format)]} {
          set tqtt $qtt
        } else {
          set tqtt "unknown"
        }
        set xth(te,sdata,$nent,qtt) $tqtt
        set xth(te,sdata,$nent,format) $xth(datafmt,$tqtt,format)
        set xth(te,sdata,$nent,cvalue) ""
        set xth(te,sdata,$nent,special) $xth(datafmt,$tqtt,special)
        set xth(te,sdata,$nent,de) $cf.de$grow
        set xth(te,sdata,$nent,fe) $cf.fe$grow
        set xth(te,sdata,$nent,nextde) $cf.de$grow
        set xth(te,sdata,$nent,nextvde) $cf.de$grow
        Label $cf.l$grow -text $qtt -anchor e -font $xth(gui,lfont)
        Entry $cf.de$grow -font $xth(gui,lfont) \
          -textvariable xth(te,sdata,$nent,cvalue)
        Entry $cf.fe$grow -font $xth(gui,lfont) -width 6 \
          -textvariable xth(te,sdata,$nent,format)
        bind $cf.de$grow <<xthFocusTo>> "focus $cf.de$grow; $cf.de$grow icursor 0; $cf.de$grow selection range 0 end"
        bind $cf.de$grow <Key-Tab> "event generate \$xth(te,sdata,$nent,nextde) <<xthFocusTo>> -when tail"
        bind $cf.de$grow <Key-Return> "event generate \$xth(te,sdata,$nent,nextvde) <<xthFocusTo>> -when tail"
        bind $cf.de$grow <Key-KP_Enter> "event generate \$xth(te,sdata,$nent,nextvde) <<xthFocusTo>> -when tail"
        grid $cf.l$grow -in $cf -column 0 -row $grow -sticky news
        grid $cf.de$grow -in $cf  -column 1 -row $grow -sticky news
        grid $cf.fe$grow -in $cf  -column 2 -row $grow -sticky news
        incr grow
        incr nent
      }
    }
  }
  
  set xth(te,sdata,nent) $nent
  set xth(te,sdata,indc) $indc
  set xth(te,sdata,invd) $invd
  
  xth_te_sdata_bind
}


proc xth_te_sdata_incr_station {ss} {
  return [xth_incr_station_name $ss 1]
}

proc xth_te_sdata_incr {} {

  global xth
  if {$xth(te,sdata,incr,station) != -1} {
    set xth(te,sdata,$xth(te,sdata,incr,station),cvalue) \
      [xth_te_sdata_incr_station \
      $xth(te,sdata,$xth(te,sdata,incr,station),cvalue)]
  } else {
    if {$xth(te,sdata,incr,from) != -1} {
      if {$xth(te,sdata,incr,to) != -1} {
        set xth(te,sdata,$xth(te,sdata,incr,from),cvalue) \
            $xth(te,sdata,$xth(te,sdata,incr,to),cvalue)
      }
    }
    if {$xth(te,sdata,incr,to) != -1} {
      set xth(te,sdata,$xth(te,sdata,incr,to),cvalue) \
        [xth_te_sdata_incr_station \
        $xth(te,sdata,$xth(te,sdata,incr,to),cvalue)]
    }    
  }
  
}


proc xth_te_sdata_bind {} {

  global xth

  if {! [info exists xth(te,sdata,nent)]} {
    return
  } elseif {$xth(te,sdata,nent) < 1} {
    return
  }

  set xth(te,sdata,incr,station) -1
  set xth(te,sdata,incr,from) -1
  set xth(te,sdata,incr,to) -1
  for {set i 0} {$i < $xth(te,sdata,nent)} {incr i} {
    if {$i != [expr $xth(te,sdata,nent) - 1]} {
      set xth(te,sdata,$i,nextde) $xth(te,sdata,[expr $i + 1],de)
      set xth(te,sdata,$i,nextvde) $xth(te,sdata,[expr $i + 1],de)
    } else {
      set xth(te,sdata,$i,nextde) $xth(te,sdata,0,de)
      set xth(te,sdata,$i,nextvde) $xth(te,sdata,0,de)
    }
    set sx [lsearch {from to station} $xth(te,sdata,$i,qtt)]
    if {$sx != -1} {
      set xth(te,sdata,incr,[lindex {from to station} $sx]) $i
    }
  }
  
  if {! $xth(te,sdata,es)} {
    for {set i 0} {$i < $xth(te,sdata,nent)} {incr i} {
      if {[lsearch {station from to} $xth(te,sdata,$i,qtt)] == -1} {
        for {set j 1} {$j < $xth(te,sdata,nent)} {incr j} {
          set jj [expr ($i + $j) % $xth(te,sdata,nent)]
          if {[lsearch {station from to} $xth(te,sdata,$jj,qtt)] == -1} {
            set xth(te,sdata,$i,nextvde) $xth(te,sdata,$jj,de)
            set j $xth(te,sdata,nent)
          }
        }
      }
    }  
  }
  
  # now let's bind enter keys
  if {$xth(te,sdata,invd)} {
    set wtw1 ""
    set wtw2 ""
    set clw ""
    for {set iet 0} {$iet < $xth(te,sdata,nent)} {incr iet} {
      if {$iet < $xth(te,sdata,invd,ent)} {
        append wtw1 " \$xth(te,sdata,$iet,cvalue)"
      } else {
        append wtw2 " \$xth(te,sdata,$iet,cvalue)"
      }
      if {[lsearch {from to station} $xth(te,sdata,$iet,qtt)] == -1} {
        append clw "set xth(te,sdata,$iet,cvalue) \"\"\n"
      }
    }
    set enter_cmd "xth_te_sdata_insert \"$wtw2\" 2 insert\nxth_te_sdata_insert \"$wtw1\" 1 insert\nxth_te_sdata_incr\n$clw"
    append enter_cmd "event generate \$xth(te,sdata,[expr $xth(te,sdata,nent) - 1],nextvde) <<xthFocusTo>> -when tail"
    bind $xth(te,sdata,[expr $xth(te,sdata,nent) - 1],de) <Return> $enter_cmd
    bind $xth(te,sdata,[expr $xth(te,sdata,nent) - 1],de) <KP_Enter> $enter_cmd

    set enter_cmd "xth_te_sdata_insert \"$wtw1\" 1 insert\nxth_te_sdata_incr\n$clw"
    append enter_cmd "event generate \$xth(te,sdata,[expr $xth(te,sdata,nent) - 1],nextvde) <<xthFocusTo>> -when tail"
    $xth(te,sdata,invd,ssb) configure -command $enter_cmd

    set enter_cmd "xth_te_sdata_insert \"break\" 3 insert\n$clw"
    append enter_cmd "event generate \$xth(te,sdata,0,de) <<xthFocusTo>> -when tail"
    $xth(te,sdata,invd,bsb) configure -command $enter_cmd
    
  } else {
    set wtw ""
    set clw ""
    for {set iet 0} {$iet < $xth(te,sdata,nent)} {incr iet} {
      append wtw " \$xth(te,sdata,$iet,cvalue)"
      if {[lsearch {from to station} $xth(te,sdata,$iet,qtt)] == -1} {
        append clw "set xth(te,sdata,$iet,cvalue) \"\"\n"
      }
    }
    set enter_cmd "xth_te_sdata_insert \"$wtw\" 0 insert\nxth_te_sdata_incr\n$clw"
    append enter_cmd "event generate \$xth(te,sdata,[expr $xth(te,sdata,nent) - 1],nextvde) <<xthFocusTo>> -when tail"
    bind $xth(te,sdata,[expr $xth(te,sdata,nent) - 1],de) <Return> $enter_cmd
    bind $xth(te,sdata,[expr $xth(te,sdata,nent) - 1],de) <KP_Enter> $enter_cmd
  }  
}


$xth(ctrl,te,sdata).sfb configure -command {
  set dil [xth_te_sdata_scan]
  xth_te_sdata_buid [lindex $dil 1] [lindex $dil 0] 
}


$xth(ctrl,te,sdata).sfs configure -command xth_te_sdata_bind


proc xth_te_sdata_insert {data invd iidx} {

  global xth
  if {$xth(te,fcurr) < 0} {
    return
  }

  if {! [info exists xth(te,sdata,nent)]} {
    return
  } elseif {$xth(te,sdata,nent) < 1} {
    return
  }

  set w $xth(te,[lindex $xth(te,flist) $xth(te,fcurr)],frame).txt
  set xth(me,sdata,err_notenought) 0

  set err 0
  if {$xth(gui,etabsize) > 0} {
    set tabspc [format \x25$xth(gui,etabsize)s " "]
  } else {
    set tabspc "  "
  }
  set sent 0
  set eent $xth(te,sdata,nent)
  switch $invd {
    1 {
      set eent $xth(te,sdata,invd,ent)
    }
    2 {
      set sent $xth(te,sdata,invd,ent)
    }
  }
  
  set txt ""
  set fst ""
  set iet $sent
  set tmp $data
  set ldata {}
  while {[string length $tmp] > 0} {
    if {[regexp {\S+} $tmp itm]} {
      lappend ldata $itm
    }
    regsub {\s*\S*\s*} $tmp {} tmp
  }
  if {([llength $ldata] < $eent) && (!$xth(te,sdata,invd))} {
    set xth(me,sdata,err_notenought) 1
  }
  foreach itm $ldata {
    set postwrt 0
    set tobreak 0
    if {$iet < $eent} {
      if {[lsearch -exact $xth(te,sdata,$iet,special) $itm] != -1} {
        set postwrt 1
      } else {
        set curfmt $xth(te,sdata,$iet,format)
        set extfmt 0
        if {[regsub {fx(\s*)$} $curfmt {f\1} curfmt]} {
          set extfmt 1
        }
#        puts "$itm -> $fst\x25$curfmt"
        if {[catch {append txt [format "$fst\x25$curfmt" $itm]}]} {
          set postwrt 1
#          puts "error"
          set err 1
        } elseif {$extfmt == 1} {
          if {[regexp {\.?0+\s*$} $txt txtextend]} {
            set teel [string length $txtextend]
            regsub {\.?0+\s*$} $txt [format \x25[expr $teel]s " "] txt
          }
        }
      }
    } else {
      # ak je dlhsie, uz neformatuj
#      puts $data
      set unfdata $data
      for {set ufi 0} {$ufi < $eent} {incr ufi} {
        regsub {^\s*\S+\s*} $unfdata "" unfdata
      }
      append txt $fst $unfdata
      # append txt [format $fst\x25$xth(datafmt,unknown,format) $itm]
      # set err 1
      set tobreak 1
    }
    
      
    if {$postwrt == 1} {
      if {[regexp {(\d+)\.?(\d*)} $xth(te,sdata,$iet,format) dum nfln nzadc]} {
        set nitm $itm
        if {[string length nzadc] > 0} {
          append nitm [format \x25[expr $nzadc + 1]s " "]
        }
        append txt [format $fst\x25[expr $nfln]s $nitm]
      } else {
        append txt [format $fst\x25$xth(datafmt,unknown,format) $itm]
      }
    }
    
    set fst $tabspc  
    incr iet
    if {$tobreak} {
      break
    }
  }
  
  set cind $xth(te,sdata,indc)
  if {($invd == 2) && (!$err)} {
    if {[regexp {\d+} $xth(te,sdata,0,format) plusindc]} {
      incr cind [expr $plusindc + 1]
    } else {
      incr cind [expr 2 * $xth(gui,etabsize)]
    }
  }
  
  if {($invd == 3) || $err} {
    set txt $data
    regsub {^\s+} $txt "" txt
    regsub {\s+$} $txt "" txt
  }
  
  if {$cind > 0} {
    set txt [format \x25[expr $cind + [string length $txt]]s $txt]  
  }
  
  if {[string compare $iidx insert] == 0} {
    xth_te_insert_text $w "\n$txt"
  } else {
    $w insert $iidx $txt
  }
  catch {
    $w edit separator
  }
  return $err
  
}


proc xth_te_sdata_auto_format {} {

  global xth
  if {$xth(te,fcurr) < 0} {
    return
  }

  if {! [info exists xth(te,sdata,nent)]} {
    return
  } elseif {$xth(te,sdata,nent) < 1} {
    return
  }
  
  set w $xth(te,[lindex $xth(te,flist) $xth(te,fcurr)],frame).txt
  set s [$w tag ranges sel]
  if {[llength $s] < 2} {
    return
  }
  
  set eline -1
  set sline 0
  regexp {(\d+)\.} [lindex $s 0] dum sline 
  regexp {(\d+)\.} [lindex $s 1] dum eline 
  # $w tag remove sel 1.0 end
  set ict 1
  for {set cline $sline} {$cline <= $eline} {incr cline} {
    set txt [$w get $cline.0 $cline.end]
    if {[regexp {\S+} $txt]} {
      set orig [$w get $cline.0 $cline.end]
      $w delete $cline.0 $cline.end
      if {$xth(te,sdata,invd)} {
        set formatres [xth_te_sdata_insert $txt $ict $cline.0]
        if {$formatres == 0} {
          if {$ict == 1} {
            set ict 2
          } else {
            set ict 1
          }
        } else {
          if {[regexp {^\s*break\s*$} $txt]} {
            set xth(me,sdata,err_notenought) 0
            set ict 1
          }
        }
      } else {
        set formatres [xth_te_sdata_insert $txt 0 $cline.0]
      }
      # an error occured
      if {$formatres || $xth(me,sdata,err_notenought)} {
#        puts "inserting >>$orig<<"
        $w delete $cline.0 $cline.end
        $w insert $cline.0 $orig
      }
    }
  }
  $w see insert
}


proc te_sr_reset {} {

  global xth
  if {$xth(te,fcurr) < 0} {
    return
  }
  set w $xth(te,[lindex $xth(te,flist) $xth(te,fcurr)],frame).txt

  set has_sel 0  
  if {$xth(ctrl,te,sr,selection_io)} {
    set seli [$w tag ranges sel]
    if {[llength $seli] > 0} {
      set xth(ctrl,te,sr,selection_start) [lindex $seli 0]
      set xth(ctrl,te,sr,selection_end) [lindex $seli 1]
      set xth(ctrl,te,sr,search_end) [lindex $seli 1]
      $w mark set insert [lindex $seli 0]
      set has_sel 1
    } else {
      set xth(ctrl,te,sr,selection_io) 0
      update idletasks
    }
  }
  
  if {!$has_sel} {
    set xth(ctrl,te,sr,selection_start) {}
    set xth(ctrl,te,sr,selection_end) {}
    set xth(ctrl,te,sr,search_end) end
    $w mark set insert 1.0
  }
  
}


proc te_sr_first {} {
  global xth
  if {$xth(te,fcurr) < 0} {
    return
  }
  if {[string length $xth(ctrl,te,sr,search)] == 0} {
    return
  }
  catch {
    $w edit separator
  }
  set w $xth(te,[lindex $xth(te,flist) $xth(te,fcurr)],frame).txt
  te_sr_clear  
  te_sr_reset
  if {![te_sr_next_next]} {
    bell
  }
  catch {
    $w edit separator
  }
  focus $w
}

proc te_sr_next_next {} {
  global xth
  if {$xth(te,fcurr) < 0} {
    return
  }
  if {[string length $xth(ctrl,te,sr,search)] == 0} {
    return
  }
  set w $xth(te,[lindex $xth(te,flist) $xth(te,fcurr)],frame).txt

  # prehlada text od pozicie kurzora po koniec (vyberu)
  # najde text - (zameni ho) - vyznaci ho a kurzor nastavi za neho
  
  set cnt 0
  set fndcmd "set fnd \[$w search -count cnt"
  if {!$xth(ctrl,te,sr,case_io)} {
    append fndcmd " -nocase"
  }
  if {$xth(ctrl,te,sr,regular_io)} {
    append fndcmd " -regexp"
  }
  append fndcmd { $xth(ctrl,te,sr,search) insert $xth(ctrl,te,sr,search_end)]}
  eval $fndcmd
  
  if {[string length $fnd] > 0} {
    $w mark set insert "$fnd + $cnt chars"
    $w mark set xthsrend "$fnd + $cnt chars"
    # do replace if necessary
    if {$xth(ctrl,te,sr,replace_io)} {
      set ostr [$w get $fnd xthsrend]
      $w delete $fnd xthsrend
      #puts "<<$ostr"
      set nstr $xth(ctrl,te,sr,replace)
      if {$xth(ctrl,te,sr,regular_io)} {
        set repcmd {regsub}
        if {!$xth(ctrl,te,sr,case_io)} {
          append repcmd " -nocase"
        }
        append repcmd { $xth(ctrl,te,sr,search) $ostr $xth(ctrl,te,sr,replace) nstr}
        eval $repcmd
      }
      #puts ">>$nstr"
      $w insert $fnd $nstr
    }
    $w tag add xthsr $fnd xthsrend
    $w tag configure xthsr -background $xth(gui,escolorbg) -foreground $xth(gui,escolorfg)
    $w see insert
    return 1
  } else {
    # uz sme nic nenasli
    return 0
  }  

}

proc te_sr_next {} {
  global xth
  if {$xth(te,fcurr) < 0} {
    return
  }
  if {[string length $xth(ctrl,te,sr,search)] == 0} {
    return
  }
  catch {
    $w edit separator
  }
  set w $xth(te,[lindex $xth(te,flist) $xth(te,fcurr)],frame).txt
  if {![te_sr_next_next]} {
    bell
  }
  catch {
    $w edit separator
  }
  focus $w
}

proc te_sr_all {} {
  global xth
  if {$xth(te,fcurr) < 0} {
    return
  }
  if {[string length $xth(ctrl,te,sr,search)] == 0} {
    return
  }
  catch {
    $w edit separator
  }
  set w $xth(te,[lindex $xth(te,flist) $xth(te,fcurr)],frame).txt
  te_sr_clear  
  te_sr_reset
  if {![te_sr_next_next]} {
    bell
  } else {
    while {[te_sr_next_next]} {}
  }
  catch {
    $w edit separator
  }
  focus $w
}

proc te_sr_clear {} {
  global xth
  if {$xth(te,fcurr) < 0} {
    return
  }
  set w $xth(te,[lindex $xth(te,flist) $xth(te,fcurr)],frame).txt
  $w tag remove xthsr 1.0 end
  focus $w
}







$xth(ctrl,te,sdata).taf configure -command xth_te_sdata_auto_format
xth_te_sdata_buid {from to tape compass clino} [expr 2 * $xth(gui,etabsize)] 
xth_te_sdata_disable ""







set xth(gui,openxp) 0

proc xth_me_image_update_position {} {
  global xth 
  set iidx [lindex [$xth(ctrl,me,images).il.ilbox curselection] 0]
  set imgx [lindex $xth(me,imgs,xlist) $iidx]
  $xth(ctrl,me,images).ic.posln configure -text [format "%.0f:%.0f" \
    [lindex $xth(me,imgs,$imgx,position) 0] \
    [lindex $xth(me,imgs,$imgx,position) 1]]
  set xth(ctrl,me,images,posx) [format "%.0f" [lindex $xth(me,imgs,$imgx,position) 0]]
  set xth(ctrl,me,images,posy) [format "%.0f" [lindex $xth(me,imgs,$imgx,position) 1]]
  update idletasks
}

proc xth_me_image_update_list {} {
  global xth
  set xth(me,imgs,list) {}
  foreach imgx $xth(me,imgs,xlist) {
    if {[string length $xth(me,imgs,$imgx,image)] > 0} {
      set imgw [image width $xth(me,imgs,$imgx,image)]
      set imgh [image height $xth(me,imgs,$imgx,image)]
    } else {
      set imgw "---"
      set imgh "---"
    }
    lappend xth(me,imgs,list) "$xth(me,imgs,$imgx,name) ($imgw x $imgh)"
  }
}


proc xth_me_image_move_to {} {
  global xth
  xth_me_cmds_update {}
  if {$xth(me,nimgs) < 1} {
    return;
  }
  set iidx [lindex [$xth(ctrl,me,images).il.ilbox curselection] 0]
  set imgx [lindex $xth(me,imgs,xlist) $iidx]
  xth_me_unredo_action "moving image" "xth_me_image_move $imgx $xth(me,imgs,$imgx,position); xth_me_image_update_position" \
    "xth_me_image_move $imgx $xth(ctrl,me,images,posx) $xth(ctrl,me,images,posy); xth_me_image_update_position"
  xth_me_image_move $imgx $xth(ctrl,me,images,posx) $xth(ctrl,me,images,posy)
  xth_me_image_update_position
}



proc xth_me_image_move {imgx xx yy} {
  # zisti si aktualne suradnice
  global xth
  if {[catch {expr $xx}]} {
    set xx [lindex $xth(me,imgs,$imgx,position) 0]
  }
  if {[catch {expr $yy}]} {
    set yy [lindex $xth(me,imgs,$imgx,position) 1]
  }
  set xth(me,imgs,$imgx,position) [list $xx $yy]
  xth_me_image_redraw $imgx
}


proc xth_me_image_toggle_vsb {iidx} {
  global xth
  if {$xth(me,nimgs) < 1} {
    return
  }
  set isel [$xth(ctrl,me,images).il.ilbox curselection]
  if {[llength $isel] < 1} {
    return
  }
  if {[string length $iidx] < 1} {
    set iidx [lindex $isel 0]
  }
  set imgx [lindex $xth(me,imgs,xlist) $iidx]

  xth_me_unredo_action "toggle image visibility" "xth_me_image_toggle_vsb $iidx" "xth_me_image_toggle_vsb $iidx"

  switch $xth(me,imgs,$imgx,vsb) {
    0 {
      set xth(me,imgs,$imgx,vsb) 1
      $xth(me,can) itemconfigure $xth(me,imgs,$imgx,image) -state normal
      xth_me_image_rescan $imgx
      xth_me_image_redraw $imgx
      set xth(ctrl,me,images,vis) 1
    }
    1 {
      set xth(me,imgs,$imgx,vsb) 0
      $xth(me,can) itemconfigure $xth(me,imgs,$imgx,image) -state hidden
      set xth(ctrl,me,images,vis) 0
    }
    default {
      set xth(ctrl,me,images,vis) 0
    }
  }
}


proc xth_me_image_set_gamma {imgx} {
  global xth
  if {$xth(me,imgs,$imgx,vsb) <= 0} {
    return
  }
  set ng $xth(me,imgs,$imgx,gamma)
  xth_status_bar_push me
  set totalsi [llength $xth(me,imgs,$imgx,subimgs)]
  set csi 0
  xth_status_bar_status me [format "Correcting image gamma (%s) ..." $xth(me,imgs,$imgx,name)]
  xth_me_progbar_show $totalsi
  foreach imgl $xth(me,imgs,$imgx,subimgs) {
    set dsti [lindex $imgl 0]
    incr csi
    xth_me_progbar_prog $csi
    $dsti configure -gamma $ng
  }
  xth_me_progbar_hide
  xth_status_bar_pop me
}

if {$xth(gui,me,nozoom)} {

proc xth_me_images_rescandraw {} {
  global xth
  if {($xth(me,zoom) > 100) && $xth(gui,me,nozoom)} {
    foreach imgx $xth(me,imgs,xlist) {
      xth_me_image_redraw $imgx
    }
  }
}

proc xth_me_image_redraw {imgx} {
  global xth
  if {$xth(me,imgs,$imgx,vsb) <= 0} {
    return
  }
  set totalsi [llength $xth(me,imgs,$imgx,subimgs)]
  set csi 0
  set x [lindex $xth(me,imgs,$imgx,position) 0]
  set y [lindex $xth(me,imgs,$imgx,position) 1]
  set w [image width $xth(me,imgs,$imgx,image)]
  set h [image height $xth(me,imgs,$imgx,image)]
  # ak je zoom 100 - nastavi image na source image
  # a kasle na ostatne
  if {$xth(me,zoom) <= 100} {
    foreach imgl $xth(me,imgs,$imgx,subimgs) {
      incr csi
      $xth(me,can) coords [lindex $imgl 1] \
        [xth_me_real2canx [expr $x + [lindex $imgl 2]]] \
        [xth_me_real2cany [expr $y - [lindex $imgl 3]]]
    }
  } else {
    # najde si suradnice z obrazka, ktore su viditelne
    set imgl [lindex $xth(me,imgs,$imgx,subimgs) 0]
    set cminx [winfo x $xth(me,can)]
    set cminy [winfo y $xth(me,can)]
    set cmaxx [expr $cminx + [winfo width $xth(me,can)]]
    set cmaxy [expr $cminy + [winfo height $xth(me,can)]]
    set sx [xth_me_can2realx [$xth(me,can) canvasx $cminx]]
    set sw [expr [xth_me_can2realx [$xth(me,can) canvasx $cmaxx]] - $sx]
    set sy [xth_me_can2realy [$xth(me,can) canvasy $cminy]]
    set sh [expr $sy - [xth_me_can2realy [$xth(me,can) canvasy $cmaxy]]]

    # ak je nieco viditelne - tak to zobrazi
    set vfx [expr round($sx - $x)]
    set vfy [expr round($y - $sy)] 
    set vtx [expr round($vfx + $sw)] 
    set vty [expr round($vfy + $sh)]
    if {$vfx < 0} {set vfx 0}
    if {$vfy < 0} {set vfy 0}
    if {$vtx > $w} {set vtx $w}
    if {$vty > $h} {set vty $h}
    
    #puts "$vfx $vfy $vtx $vty"
    if {($vtx <= 0) || ($vty <= 0) || 
        ($vfx >= $w) || ($vfy >= $h) ||
        ($vtx <= $vfx) || ($vty <= $vfy)} {
      # nezobrazime nic
      $xth(me,can) itemconfigure [lindex $imgl 1] -image {}
    } else {
      # zobrazime vyrez
      set dsti [lindex $imgl 0]
      $dsti copy $xth(me,imgs,$imgx,image) -zoom [expr $xth(me,zoom) / 100] -shrink \
        -from $vfx $vfy $vtx $vty
      $xth(me,can) itemconfigure [lindex $imgl 1] -image $dsti
      $xth(me,can) coords [lindex $imgl 1] \
        [xth_me_real2canx [expr $x + $vfx]] \
        [xth_me_real2cany [expr $y - $vfy]]
    }
  }
  update idletasks
}

proc xth_me_image_rescan {imgx} {
  global xth
  if {$xth(me,imgs,$imgx,vsb) <= 0} {
    return
  }
  set srci $xth(me,imgs,$imgx,image)
  xth_status_bar_push me
  set totalsi [llength $xth(me,imgs,$imgx,subimgs)]
  set csi 0
  xth_status_bar_status me [format "Zooming image %s ..." $xth(me,imgs,$imgx,name)]
  xth_me_progbar_show $totalsi
  foreach imgl $xth(me,imgs,$imgx,subimgs) {
    set dsti [lindex $imgl 0]
    incr csi
    xth_me_progbar_prog $csi
    switch $xth(me,zoom) {
      100 {
        $xth(me,can) itemconfigure [lindex $imgl 1] -image $srci
      }
      default {
        $xth(me,can) itemconfigure [lindex $imgl 1] -image $dsti
      }
    }
    switch $xth(me,zoom) {
      25 {$dsti copy $srci -subsample 4 -shrink}
      50 {$dsti copy $srci -subsample 2 -shrink}
      200 {}
      400 {}
      default {}
    }
  }
  xth_me_progbar_hide
  xth_status_bar_pop me
}

# NOZOOMING
} else {

proc xth_me_images_rescandraw {} {
}

proc xth_me_image_redraw {imgx} {
  global xth
  if {$xth(me,imgs,$imgx,vsb) <= 0} {
    return
  }
  set totalsi [llength $xth(me,imgs,$imgx,subimgs)]
  set csi 0
  set x [lindex $xth(me,imgs,$imgx,position) 0]
  set y [lindex $xth(me,imgs,$imgx,position) 1]
  foreach imgl $xth(me,imgs,$imgx,subimgs) {
    incr csi
    $xth(me,can) coords [lindex $imgl 1] \
      [xth_me_real2canx [expr $x + [lindex $imgl 2]]] \
      [xth_me_real2cany [expr $y - [lindex $imgl 3]]]
  }
  update idletasks
}

proc xth_me_image_rescan {imgx} {
  global xth
  if {$xth(me,imgs,$imgx,vsb) <= 0} {
    return
  }
  set srci $xth(me,imgs,$imgx,image)
  xth_status_bar_push me
  set totalsi [llength $xth(me,imgs,$imgx,subimgs)]
  set csi 0
  xth_status_bar_status me [format "Zooming image %s ..." $xth(me,imgs,$imgx,name)]
  xth_me_progbar_show $totalsi
  foreach imgl $xth(me,imgs,$imgx,subimgs) {
    set dsti [lindex $imgl 0]
    incr csi
    xth_me_progbar_prog $csi
    switch $xth(me,zoom) {
      25 {$dsti copy $srci -subsample 4 -shrink -from \
        [lindex $imgl 2] [lindex $imgl 3] [lindex $imgl 4] [lindex $imgl 5]}
      50 {$dsti copy $srci -subsample 2 -shrink -from \
        [lindex $imgl 2] [lindex $imgl 3] [lindex $imgl 4] [lindex $imgl 5]}
      200 {$dsti copy $srci -zoom 2 -shrink -from \
        [lindex $imgl 2] [lindex $imgl 3] [lindex $imgl 4] [lindex $imgl 5]}
      400 {$dsti copy $srci -zoom 4 -shrink -from \
        [lindex $imgl 2] [lindex $imgl 3] [lindex $imgl 4] [lindex $imgl 5]}
      default {$dsti copy $srci -shrink -from \
        [lindex $imgl 2] [lindex $imgl 3] [lindex $imgl 4] [lindex $imgl 5]}
    }
  }
  xth_me_progbar_hide
  xth_status_bar_pop me
}

}
# END NO NOZOOM

proc xth_me_image_insert {xx yy fname iidx imgx} {

  global xth
  
  if {! $xth(me,fopen)} {
    return
  }

  set vsb 1
  set igamma 1.0
  if {[llength $xx] > 1} {
    if {[llength $xx] > 2} {
       set igamma [lindex $xx 2]
    }
    set vsb [lindex $xx 1]
    set xx [lindex $xx 0]
  } 
  

  if {[catch {expr $xx}]} {
    set xx $xth(me,area,xmin)
  }
  if {[catch {expr $yy}]} {
    set yy $xth(me,area,ymax)
  }
  
  set dial_id 0
  if {[string length $fname] < 1} {
  
    if {$xth(me,fnewf)} {
      xth_me_save_file 1
    }
    if {$xth(me,fnewf)} {
      return
    }
    
    set fname [tk_getOpenFile -parent $xth(gui,main) \
       -filetypes $xth(gui,imgfiletypes) \
       -initialdir $xth(me,fpath) -defaultextension ".gif"]  
    if {[string length $fname] < 1} {
      return
    } else {
      # overi ci cesta sedi
      if {![string equal -length [string length $xth(me,fpath)] \
        $xth(me,fpath) $fname]} {
        MessageDlg $xth(gui,message) -parent $xth(gui,main) \
          -icon error -type ok \
          -message "Picture $fname not in file path $xth(me,fpath)." \
          -font $xth(gui,lfont)
        return
      } else {
        set fname [string range $fname [expr [string length $xth(me,fpath)] + 1] end]
        set dial_id 1
      }
    }
  }

    
  xth_status_bar_push me
  xth_status_bar_status me "Loading image file $fname ..."
  set ffname [file join $xth(me,fpath) $fname]
  if {[string length $imgx] < 1} {
    set imgx $xth(me,imgln)
  }
  set imgid {}
	if {!$xth(gui,openxp)} {
	  catch {
	      set imgid [image create photo -file $ffname]
	  } errorinf
  } else {
		set errorinf "excluded picture"
	}
  if {[string length $imgid] < 1} {
    if {$xth(me,unredook)} {
      MessageDlg $xth(gui,message) -parent $xth(gui,main) \
        -icon error -type ok \
        -message "$errorinf" \
        -font $xth(gui,lfont)
    }
    xth_status_bar_pop me
    if {$dial_id} {
      return
    } else {
      set vsb [expr $vsb - 2]
    }
  }

  xth_me_unredo_action "inserting image" "xth_me_image_remove $iidx" "xth_me_image_insert {$xx $vsb} $yy [list $fname] $iidx $imgx"

  incr xth(me,nimgs)
  set xth(me,imgs,xlist) [linsert $xth(me,imgs,xlist) $iidx $imgx]
  set xth(me,imgs,$imgx,name) $fname
  set xth(me,imgs,$imgx,image) $imgid
  set xth(me,imgs,$imgx,position) [list $xx $yy]  
  set xth(me,imgs,$imgx,subimgs) {}
  set xth(me,imgs,$imgx,vsb) $vsb
  set xth(me,imgs,$imgx,gamma) $igamma
  
  
  # let's create image subimages
  if {$vsb >= 0} {
    if {$xth(gui,me,nozoom)} {
      set subimg [image create photo]
      set subcimg [$xth(me,can) create image 0 0 -image $subimg -anchor nw \
        -tags "$imgid bgimg"]
      xth_me_bind_area_drag $subcimg $imgx
      xth_me_bind_image_drag $subcimg $imgx
      set iw [image width $imgid]
      set ih [image height $imgid]
      lappend xth(me,imgs,$imgx,subimgs) [list $subimg $subcimg 0 0 $iw $ih]
      $xth(me,can) lower $xth(me,imgs,$imgx,image) command
      if {$iidx > 0} {
        $xth(me,can) lower $xth(me,imgs,$imgx,image) $xth(me,imgs,[lindex $xth(me,imgs,xlist) [expr $iidx - 1]],image)
      }
    } else {
      set iw [image width $imgid]
      set ih [image height $imgid]
      set subisize 128
      for {set subx 0} {$subx < $iw} {incr subx $subisize} {
        for {set suby 0} {$suby < $ih} {incr suby $subisize} {
          set subxx [expr $subx + $subisize]
          set subyy [expr $suby + $subisize]
          if {$subxx > $iw} {
            set subxx $iw
          }
          if {$subyy > $ih} {
            set subyy $ih
          }
          set subimg [image create photo]
          set subcimg [$xth(me,can) create image 0 0 -image $subimg -anchor nw \
            -tags "$imgid bgimg"]
          xth_me_bind_area_drag $subcimg $imgx
          xth_me_bind_image_drag $subcimg $imgx
          lappend xth(me,imgs,$imgx,subimgs) [list $subimg $subcimg $subx $suby $subxx $subyy]
        }
      }
      $xth(me,can) lower $xth(me,imgs,$imgx,image) command
      if {$iidx > 0} {
        $xth(me,can) lower $xth(me,imgs,$imgx,image) $xth(me,imgs,[lindex $xth(me,imgs,xlist) [expr $iidx - 1]],image)
      }
    }  
  }
  xth_me_image_rescan $imgx
  xth_me_image_redraw $imgx
  xth_me_image_set_gamma $imgx
  xth_me_image_update_list
  xth_me_image_select 0
  incr xth(me,imgln)
  catch {$xth(me,can) raise cmd_ctrl bgimg}
  xth_status_bar_pop me
}


proc xth_me_image_destroy_all {} {
  global xth
  foreach imgx $xth(me,imgs,xlist) {
    unset xth(me,imgs,$imgx,name)
    unset xth(me,imgs,$imgx,position)
    if {[string length $xth(me,imgs,$imgx,image)] > 0} {
      image delete $xth(me,imgs,$imgx,image)
    }
    unset xth(me,imgs,$imgx,image)
    unset xth(me,imgs,$imgx,vsb)
    unset xth(me,imgs,$imgx,gamma)
    foreach silist $xth(me,imgs,$imgx,subimgs) {
      image delete [lindex $silist 0]
      $xth(me,can) delete [lindex $silist 1]
    }
    unset xth(me,imgs,$imgx,subimgs)
  }
  set xth(me,nimgs) 0
  set xth(me,imgln) 0
  set xth(me,imgs,list) {}
  set xth(me,imgs,xlist) {}
}

proc xth_me_image_remove {iidx} {
  global xth
  if {$xth(me,nimgs) < 1} {
    return
  }
  set isel [$xth(ctrl,me,images).il.ilbox curselection]
  if {[llength $isel] < 1} {
    return;
  }
  if {[string length $iidx] < 1} {
    set iidx [lindex $isel 0]
  }
  set imgx [lindex $xth(me,imgs,xlist) $iidx]
  xth_me_unredo_action "removing image" "xth_me_image_insert {[lindex $xth(me,imgs,$imgx,position) 0] $xth(me,imgs,$imgx,vsb) $xth(me,imgs,$imgx,gamma)} [lindex $xth(me,imgs,$imgx,position) 1] [list $xth(me,imgs,$imgx,name)] $iidx $imgx" "xth_me_image_remove $iidx"
  unset xth(me,imgs,$imgx,name)
  unset xth(me,imgs,$imgx,position)
  if {[string length $xth(me,imgs,$imgx,image)] > 0} {
   image delete $xth(me,imgs,$imgx,image)
  }
  unset xth(me,imgs,$imgx,image)
  unset xth(me,imgs,$imgx,vsb)
  unset xth(me,imgs,$imgx,gamma)
  foreach silist $xth(me,imgs,$imgx,subimgs) {
    image delete [lindex $silist 0]
    $xth(me,can) delete [lindex $silist 1]
  }
  unset xth(me,imgs,$imgx,subimgs)
  set xth(me,nimgs) [expr $xth(me,nimgs) - 1]
  set xth(me,imgs,xlist) [lreplace $xth(me,imgs,xlist) $iidx $iidx]
  xth_me_image_update_list
  if {$iidx >= [llength $xth(me,imgs,xlist)]} {
    set iidx end
  }
  xth_me_image_select $iidx
}


proc xth_me_image_move_special {iidx newiidx} {

  global xth  

  if {$iidx == [expr $xth(me,nimgs) - 1]} {
    set iidx $xth(me,nimgs)
  }
  if {$iidx < $xth(me,nimgs)} {
    set iiidx $iidx
    set xiidx $iidx
  } else {
    set iiidx end
    set xiidx [expr $xth(me,nimgs) - 1]
  }
  set imgx [lindex $xth(me,imgs,xlist) $iiidx]

  if {$newiidx < $xth(me,nimgs)} {
    $xth(me,can) raise $xth(me,imgs,$imgx,image) $xth(me,imgs,[lindex $xth(me,imgs,xlist) $newiidx],image)
    set xth(me,imgs,xlist) [linsert [lreplace $xth(me,imgs,xlist) $iiidx $iiidx] $newiidx $imgx]
  } else {
    $xth(me,can) lower $xth(me,imgs,$imgx,image) $xth(me,imgs,[lindex $xth(me,imgs,xlist) end],image)
    set xth(me,imgs,xlist) [linsert [lreplace $xth(me,imgs,xlist) $iiidx $iiidx] end $imgx]
  }  

  xth_me_unredo_action "moving image" "xth_me_image_move_special $newiidx $iidx" "xth_me_image_move_special $iidx $newiidx"
  xth_me_image_update_list
  xth_me_image_select $xiidx
  
}


proc xth_me_image_move_front {} {
  global xth
  xth_me_cmds_update {}
  if {$xth(me,nimgs) < 1} {
    return
  }
  set isel [$xth(ctrl,me,images).il.ilbox curselection]
  if {[llength $isel] < 1} {
    return;
  }
  set iidx [lindex $isel 0]
  if {$iidx == 0} {
    return
  }
  
  xth_me_image_move_special $iidx 0

}


proc xth_me_image_move_back {} {
  global xth
  xth_me_cmds_update {}
  if {$xth(me,nimgs) < 1} {
    return
  }
  set isel [$xth(ctrl,me,images).il.ilbox curselection]
  if {[llength $isel] < 1} {
    return;
  }
  set iidx [lindex $isel 0]
  if {$iidx == ($xth(me,nimgs) - 1)} {
    return
  }

  xth_me_image_move_special $iidx $xth(me,nimgs)
}


proc xth_me_image_select {iidx} {
  
  global xth

  if {!$xth(me,fopen)} {
    return
  }
  
  if {$xth(me,nimgs) > 0} {
    $xth(ctrl,me,images).ic.remp configure -state normal
    $xth(ctrl,me,images).ic.posl configure -state normal
    $xth(ctrl,me,images).ic.posln configure -state normal
    $xth(ctrl,me,images).ic.posch configure -state normal
    $xth(ctrl,me,images).ic.posx configure -state normal
    $xth(ctrl,me,images).ic.posy configure -state normal
    $xth(ctrl,me,images).ic.mvf configure -state normal
    $xth(ctrl,me,images).ic.mvb configure -state normal
#    $xth(ctrl,me,images).il.ilbox configure -state normal
    $xth(ctrl,me,images).il.ilbox selection clear 0 end
    $xth(ctrl,me,images).il.ilbox selection set $iidx
    set iidx [lindex [$xth(ctrl,me,images).il.ilbox curselection] 0]
    set imgx [lindex $xth(me,imgs,xlist) $iidx]
    if {$xth(me,imgs,$imgx,vsb) < 0} {
      $xth(ctrl,me,images).ic.viscb configure -state disabled
      $xth(ctrl,me,images).ic.gs configure -state disabled
      $xth(ctrl,me,images).ic.gr configure -state disabled
      $xth(ctrl,me,images).ic.gl configure -state disabled
      xth_me_image_update_gamma_scale
      set xth(ctrl,me,images,vis) 0
    } else {
      $xth(ctrl,me,images).ic.viscb configure -state normal
      $xth(ctrl,me,images).ic.gs configure -state normal
      $xth(ctrl,me,images).ic.gr configure -state normal
      $xth(ctrl,me,images).ic.gl configure -state normal
      xth_me_image_update_gamma_scale
      set xth(ctrl,me,images,vis) $xth(me,imgs,$imgx,vsb)
    }
    xth_me_image_update_position
    update idletasks
  } else {
    $xth(ctrl,me,images).ic.viscb configure -state disabled
    $xth(ctrl,me,images).ic.remp configure -state disabled
    $xth(ctrl,me,images).ic.posl configure -state disabled
    $xth(ctrl,me,images).ic.posln configure -state disabled -text ""
    set xth(ctrl,me,images,posx) ""
    set xth(ctrl,me,images,posy) ""
    $xth(ctrl,me,images).ic.posch configure -state disabled
    $xth(ctrl,me,images).ic.posx configure -state disabled
    $xth(ctrl,me,images).ic.posy configure -state disabled
    $xth(ctrl,me,images).ic.mvf configure -state disabled
    $xth(ctrl,me,images).ic.mvb configure -state disabled
    $xth(ctrl,me,images).ic.gs configure -state disabled
    $xth(ctrl,me,images).ic.gr configure -state disabled
    $xth(ctrl,me,images).ic.gl configure -state disabled -text "gamma 1.00"
#    $xth(ctrl,me,images).il.ilbox configure -state disabled
    focus $xth(gui,main)
    update idletasks
  }
  
}

proc xth_me_image_gamma {imgx gv} {
  global xth
  set og $xth(me,imgs,$imgx,gamma)
  set xth(me,imgs,$imgx,gamma) $gv
  xth_me_image_set_gamma $imgx
  xth_me_unredo_action "gamma correction" "xth_me_image_gamma $imgx $og" \
    "xth_me_image_gamma $imgx $gv"
  xth_me_image_update_gamma_scale
}

proc xth_me_image_update_gamma {} {
  global xth
  catch { 
    set iidx [lindex [$xth(ctrl,me,images).il.ilbox curselection] 0]
    set imgx [lindex $xth(me,imgs,xlist) $iidx]
    if {[string length $imgx] > 0} {
      xth_me_image_gamma $imgx [expr pow(10.0,$xth(ctrl,me,images,gamma))]
    }
  }
}

proc xth_me_image_update_gamma_scale {} {
  global xth
  set iidx [lindex [$xth(ctrl,me,images).il.ilbox curselection] 0]
  set imgx [lindex $xth(me,imgs,xlist) $iidx]
  if {[string length $imgx] > 0} {
    set xth(ctrl,me,images,gamma) [expr log10($xth(me,imgs,$imgx,gamma))]
    $xth(ctrl,me,images).ic.gl configure -text [format "gamma %.2f" $xth(me,imgs,$imgx,gamma)]
  } else {
    $xth(ctrl,me,images).ic.gl configure -text "gamma 1.00"
    set xth(ctrl,me,images,gamma) 0
  }
}









proc xth_me_cmds_get_line_option {ln opt} {
  set rxl [list [list "\\s*\\-$opt\\s+\\\[(\[^\\\]\]*)\\\]" "\["]\
    [list "\\s*\\-$opt\\s+\\\"((\\\"\\\"|\[^\\\"])+)\\\"" "\""]\
    [list "\\s*\\-$opt\\s+(\\S+)" {}]]
  set rln $ln
  set val {}
  set sep {}
  set res 0
  foreach rx $rxl {
    if {[regexp [lindex $rx 0] $ln dump val]} {
      regsub [lindex $rx 0] $ln {} rln
      set sep [lindex $rx 1]
      set res 1
      break
    }
  }
  return [list $val $rln $res]
}


proc xth_me_cmds_set_action {act} {

  global xth
  
  set xth(me,cmds,action) $act
  switch $act {
    0 {
      $xth(ctrl,me,cmds).cc.go configure -text "Insert line"
    }
    1 {
      $xth(ctrl,me,cmds).cc.go configure -text "Insert point"
    }
    2 {
      $xth(ctrl,me,cmds).cc.go configure -text "Insert scrap"
    }
    3 {
      $xth(ctrl,me,cmds).cc.go configure -text "Insert text"
    }
    4 {
      $xth(ctrl,me,cmds).cc.go configure -text "Delete"
    }
    5 {
      $xth(ctrl,me,cmds).cc.go configure -text "Insert area"
    }
  }

  update idletasks

}


proc xth_me_cmds_update_buttons {} {

  global xth
  set ccbox $xth(ctrl,me,cmds).cc
  set clbox $xth(ctrl,me,cmds).cl
  set ncmd [expr [llength $xth(me,cmds,xlist)] - 1]
  if {$xth(me,fopen)} {
    $ccbox.cfg configure -state normal
    $clbox.l configure -takefocus 1
    $ccbox.go configure -state normal
    $xth(me,mbar) configure -state normal
    if {$ncmd > 0} {
      $ccbox.sel configure -state normal
      $xth(me,menu,edit) entryconfigure "Select" -state normal
      $xth(ctrl,me,prev).upd  configure -state normal

      $xth(ctrl,me,ss).xl configure -state normal
      $xth(ctrl,me,ss).xe configure -state normal
      $xth(ctrl,me,ss).cs configure -state normal
      $xth(ctrl,me,ss).rx configure -state normal
      $xth(ctrl,me,ss).sn configure -state normal
      $xth(ctrl,me,ss).sa configure -state normal
      $xth(ctrl,me,ss).sf configure -state normal
      $xth(ctrl,me,ss).ca configure -state normal
      
      if {$ncmd > 1} {
        $ccbox.mu configure -state normal
        $ccbox.md configure -state normal
        $ccbox.mt configure -state normal
        $ccbox.tt configure -state normal
     } else {
        $ccbox.mu configure -state disabled
        $ccbox.md configure -state disabled
        $ccbox.mt configure -state disabled
        $ccbox.tt configure -state disabled
      }
      $ccbox.cfg.m entryconfigure "Delete" -state normal
      $xth(me,menu,edit) entryconfigure "Delete" -state normal
    } else {
      $xth(ctrl,me,prev).upd  configure -state disabled
      $ccbox.sel configure -state disabled
      $xth(me,menu,edit) entryconfigure "Select" -state disabled
      $ccbox.cfg.m entryconfigure "Delete" -state disabled
      $xth(me,menu,edit) entryconfigure "Delete" -state disabled
      $ccbox.mu configure -state disabled
      $ccbox.md configure -state disabled
      $ccbox.mt configure -state disabled
      $ccbox.tt configure -state disabled
      if {$xth(me,cmds,action) == 4} {
        xth_me_cmds_set_action 3
      }

      $xth(ctrl,me,ss).xl configure -state disabled
      $xth(ctrl,me,ss).xe configure -state disabled
      $xth(ctrl,me,ss).cs configure -state disabled
      $xth(ctrl,me,ss).rx configure -state disabled
      $xth(ctrl,me,ss).sn configure -state disabled
      $xth(ctrl,me,ss).sa configure -state disabled
      $xth(ctrl,me,ss).sf configure -state disabled
      $xth(ctrl,me,ss).ca configure -state disabled

    }
  } else {
    xth_me_cmds_set_action 3
    $ccbox.go configure -state disabled
    $ccbox.cfg configure -state disabled
    $clbox.l configure -takefocus 0
    $xth(me,mbar) configure -text "" -state disabled -bg $xth(me,mbar,bg) -fg $xth(me,mbar,fg)
    $ccbox.sel configure -state disabled
    $ccbox.mu configure -state disabled
    $ccbox.md configure -state disabled
    $ccbox.mt configure -state disabled
    $ccbox.tt configure -state disabled

    $xth(ctrl,me,ss).xl configure -state disabled
    $xth(ctrl,me,ss).xe configure -state disabled
    $xth(ctrl,me,ss).cs configure -state disabled
    $xth(ctrl,me,ss).rx configure -state disabled
    $xth(ctrl,me,ss).sn configure -state disabled
    $xth(ctrl,me,ss).sa configure -state disabled
    $xth(ctrl,me,ss).sf configure -state disabled
    $xth(ctrl,me,ss).ca configure -state disabled

  }
  
  update idletasks
  
}


# typy prikazov
# 0 eof
# 1 text
# 2 point
# 3 line
# 4 scrap
# 5 endscrap
# 6 area

proc xth_me_cmds_create {typ id ix} {
  global xth
  if {[string length $id] < 1} {
    set id $xth(me,cmds,cmdln)
    incr xth(me,cmds,cmdln)
  }
  set xth(me,cmds,$id,listix) -1
  set xth(me,cmds,$id,ct) $typ
  set xth(me,cmds,$id,type) {}
  set xth(me,cmds,$id,name) {}
  set xth(me,cmds,$id,data) {}
  set ix [lsearch $xth(me,cmds,xlist) $xth(me,cmds,selid)]

	# ak sme v normalnom mode a na scrape a chceme vlozit
	# point, line, area alebo scrap
  if {$xth(me,unredook)} {
		set ccmdid $xth(me,cmds,selid)
		if {($xth(me,cmds,$ccmdid,ct) == 4) && (($typ == 2) || ($typ == 3) || ($typ == 6))} {
		    incr ix;
		}
	}
	
  set xth(me,cmds,list) [linsert $xth(me,cmds,list) $ix {}]
  set xth(me,cmds,xlist) [linsert $xth(me,cmds,xlist) $ix $id]
  if {$ix != -1} {
    xth_me_cmds_update_list_ft $ix {}
  }
  xth_me_cmds_update_buttons
  return $id
  
}


proc xth_me_cmds_update_list_ft {f t} {
  global xth
  if {[string length $f] == 0} {
    set f 0
  }
  if {[string length $t] == 0} {
    set t [llength $xth(me,cmds,xlist)]
  }
  for {set ii $f} {$ii < $t} {incr ii} {
    xth_me_cmds_update_list [lindex $xth(me,cmds,xlist) $ii]
  }
}

proc xth_me_cmds_update_list {id} {
  global xth
  set ix [lsearch $xth(me,cmds,xlist) $id]
  switch $xth(me,cmds,$id,ct) {
    0 {
      set cstr "end of file"
    }
    1 {
      set cstr "$ix: text"
    }
    2 {
      set cstr "$ix: point"
    }
    3 {
      set cstr "$ix: line"
    }
    4 {
      set cstr "$ix: scrap"
    }
    5 {
      set cstr "$ix: endscrap"
    }
    6 {
      set cstr "$ix: area"
    }
  }
  if {[string length $xth(me,cmds,$id,type)] > 0} {
    set cstr "$cstr $xth(me,cmds,$id,type)"
  }
  if {[string length $xth(me,cmds,$id,name)] > 0} {
    set cstr "$cstr - $xth(me,cmds,$id,name)"
  }
  set xth(me,cmds,list) [lreplace $xth(me,cmds,list) $ix $ix $cstr]
  set xth(me,cmds,$id,listix) $ix
  update idletasks
}


proc xth_me_cmds_draw {id} {
  global xth
  switch $xth(me,cmds,$id,ct) {
    2 {
      xth_me_cmds_draw_point $id
    }
    3 {
      xth_me_cmds_draw_line $id
    }
  }
}


proc xth_me_cmds_erase {id} {
  global xth
  switch $xth(me,cmds,$id,ct) {
    2 {
      $xth(me,can) delete pt$id
    }
    3 {
      $xth(me,can) delete ln$id
    }
  }
}


proc xth_me_cmds_undelete {id pid ix} {
  global xth
  xth_me_cmds_select 0
  set xth(me,cmds,list) [linsert $xth(me,cmds,list) $ix {}]
  set xth(me,cmds,xlist) [linsert $xth(me,cmds,xlist) $ix $id]
  xth_me_cmds_update_list_ft $ix {}
  #xth_me_cmds_update_list $id
  xth_me_cmds_draw $id
  xth_me_cmds_select "$id $pid"
  xth_me_cmds_update_buttons
}

proc xth_me_cmds_delete {id} {
  global xth
  if {[string length $id] < 1} {
    set id $xth(me,cmds,selid)
  }
  if {$xth(me,cmds,$id,ct) > 0} {
    set oldselid $xth(me,cmds,selid)
    set oldselpid $xth(me,cmds,selpid)
    xth_me_cmds_select 0
    set ix [lsearch $xth(me,cmds,xlist) $id]
    set xth(me,cmds,list) [lreplace $xth(me,cmds,list) $ix $ix]
    set xth(me,cmds,xlist) [lreplace $xth(me,cmds,xlist) $ix $ix]
    xth_me_cmds_update_list_ft $ix {}
    xth_me_cmds_erase $id
    if {$oldselid == $id} {
      set nwid [lindex $xth(me,cmds,xlist) $ix]
    } else {
      set nwid $oldselid
    }
    xth_me_cmds_select $nwid
    xth_me_unredo_action "deleting" "xth_me_cmds_undelete $id $oldselpid $ix" \
      "xth_me_cmds_delete $id"
    xth_me_cmds_update_buttons
  }
}


proc xth_me_cmds_update {id} {
  global xth

  if {[llength $id] < 1} {
    update idletasks
    set id $xth(me,cmds,selid)
    set pid $xth(me,cmds,selpid)
  } elseif {[llength $id] < 2} {
    set id [lindex $id 0]
    set pid $xth(me,cmds,selpid)
  } else {
    set id [lindex $id 0]
    set pid [lindex $id 1]
  }
  
  if {[string length $id] < 1} {
    set id $xth(me,cmds,selid)
  }
  switch $xth(me,cmds,$id,ct) {
    1 {
      xth_me_cmds_update_text $id [$xth(ctrl,me,text).txt get 1.0 end] \
        [$xth(ctrl,me,text).txt index insert]
    }
    2 {
      xth_me_cmds_update_point $id $xth(ctrl,me,point,x) \
        $xth(ctrl,me,point,y) $xth(ctrl,me,point,type) \
        $xth(ctrl,me,point,name) $xth(ctrl,me,point,opts) \
        $xth(ctrl,me,point,rot) $xth(ctrl,me,point,xs) \
        $xth(ctrl,me,point,ys)
      xth_me_cmds_update_point_vars $id
    }
    3 {
      xth_me_cmds_update_line $id $pid $xth(ctrl,me,line,type) \
        $xth(ctrl,me,line,name) $xth(ctrl,me,line,opts) \
        $xth(ctrl,me,line,reverse) $xth(ctrl,me,linept,x) \
        $xth(ctrl,me,linept,y) $xth(ctrl,me,linept,xp) \
        $xth(ctrl,me,linept,yp) $xth(ctrl,me,linept,xn) \
        $xth(ctrl,me,linept,yn) $xth(ctrl,me,linept,smooth) \
        $xth(ctrl,me,linept,rot) $xth(ctrl,me,linept,rs) \
        $xth(ctrl,me,linept,ls) \
        [$xth(ctrl,me,linept).oe.txt get 1.0 end] \
        [$xth(ctrl,me,linept).oe.txt index insert]
      xth_me_cmds_update_line_vars $id $pid
    }    
    4 {
      xth_me_cmds_update_scrap $id $xth(ctrl,me,scrap,name) \
        $xth(ctrl,me,scrap,projection) $xth(ctrl,me,scrap,options) \
         [list $xth(ctrl,me,scrap,px1) $xth(ctrl,me,scrap,py1) \
          $xth(ctrl,me,scrap,px2) $xth(ctrl,me,scrap,py2) \
          $xth(ctrl,me,scrap,rx1) $xth(ctrl,me,scrap,ry1) \
          $xth(ctrl,me,scrap,rx2) $xth(ctrl,me,scrap,ry2) \
          $xth(ctrl,me,scrap,units)]
      xth_me_cmds_update_scrap_vars $id
    }
    6 {
      xth_me_cmds_update_area $id $xth(ctrl,me,ac,type) \
        $xth(ctrl,me,ac,opts)
      xth_me_cmds_update_area_vars $id
    }
  }
  xth_me_cmds_update_list $id
  xth_me_prev_cmd $xth(me,cmds,$id,data)
  update idletasks
}

proc xth_me_cmds_update_text_ctrl {id} {

  global xth
  if {[string length $id] > 0} {
    $xth(ctrl,me,text).txt configure -state normal
    $xth(ctrl,me,text).txt delete 1.0 end
    $xth(ctrl,me,text).txt insert 1.0 $xth(me,cmds,$id,data)
    $xth(ctrl,me,text).txt mark set insert $xth(me,cmds,$id,cpos)
    $xth(ctrl,me,text).txt see $xth(me,cmds,$id,cpos)
    $xth(ctrl,me,text).upd configure -state normal
    xth_me_prev_cmd $xth(me,cmds,$id,data)
  } else {
    $xth(ctrl,me,text).txt configure -state normal
    $xth(ctrl,me,text).txt delete 1.0 end
    $xth(ctrl,me,text).txt see 1.0
    $xth(ctrl,me,text).txt configure -state disabled
    $xth(ctrl,me,text).upd configure -state disabled
  }
  
}



proc xth_me_cmds_unselect {id} {
  
  global xth
  if {[string length $id] < 1} {
    set id $xth(me,cmds,selid)
  }
  if {$xth(me,unredook)} {
    xth_me_cmds_update $id
  }
  switch $xth(me,cmds,$id,ct) {
    1 {xth_me_cmds_update_text_ctrl {}}
    2 {xth_me_cmds_update_point_ctrl {}}
    3 {
      xth_me_cmds_update_line_ctrl {}
      xth_me_cmds_update_linept_ctrl {} 0
      set xth(me,cmds,selpid) 0
      if {$xth(me,cmds,mode) == 2} {
        xth_me_cmds_set_mode 0
      }
    }
    4 {xth_me_cmds_update_scrap_ctrl {}}
    6 {
      xth_me_cmds_update_area_ctrl {}
      if {$xth(me,cmds,mode) == 3} {
        xth_me_cmds_set_mode 0
      }
    }
  }
  update idletasks
  
}


proc xth_me_cmds_select {id} {

  global xth
  
  if {!$xth(me,fopen)} {
    return
  }
  set center_to 0
  update idletasks
  if {[llength $id] < 1} {
    set id [lindex $xth(me,cmds,xlist) [lindex [$xth(ctrl,me,cmds).cl.l curselection] 0]]
    if {$xth(me,cmds,$id,ct) == 2} {
      set center_to 1
    }
    set pid -1
  } elseif {[llength $id] < 2} {
    set id [lindex $id 0]
    set pid -1
  } else {
    set pid [lindex $id 1]
    set id [lindex $id 0]
  }  

  if {$pid == -1} {
    set pid 0
    if {($xth(me,cmds,$id,ct) == 3) && ([llength $xth(me,cmds,$id,xplist)] > 1)} {
      set center_to [lindex $xth(me,cmds,$id,xplist) [expr [llength $xth(me,cmds,$id,xplist)] - 2]]
    }
  }
  
  set newx [lsearch $xth(me,cmds,xlist) $id]
  if {$xth(me,cmds,selid) == $id} {
    $xth(ctrl,me,cmds).cl.l selection clear 0 end  
    $xth(ctrl,me,cmds).cl.l selection set $newx $newx
    $xth(ctrl,me,cmds).cl.l see $newx
    if {($xth(me,cmds,$id,ct) == 3) && ($pid != $xth(me,cmds,selpid))} {
      xth_me_cmds_select_linept $id $pid
    }
    if {$xth(me,unredook)} {
      return
    }
  }
  if {$xth(me,cmds,$xth(me,cmds,selid),ct) != $xth(me,cmds,$id,ct)} {
    if {![string equal $xth(ctrl,me,cmds).cl.l [focus -lastfor $xth(gui,main)]]} {
      focus $xth(gui,main)
    }
  }
  
  if {$xth(me,cmds,selid) != $id} {
    xth_me_cmds_unselect $xth(me,cmds,selid)
  }

  set xth(me,cmds,selid) $id
  $xth(ctrl,me,cmds).cl.l selection clear 0 end  
  $xth(ctrl,me,cmds).cl.l selection set $newx $newx  
  $xth(ctrl,me,cmds).cl.l see $newx
  xth_me_cmds_set_colors  
  switch $xth(me,cmds,$id,ct) {
    1 {xth_me_cmds_update_text_ctrl $id}
    2 {xth_me_cmds_update_point_ctrl $id}
    3 {
      xth_me_cmds_update_line_ctrl $id
      xth_me_cmds_select_linept $id $pid
      $xth(me,can) itemconfigure lnln$id -fill $xth(gui,me,activefill)
      $xth(me,can) itemconfigure lnpt$id -fill $xth(gui,me,activefill)
    }
    4 {xth_me_cmds_update_scrap_ctrl $id}
    6 {
      xth_me_cmds_update_area_ctrl $id
      xth_me_cmds_show_current_area
    }
    default {xth_me_prev_cmd $xth(me,cmds,$id,data)}
  }
  
  if {$center_to > 0} {
    switch $xth(me,cmds,$id,ct) {
      2 { xth_me_center_to [list $xth(me,cmds,$id,x) $xth(me,cmds,$id,y)]
        }
      3 { xth_me_center_to [list \
          $xth(me,cmds,$xth(me,cmds,selid),$center_to,x) \
          $xth(me,cmds,$xth(me,cmds,selid),$center_to,y)]
        }
    }
  }
  update idletasks
}

proc xth_me_cmds_set_move_to_list {} {
  global xth
  # prejde vsetky prikazy a najde scrapy a endscrapy
  set xl [llength $xth(me,cmds,xlist)]
  set vls {}
  set lscrap {}
  for {set ii 0} {$ii < $xl} {incr ii} {
    set id [lindex $xth(me,cmds,xlist) $ii]
    switch $xth(me,cmds,$id,ct) {
      4 {
        set lscrap $xth(me,cmds,$id,name)
        lappend vls "$lscrap begin \[[expr $ii + 1]\]"
      }
      5 {
        lappend vls "$lscrap end \[$ii\]"
      }
    }
  }
  $xth(ctrl,me,cmds).cc.tt configure -values $vls
  update idletasks
}

proc xth_me_cmds_set_move_to {} {
  global xth
  set lnum {}
  regexp {\[(\d+)\]} $xth(ctrl,me,cmds,moveto) dum lnum
  set xth(ctrl,me,cmds,moveto) $lnum
  update idletasks
}


proc xth_me_cmds_move_to {id dx} {
  global xth
  xth_me_cmds_update {}
  if {[string length $dx] < 1} {
    set dx $xth(ctrl,me,cmds,moveto)
  }
  set dx [regexp -inline {\d*} $dx]
  if {[string length $dx] < 1} {
    return
  }
  if {[string length $id] < 1} {
    set id $xth(me,cmds,selid)
  }
  set sx [lsearch $xth(me,cmds,xlist) $id]
  set maxsdx [expr [llength $xth(me,cmds,xlist)] - 2]
  if {($dx == $sx) || ($sx > $maxsdx) || ($dx > $maxsdx)} {
    return;
  }

  # prehodi  
  set xth(me,cmds,list) [linsert $xth(me,cmds,list) $dx [lindex $xth(me,cmds,list) $sx]]
  set xth(me,cmds,xlist) [linsert $xth(me,cmds,xlist) $dx [lindex $xth(me,cmds,xlist) $sx]]
  if {$dx < $sx} {
    set xth(me,cmds,list) [lreplace $xth(me,cmds,list) [expr $sx + 1] [expr $sx + 1]]
    set xth(me,cmds,xlist) [lreplace $xth(me,cmds,xlist) [expr $sx + 1] [expr $sx + 1]]
  } else {
    set xth(me,cmds,list) [lreplace $xth(me,cmds,list) $sx $sx]
    set xth(me,cmds,xlist) [lreplace $xth(me,cmds,xlist) $sx $sx]
  }    

  if {$dx < $sx} {
    xth_me_cmds_update_list_ft $dx [expr $sx + 1]
  } else {
    xth_me_cmds_update_list_ft $sx [expr $dx + 1]
  }

  set nid [lindex $xth(me,cmds,xlist) $sx]
  if {$xth(me,unredook)} {
    xth_me_cmds_select $nid
  }
  

  # unredo
  xth_me_unredo_action "moving command" "xth_me_cmds_move_to $id $sx\nxth_me_cmds_select $id" "xth_me_cmds_move_to $id $dx\nxth_me_cmds_select $nid"
  update idletasks
  
}

proc xth_me_cmds_move_up {id} {
  global xth
  xth_me_cmds_update {}
  if {[string length $id] < 1} {
    set id $xth(me,cmds,selid)
  }
  if {$id < 1} {
    return
  }
  set ix [lsearch $xth(me,cmds,xlist) $id]
  if {$ix < 1} {
    return
  }
  set dix [expr $ix - 1]
  # vymenime v liste
  set xth(me,cmds,list) [lreplace $xth(me,cmds,list) $dix $ix \
    [lindex $xth(me,cmds,list) $ix] [lindex $xth(me,cmds,list) $dix]]
  # vymenime v xliste
  set xth(me,cmds,xlist) [lreplace $xth(me,cmds,xlist) $dix $ix \
    [lindex $xth(me,cmds,xlist) $ix] [lindex $xth(me,cmds,xlist) $dix]]
  # selection
  if {$id == $xth(me,cmds,selid)} {
    $xth(ctrl,me,cmds).cl.l selection clear 0 end  
    $xth(ctrl,me,cmds).cl.l selection set $dix $dix
    $xth(ctrl,me,cmds).cl.l see $dix
    set selcmd "\nxth_me_cmds_select $id"
  } else {
    set selcmd {}
  }
  xth_me_cmds_update_list [lindex $xth(me,cmds,xlist) $ix]
  xth_me_cmds_update_list [lindex $xth(me,cmds,xlist) $dix]
  # unredo
  xth_me_unredo_action "moving command" "xth_me_cmds_move_down $id$selcmd" "xth_me_cmds_move_up $id$selcmd"
  update idletasks
}


proc xth_me_cmds_move_down {id} {
  global xth
  xth_me_cmds_update {}
  if {[string length $id] < 1} {
    set id $xth(me,cmds,selid)
  }
  if {$id < 1} {
    return
  }
  set ix [lsearch $xth(me,cmds,xlist) $id]
  if {$ix > [expr [llength $xth(me,cmds,xlist)] - 3]} {
    return
  }
  set iix [expr $ix + 1]
  # vymenime v liste
  set xth(me,cmds,list) [lreplace $xth(me,cmds,list) $ix $iix \
    [lindex $xth(me,cmds,list) $iix] [lindex $xth(me,cmds,list) $ix]]
  # vymenime v xliste
  set xth(me,cmds,xlist) [lreplace $xth(me,cmds,xlist) $ix $iix \
    [lindex $xth(me,cmds,xlist) $iix] [lindex $xth(me,cmds,xlist) $ix]]
  # selection
  if {$id == $xth(me,cmds,selid)} {
    $xth(ctrl,me,cmds).cl.l selection clear 0 end  
    $xth(ctrl,me,cmds).cl.l selection set $iix $iix
    $xth(ctrl,me,cmds).cl.l see $iix
    set selcmd "\nxth_me_cmds_select $id"
  } else {
    set selcmd {}
  }
  # unredo
  xth_me_cmds_update_list [lindex $xth(me,cmds,xlist) $ix]
  xth_me_cmds_update_list [lindex $xth(me,cmds,xlist) $iix]
  xth_me_unredo_action "moving command" "xth_me_cmds_move_up $id$selcmd" "xth_me_cmds_move_down $id$selcmd"
  update idletasks
}


proc xth_me_cmds_create_endscrap {ix mode name} {
  global xth
  xth_me_cmds_update {}
  set id [xth_me_cmds_create 5 {} $ix]
  set xth(me,cmds,$id,name) {}
  set xth(me,cmds,$id,data) "endscrap"
  if {[string length $name] > 0} {
    set xth(me,cmds,$id,data) "$xth(me,cmds,$id,data)\n# $name"
  }
  xth_me_cmds_update_list $id
  if {$mode} {
    xth_me_cmds_select $id
    xth_me_cmds_select [expr $id - 1]
    xth_me_unredo_action "creating endscrap" "xth_me_cmds_delete $id" \
      "xth_me_cmds_undelete $id 0 [lsearch $xth(me,cmds,xlist) $id]"  
  }
}


proc xth_me_cmds_hide_scrap_xctrl {} {

  global xth

  $xth(me,can) itemconfigure $xth(me,canid,scrap,scp1) -state hidden
  $xth(me,can) bind $xth(me,canid,scrap,scp1) <Enter> ""
  $xth(me,can) bind $xth(me,canid,scrap,scp1) <Leave> ""

  $xth(me,can) itemconfigure $xth(me,canid,scrap,scp2) -state hidden
  $xth(me,can) bind $xth(me,canid,scrap,scp2) <Enter> ""
  $xth(me,can) bind $xth(me,canid,scrap,scp2) <Leave> ""
  
}


proc xth_me_cmds_move_scrap_xctrl {id x y} {
  global xth
  set x [xth_me_real2canx $x]
  set y [xth_me_real2cany $y]
  $xth(me,can) coords $xth(me,canid,scrap,scp$id) \
    [expr $x - $xth(gui,me,scrap,psize)] [expr $y - $xth(gui,me,scrap,psize)] \
    [expr $x + $xth(gui,me,scrap,psize)] [expr $y + $xth(gui,me,scrap,psize)]
}


proc xth_me_cmds_start_scrap_xctrl_drag {pid x y} {
  global xth
  xth_me_cmds_update {}
  set xth(me,scrap,xdrag_mx) $x
  set xth(me,scrap,xdrag_my) $y
  set xth(me,scrap,xdrag_px) $xth(ctrl,me,scrap,px$pid)
  set xth(me,scrap,xdrag_py) $xth(ctrl,me,scrap,py$pid)
  set xth(me,scrap,xdrag_benter) [$xth(me,can) bind $xth(me,canid,scrap,scp$pid) <Enter>]
  $xth(me,can) bind $xth(me,canid,scrap,scp$pid) <Enter> {}
  set xth(me,scrap,xdrag_bleave) [$xth(me,can) bind $xth(me,canid,scrap,scp$pid) <Leave>]
  $xth(me,can) bind $xth(me,canid,scrap,scp$pid) <Leave> {}
  $xth(me,can) itemconfigure $xth(me,canid,scrap,scp$pid) -fill {}
  $xth(me,can) bind $xth(me,canid,scrap,scp$pid) <B1-Motion> "xth_me_cmds_scrap_xctrl_drag $pid %x %y"
  $xth(me,can) bind $xth(me,canid,scrap,scp$pid) <B1-ButtonRelease> "xth_me_cmds_end_scrap_xctrl_drag $pid %x %y"
  $xth(me,can) configure -cursor {}
}


proc xth_me_cmds_scrap_xctrl_drag {pid x y} {
  global xth
  set nx [expr $xth(me,scrap,xdrag_px) - [expr double($xth(me,scrap,xdrag_mx) - $x) * 100.0 / $xth(me,zoom)]]
  set ny [expr $xth(me,scrap,xdrag_py) + [expr double($xth(me,scrap,xdrag_my) - $y) * 100.0 / $xth(me,zoom)]]
  xth_me_cmds_move_scrap_xctrl $pid $nx $ny
  set xth(ctrl,me,scrap,px$pid) $nx
  set xth(ctrl,me,scrap,py$pid) $ny
  update idletasks
}


proc xth_me_cmds_end_scrap_xctrl_drag {pid x y} {
  global xth
  xth_me_cmds_scrap_xctrl_drag $pid $x $y
  $xth(me,can) bind $xth(me,canid,scrap,scp$pid) <B1-Motion> ""
  $xth(me,can) bind $xth(me,canid,scrap,scp$pid) <B1-ButtonRelease> ""
  $xth(me,can) bind $xth(me,canid,scrap,scp$pid) <Enter> $xth(me,scrap,xdrag_benter)
  $xth(me,can) bind $xth(me,canid,scrap,scp$pid) <Leave> $xth(me,scrap,xdrag_bleave)
  $xth(me,can) itemconfigure $xth(me,canid,scrap,scp$pid) -fill yellow
  $xth(me,can) configure -cursor crosshair
  xth_me_cmds_update {}
}


proc xth_me_cmds_show_scrap_xctrl {x1 y1 x2 y2} {

  global xth
  
  xth_me_cmds_move_scrap_xctrl 1 $x1 $y1
  $xth(me,can) itemconfigure $xth(me,canid,scrap,scp1) -state normal
  $xth(me,can) raise $xth(me,canid,scrap,scp1)
  $xth(me,can) bind $xth(me,canid,scrap,scp1) <Enter> "xth_status_bar_push me; xth_status_bar_status me \"Scrap picture scale point 1.\"; $xth(me,can) itemconfigure $xth(me,canid,scrap,scp1) -fill yellow"
  $xth(me,can) bind $xth(me,canid,scrap,scp1) <Leave> "xth_status_bar_pop me; $xth(me,can) itemconfigure $xth(me,canid,scrap,scp1) -fill red"
  $xth(me,can) bind $xth(me,canid,scrap,scp1) <1> "xth_me_cmds_start_scrap_xctrl_drag 1 %x %y"

  xth_me_cmds_move_scrap_xctrl 2 $x2 $y2
  $xth(me,can) itemconfigure $xth(me,canid,scrap,scp2) -state normal
  $xth(me,can) raise $xth(me,canid,scrap,scp2)
  $xth(me,can) bind $xth(me,canid,scrap,scp2) <Enter> "xth_status_bar_push me; xth_status_bar_status me \"Scrap picture scale point 2.\"; $xth(me,can) itemconfigure $xth(me,canid,scrap,scp2) -fill yellow"
  $xth(me,can) bind $xth(me,canid,scrap,scp2) <Leave> "xth_status_bar_pop me; $xth(me,can) itemconfigure $xth(me,canid,scrap,scp2) -fill red"
  $xth(me,can) bind $xth(me,canid,scrap,scp2) <1> "xth_me_cmds_start_scrap_xctrl_drag 2 %x %y"
  
}


proc xth_me_cmds_update_scrap_ctrl {id} {
  global xth
  if {[string length $id] > 0} {
    $xth(ctrl,me,scrap).namel configure -state normal
    $xth(ctrl,me,scrap).name configure -state normal
    $xth(ctrl,me,scrap).projl configure -state normal
    $xth(ctrl,me,scrap).proj configure -state normal
    $xth(ctrl,me,scrap).optl configure -state normal
    $xth(ctrl,me,scrap).opt configure -state normal
    $xth(ctrl,me,scrap).scl configure -state normal
    $xth(ctrl,me,scrap).scpb configure -state normal
    $xth(ctrl,me,scrap).scpp configure -state normal
    $xth(ctrl,me,scrap).scrp configure -state normal
    $xth(ctrl,me,scrap).scx1p configure -state normal
    $xth(ctrl,me,scrap).scy1p configure -state normal
    $xth(ctrl,me,scrap).scx2p configure -state normal
    $xth(ctrl,me,scrap).scy2p configure -state normal
    $xth(ctrl,me,scrap).scx1r configure -state normal
    $xth(ctrl,me,scrap).scy1r configure -state normal
    $xth(ctrl,me,scrap).scx2r configure -state normal
    $xth(ctrl,me,scrap).scy2r configure -state normal
    $xth(ctrl,me,scrap).scu configure -state normal
    $xth(ctrl,me,scrap).scul configure -state normal
    set xth(ctrl,me,scrap,name) $xth(me,cmds,$id,name)
    set xth(ctrl,me,scrap,projection) $xth(me,cmds,$id,projection)
    set xth(ctrl,me,scrap,options) $xth(me,cmds,$id,options)
    set xth(ctrl,me,scrap,px1) [lindex $xth(me,cmds,$id,scale) 0]
    set xth(ctrl,me,scrap,py1) [lindex $xth(me,cmds,$id,scale) 1]
    set xth(ctrl,me,scrap,px2) [lindex $xth(me,cmds,$id,scale) 2]
    set xth(ctrl,me,scrap,py2) [lindex $xth(me,cmds,$id,scale) 3]
    set xth(ctrl,me,scrap,rx1) [lindex $xth(me,cmds,$id,scale) 4]
    set xth(ctrl,me,scrap,ry1) [lindex $xth(me,cmds,$id,scale) 5]
    set xth(ctrl,me,scrap,rx2) [lindex $xth(me,cmds,$id,scale) 6]
    set xth(ctrl,me,scrap,ry2) [lindex $xth(me,cmds,$id,scale) 7]
    set xth(ctrl,me,scrap,units) [lindex $xth(me,cmds,$id,scale) 8]
    xth_me_cmds_show_scrap_xctrl [lindex $xth(me,cmds,$id,scale) 0] \
      [lindex $xth(me,cmds,$id,scale) 1] [lindex $xth(me,cmds,$id,scale) 2] \
      [lindex $xth(me,cmds,$id,scale) 3]
    xth_me_prev_cmd $xth(me,cmds,$id,data)
  } else {
    set xth(ctrl,me,scrap,name) ""
    set xth(ctrl,me,scrap,projection) $xth(me,dflt,scrap,projection)
    set xth(ctrl,me,scrap,options) $xth(me,dflt,scrap,options)
    set xth(ctrl,me,scrap,px1) [lindex $xth(me,dflt,scrap,scale) 0]
    set xth(ctrl,me,scrap,py1) [lindex $xth(me,dflt,scrap,scale) 1]
    set xth(ctrl,me,scrap,px2) [lindex $xth(me,dflt,scrap,scale) 2]
    set xth(ctrl,me,scrap,py2) [lindex $xth(me,dflt,scrap,scale) 3]
    set xth(ctrl,me,scrap,rx1) [lindex $xth(me,dflt,scrap,scale) 4]
    set xth(ctrl,me,scrap,ry1) [lindex $xth(me,dflt,scrap,scale) 5]
    set xth(ctrl,me,scrap,rx2) [lindex $xth(me,dflt,scrap,scale) 6]
    set xth(ctrl,me,scrap,ry2) [lindex $xth(me,dflt,scrap,scale) 7]
    set xth(ctrl,me,scrap,units) [lindex $xth(me,dflt,scrap,scale) 8]
    $xth(ctrl,me,scrap).namel configure -state disabled
    $xth(ctrl,me,scrap).name configure -state disabled
    $xth(ctrl,me,scrap).projl configure -state disabled
    $xth(ctrl,me,scrap).proj configure -state disabled
    $xth(ctrl,me,scrap).optl configure -state disabled
    $xth(ctrl,me,scrap).opt configure -state disabled
    $xth(ctrl,me,scrap).scl configure -state disabled
    $xth(ctrl,me,scrap).scpb configure -state disabled
    $xth(ctrl,me,scrap).scpp configure -state disabled
    $xth(ctrl,me,scrap).scrp configure -state disabled
    $xth(ctrl,me,scrap).scx1p configure -state disabled
    $xth(ctrl,me,scrap).scy1p configure -state disabled
    $xth(ctrl,me,scrap).scx2p configure -state disabled
    $xth(ctrl,me,scrap).scy2p configure -state disabled
    $xth(ctrl,me,scrap).scx1r configure -state disabled
    $xth(ctrl,me,scrap).scy1r configure -state disabled
    $xth(ctrl,me,scrap).scx2r configure -state disabled
    $xth(ctrl,me,scrap).scy2r configure -state disabled
    $xth(ctrl,me,scrap).scu configure -state disabled
    $xth(ctrl,me,scrap).scul configure -state disabled
    xth_me_cmds_hide_scrap_xctrl    
  }
}

proc xth_me_cmds_update_scrap_vars {id} {

  global xth
  set xth(ctrl,me,scrap,name) $xth(me,cmds,$id,name)
  set xth(ctrl,me,scrap,projection) $xth(me,cmds,$id,projection)
  set xth(ctrl,me,scrap,options) $xth(me,cmds,$id,options)
  set xth(ctrl,me,scrap,px1) [lindex $xth(me,cmds,$id,scale) 0]
  set xth(ctrl,me,scrap,py1) [lindex $xth(me,cmds,$id,scale) 1]
  set xth(ctrl,me,scrap,px2) [lindex $xth(me,cmds,$id,scale) 2]
  set xth(ctrl,me,scrap,py2) [lindex $xth(me,cmds,$id,scale) 3]
  set xth(ctrl,me,scrap,rx1) [lindex $xth(me,cmds,$id,scale) 4]
  set xth(ctrl,me,scrap,ry1) [lindex $xth(me,cmds,$id,scale) 5]
  set xth(ctrl,me,scrap,rx2) [lindex $xth(me,cmds,$id,scale) 6]
  set xth(ctrl,me,scrap,ry2) [lindex $xth(me,cmds,$id,scale) 7]
  set xth(ctrl,me,scrap,units) [lindex $xth(me,cmds,$id,scale) 8]
  xth_me_cmds_move_scrap_xctrl 1 [lindex $xth(me,cmds,$id,scale) 0] \
    [lindex $xth(me,cmds,$id,scale) 1] 
  xth_me_cmds_move_scrap_xctrl 2 [lindex $xth(me,cmds,$id,scale) 2] \
    [lindex $xth(me,cmds,$id,scale) 3]

}


proc xth_me_cmds_update_scrap {id nname nproj nopt nscale} {

  global xth
  
  set oname $xth(me,cmds,$id,name)
  set oproj $xth(me,cmds,$id,projection)
  set oopt $xth(me,cmds,$id,options)
  set oscale $xth(me,cmds,$id,scale)

  regsub {^\s*} $nopt "" nopt
  regsub {\s*$} $nopt "" nopt
  if {[string length $nname] < 1} {
    set nname $oname
  }  
  if {[llength $nscale] < 8} {
    set nscale oscale
  } else {
    for {set i 0} {$i < 8} {incr i} {
      if {[catch {expr [lindex $nscale $i]}]} {
        set nscale [lreplace $nscale $i $i [lindex $oscale $i]]
      }
    }
  }
  if {[llength $nscale] == 9} {
    if {[string length [lindex $nscale 8]] == 0} {
      set nscale [lreplace $nscale 8 8]
    }
  }
  
  if {![string equal "$oname $oproj $oopt $oscale" "$nname $nproj $nopt $nscale"]} {
    xth_me_unredo_action "scrap changes" \
      "xth_me_cmds_update_scrap $id $oname [list $oproj] [list $oopt] [list $oscale]; xth_me_cmds_select $id" \
      "xth_me_cmds_update_scrap $id $nname [list $nproj] [list $nopt] [list $nscale]; xth_me_cmds_select $id"
    set xth(me,cmds,$id,name) $nname
    set xth(me,cmds,$id,projection) $nproj
    set xth(me,cmds,$id,options) $nopt
    set xth(me,cmds,$id,scale) $nscale
    xth_me_cmds_update_scrap_data $id
    xth_me_cmds_update_list $id
  }
  
}


proc xth_me_cmds_update_scrap_data {id} {

  global xth

  set d "scrap $xth(me,cmds,$id,name)"

  if {[llength $xth(me,cmds,$id,projection)] > 1} {
    set d "$d -projection \[$xth(me,cmds,$id,projection)\]"
  } elseif {[llength $xth(me,cmds,$id,projection)] > 0} {
    set d "$d -projection $xth(me,cmds,$id,projection)"
  }
  set xth(me,dflt,scrap,projection) $xth(me,cmds,$id,projection)

  if {[string length $xth(me,cmds,$id,options)] > 0} {
    set d "$d $xth(me,cmds,$id,options)"
  }
  set xth(me,dflt,scrap,options) $xth(me,cmds,$id,options)

  set d "$d -scale \[$xth(me,cmds,$id,scale)\]"
  set xth(me,dflt,scrap,scale) $xth(me,cmds,$id,scale)

  set xth(me,cmds,$id,data) "$d"
  
}


proc xth_me_cmds_create_scrap {ix mode name opts} {

  global xth
  xth_me_cmds_update {}

  set undoselect {}
  if {[string length $ix] == 0} {
    set undoselect "; xth_me_cmds_select $xth(me,cmds,selid)"

    #xth_me_cmds_select [lindex $xth(me,cmds,xlist) 0]
    set newselid 0
    set cx [lsearch -exact $xth(me,cmds,xlist) $xth(me,cmds,selid)]
    if {$cx > -1} {
      for {set cc [expr $cx + 1]} {$cc < [llength $xth(me,cmds,xlist)]} {incr cc} {
        set cselid [lindex $xth(me,cmds,xlist) $cc]
        if {$xth(me,cmds,$cselid,ct) == 4} {
          set newselid $cselid
          break
        }
      }
    }
    xth_me_cmds_select $newselid
    
  }
  
  set id [xth_me_cmds_create 4 {} $ix]

  if {[string length $name] > 0} {
    set xth(me,cmds,$id,name) $name
  } else {
    set xth(me,cmds,$id,name) "scrap$id"
  }

  if {$mode && ([string length $opts] < 1)} {
    set opts $xth(me,dflt,scrap,options)
  }
  
  # nastavit projekciu
  if {$mode} {
    set xth(me,cmds,$id,projection) $xth(me,dflt,scrap,projection)
  } else {
    set xth(me,cmds,$id,projection) {}
  }
  set optl [xth_me_cmds_get_line_option $opts projection]
  if {[lindex $optl 2]} {
    set xth(me,cmds,$id,projection) [lindex $optl 0]
    set opts [lindex $optl 1]
  }
  set optl [xth_me_cmds_get_line_option $opts proj]
  if {[lindex $optl 2]} {
    set xth(me,cmds,$id,projection) [lindex $optl 0]
    set opts [lindex $optl 1]
  }
  
  # nastavit scale
  set xth(me,cmds,$id,scale) {}
  if {[llength $xth(me,dflt,scrap,scale)] < 1} {
    set xth(me,dflt,scrap,scale) [list $xth(me,area,xmin) $xth(me,area,ymin) \
      $xth(me,area,xmax) $xth(me,area,ymin) 0.0 0.0 [expr 0.0254 * ($xth(me,area,xmax) - $xth(me,area,xmin))] 0.0 m]
  }
  set optl [xth_me_cmds_get_line_option $opts scale]
  set optv [lindex $optl 0]
  set opts [lindex $optl 1]
  switch [llength $optv] {
    1 {
      set xth(me,cmds,$id,scale) [list $xth(me,area,xmin) $xth(me,area,ymin) \
        $xth(me,area,xmax) $xth(me,area,ymin) 0.0 0.0 [expr 1.0 * $optv * ($xth(me,area,xmax) - $xth(me,area,xmin))] 0.0 m]
    }
    2 {
      set xth(me,cmds,$id,scale) [list $xth(me,area,xmin) $xth(me,area,ymin) \
        $xth(me,area,xmax) $xth(me,area,ymin) 0.0 0.0 [expr 1.0 * [lindex $optv 0] * ($xth(me,area,xmax) - $xth(me,area,xmin))] 0.0 [lindex $optv 1]]
    }
    3 {
      set xth(me,cmds,$id,scale) [list $xth(me,area,xmin) $xth(me,area,ymin) \
        $xth(me,area,xmax) $xth(me,area,ymin) 0.0 0.0 [expr 1.0 * [lindex $optv 1] / [lindex $optv 0] * ($xth(me,area,xmax) - $xth(me,area,xmin))] 0.0 [lindex $optv 2]]
    }
    8 {
      set xth(me,cmds,$id,scale) [list [lindex $optv 0] [lindex $optv 1] [lindex $optv 2] \
      [lindex $optv 3] [lindex $optv 4] [lindex $optv 5] [lindex $optv 6] [lindex $optv 7]]
    }
    9 {
      set xth(me,cmds,$id,scale) [list [lindex $optv 0] [lindex $optv 1] [lindex $optv 2] \
      [lindex $optv 3] [lindex $optv 4] [lindex $optv 5] [lindex $optv 6] [lindex $optv 7] [lindex $optv 8]]
    }
    default {
      set xth(me,cmds,$id,scale) $xth(me,dflt,scrap,scale)
    }
  }

  # nastavit options
  regsub {^\s*} $opts "" opts
  regsub {\s*$} $opts "" opts
  set xth(me,cmds,$id,options) $opts
  
  xth_me_cmds_update_list $id
  xth_me_cmds_update_scrap_data $id
  if {$mode} {
    xth_me_unredo_action "creating scrap" "xth_me_cmds_delete $id$undoselect" \
      "xth_me_cmds_undelete $id 0 [lsearch $xth(me,cmds,xlist) $id]"  
    xth_me_cmds_create_endscrap $ix $mode {}
  }
}


proc xth_me_cmds_create_text {ix mode data cpos} {
  global xth
  xth_me_cmds_update {}
  set id [xth_me_cmds_create 1 {} $ix]
  set xth(me,cmds,$id,data) $data
  set xth(me,cmds,$id,cpos) $cpos
  if {$mode} {
    xth_me_cmds_select $id
    xth_me_unredo_action "creating text" "xth_me_cmds_delete $id" \
      "xth_me_cmds_undelete $id 0 [lsearch $xth(me,cmds,xlist) $id]"
  }
}


proc xth_me_cmds_update_text {id newdata newcpos} {
  global xth
  set olddata $xth(me,cmds,$id,data)
  set oldcpos $xth(me,cmds,$id,cpos)
  regsub {\s*$} $newdata {} newdata
  if {![string equal $xth(me,cmds,$id,data) $newdata]} {
    set newdata "$newdata\n"
    xth_me_unredo_action "text changes" \
      "xth_me_cmds_update_text $id [list $olddata] $oldcpos; xth_me_cmds_select $id" \
      "xth_me_cmds_update_text $id [list $newdata] $newcpos; xth_me_cmds_select $id"
    set xth(me,cmds,$id,data) $newdata
    set xth(me,cmds,$id,cpos) $newcpos    
  }
}


proc xth_me_cmds_action {} {
  global xth
  switch $xth(me,cmds,action) {
    0 {
      xth_me_cmds_create_line {} 1 "" "" ""
      xth_ctrl_scroll_to me line
      xth_ctrl_maximize me line
      xth_ctrl_maximize me linept
    }
    1 {
      xth_me_cmds_set_mode 1    
    }
    2 {
      xth_me_cmds_create_scrap {} 1 "" ""
      xth_ctrl_scroll_to me scrap
      xth_ctrl_maximize me scrap
    }
    3 {
      xth_me_cmds_create_text {} 1 "\n" "1.0"
      xth_ctrl_scroll_to me text
      xth_ctrl_maximize me text
      focus $xth(ctrl,me,text).txt
    }
    4 {
      xth_me_cmds_delete {}
    }
    5 {
      xth_me_cmds_create_area {} 1 "" "" ""
      xth_ctrl_scroll_to me ac
      xth_ctrl_maximize me ac
    }
  }
}


proc xth_me_cmds_create_all {lns} {
  global xth
  set ctext {}
  xth_status_bar_push me
  set ctext_push {
    regsub {^\s*} $ctext {} ctext
    regsub {\s*$} $ctext {} ctext
    if {[string length $ctext] > 0} {
      xth_me_cmds_create_text [expr [llength $xth(me,cmds,xlist)] - 1] 0 "$ctext\n" 1.0
      set ctext {}
    }
  }
  set line_lines {}
  set line_type {}
  set line_opts {}
  set inline 0
  set linenumber 0
  set totallns [llength $lns]
  xth_me_progbar_show $totallns
  xth_status_bar_status me "Processing commands ..."
  foreach ln $lns {
    incr linenumber
    xth_me_progbar_prog $linenumber
    # here take care of special commands
    if {[regexp {^\s*scrap\s+(\S+)\s*(.*)$} $ln dum name opts]} {
      eval $ctext_push
      xth_me_cmds_create_scrap [expr [llength $xth(me,cmds,xlist)] - 1] 0 $name $opts
    } elseif {[regexp {^\s*endscrap\s*(\S*)\s*$} $ln dum name]} {
      eval $ctext_push
      xth_me_cmds_create_endscrap [expr [llength $xth(me,cmds,xlist)] - 1] 0 $name
    } elseif {[regexp {^\s*point\s+(\S+)\s+(\S+)\s+(\S+)\s*(.*)$} $ln dum x y type opts]} {
      eval $ctext_push
      xth_me_cmds_create_point [expr [llength $xth(me,cmds,xlist)] - 1] 0 $x $y $type $opts
    } elseif {[regexp {^\s*line\s+(\S+)\s*(.*)$} $ln dum line_type line_opts]} {
      eval $ctext_push
      set line_lines {}
      set inline 1
    } elseif {($inline == 1) && [regexp {^\s*endline(\s|$)} $ln]} {
      xth_me_cmds_create_line [expr [llength $xth(me,cmds,xlist)] - 1] 0 $line_type $line_opts $line_lines
      set line_lines {}
      set line_type {}
      set line_opts {}
      set inline 0
    } elseif {[regexp {^\s*area\s+(\S+)\s*(.*)$} $ln dum line_type line_opts]} {
      eval $ctext_push
      set line_lines {}
      set inline 2
    } elseif {($inline == 2) && [regexp {^\s*endarea(\s|$)} $ln]} {
      xth_me_cmds_create_area [expr [llength $xth(me,cmds,xlist)] - 1] 0 $line_type $line_opts $line_lines
      set line_lines {}
      set line_type {}
      set line_opts {}
      set inarea 0
    } elseif {($inline > 0)} {
      lappend line_lines $ln
    } else {
      set ctext "$ctext\n$ln"
    }
  }
  if {$inline > 0} {
    foreach ln $line_lines {
      set ctext "$ctext\n$ln"
    }
  }
  eval $ctext_push
  xth_me_progbar_hide
  xth_status_bar_pop me
}


proc xth_me_cmds_click {id tagOrId x y mx my} {
  global xth
  xth_me_cmds_update {}
  if {[llength $id] == 2} {
    set pid [lindex $id 1]
    set id [lindex $id 0]
  } else {
    set pid 0
  }
  
  switch $xth(me,cmds,mode) {
    0 {
      if {[llength $id] > 0} {
        if {$id != $xth(me,cmds,selid)} {
          xth_me_cmds_select "$id $pid"
          if {$pid == 0} {
            xth_ctrl_scroll_to me point
            xth_ctrl_maximize me point
          } else {
            xth_ctrl_scroll_to me line
            xth_ctrl_maximize me line
            xth_ctrl_maximize me linept
          }
        } else {
          switch $xth(me,cmds,$id,ct) {
            2 {xth_me_cmds_start_point_drag $id $mx $my}
            3 {
              if {$xth(me,cmds,selpid) != $pid} {
                xth_me_cmds_select_linept $id $pid
              } else {
                xth_me_cmds_start_linecp_drag pt$id.$pid $id 0 $pid 0 x $mx $my
              }
            }
          }
        }
      }
    }
    1 {
      xth_ctrl_scroll_to me point
      xth_ctrl_maximize me point
      if {$id == ($xth(me,cmds,cmdln) - 1)} {
        xth_me_cmds_end_point 
      } else {
        xth_me_cmds_create_point {} 1 $x $y {} {}
      }
    }
    2 {
      xth_ctrl_scroll_to me line
      xth_ctrl_maximize me line
      xth_ctrl_maximize me linept
      set fpid -1
      set lpid -1
      if {($id == $xth(me,cmds,selid)) && ([string length $id] > 0) && ($pid > 0)} {
        set xl $xth(me,cmds,$id,xplist)
        set lix [expr [llength $xl] - 2]
        if {$lix >= 0} {
          set fpid [lindex $xl 0]
          set lpid [lindex $xl $lix]
        }
      }
      if {($id == $xth(me,cmds,selid)) && ($pid != 0) && ($pid == $xth(me,cmds,inspid))} {
        xth_me_cmds_end_line
      } elseif {($id == $xth(me,cmds,selid)) && ($pid == $fpid) && ($xth(me,cmds,inspid) == 0)} {
        xth_me_cmds_close_line $id
      } elseif {($id == $xth(me,cmds,selid)) && ($pid == $lpid) && ($xth(me,cmds,inspid) == 0)} {
        xth_me_cmds_end_line
      } else {
        # vytvori novy bod
        xth_me_cmds_start_create_linept $tagOrId $x $y $mx $my
      }      
    }
    3 {
      if {([string length $id] > 0) && ($xth(me,cmds,$id,ct) == 3)} {
        xth_me_cmds_insert_area_lineid $id $mx $my
      }
    }
  }
}


proc xth_me_cmds_end_point {} {
  set recmds "xth_me_cmds_set_mode 0"
  set uncmds "xth_me_cmds_set_mode 1"
  eval $recmds
  xth_me_unredo_action "end point insertion" $uncmds $recmds
}




proc xth_me_cmds_click_lineln {id tagOrId mx my} {
  global xth
  xth_me_cmds_update {}
  if {[llength $id] == 2} {
    set pid [lindex $id 1]
    set id [lindex $id 0]
  } else {
    set pid 0
  }

  switch $xth(me,cmds,mode) {
    3 {
      if {$xth(me,cmds,$id,ct) == 3} {
        xth_me_cmds_insert_area_lineid $id $mx $my
      }
    }
    0 {
      xth_me_cmds_select "$id $pid"
    }
    default {
      xth_me_cmds_click_area ln$id.$pid $mx $my
    }
  }
}



proc xth_me_cmds_click_area {tagOrId x y} {
  global xth
  xth_me_cmds_click {} $tagOrId [xth_me_can2realx [$xth(me,can) canvasx $x]] [xth_me_can2realy [$xth(me,can) canvasy $y]] $x $y
}


proc xth_me_cmds_set_mode {nmode} {
  
  global xth
  
  if {!$xth(me,fopen)} {
    return
  }

  if {($nmode == 0) && ($xth(me,cmds,mode) == 0)} {
    xth_me_cmds_select_nopoint
  }

  set xth(me,cmds,mode) $nmode
  switch $nmode {
    0 {
      $xth(me,mbar) configure -text "select object" -bg green -fg black
      $xth(ctrl,me,ac).ins configure -text "Insert"
    }
    1 {
      $xth(me,mbar) configure -text "insert point" -bg red -fg white
    }
    2 {
      $xth(me,mbar) configure -text "insert line point" -bg red -fg white
    }
    3 {
      $xth(me,mbar) configure -text "insert area border" -bg red -fg white
      $xth(ctrl,me,ac).ins configure -text "Select"
    }
  }
  
}


proc xth_me_cmds_create_point {ix mode x y type opts} {

  global xth
  xth_me_cmds_update {}
  set id [xth_me_cmds_create 2 {} $ix]

  set xth(me,cmds,$id,x) $x
  set xth(me,cmds,$id,y) $y
  
  if {$mode && ([string length $opts] < 1)} {
    if {([string length $type] < 1) && \
        [string equal $xth(me,dflt,point,type) station] && \
        [regexp {\-name\s+(\S+)} $xth(me,dflt,point,options) dum stname]} {
      regsub {\-name\s+(\S+)} $xth(me,dflt,point,options) "-name [xth_incr_station_name $stname $xth(me,snai)]" xth(me,dflt,point,options)
    }
    set opts $xth(me,dflt,point,options)
  }

  if {[string length $type] > 0} {
    set xth(me,cmds,$id,type) $type
  } else {
    set xth(me,cmds,$id,type) $xth(me,dflt,point,type)
  }
  
  # nastavit meno
  set optl [xth_me_cmds_get_line_option $opts id]
  if {[lindex $optl 2]} {
    set xth(me,cmds,$id,name) [lindex $optl 0]
    set opts [lindex $optl 1]
  }
  
  # nastavit rotation
  if {$mode} {
    set xth(me,cmds,$id,rotation) $xth(me,dflt,point,rotation)
  } else {
    set xth(me,cmds,$id,rotation) {}
  }
  set optl [xth_me_cmds_get_line_option $opts orientation]
  if {[lindex $optl 2]} {
    set xth(me,cmds,$id,rotation) [lindex $optl 0]
    set opts [lindex $optl 1]
  } else {
    set optl [xth_me_cmds_get_line_option $opts orient]
    if {[lindex $optl 2]} {
      set xth(me,cmds,$id,rotation) [lindex $optl 0]
      set opts [lindex $optl 1]
    }
  }

  # nastavit xsize
  if {$mode} {
    set xth(me,cmds,$id,xsize) $xth(me,dflt,point,xsize)
  } else {
    set xth(me,cmds,$id,xsize) {}
  }
  set optl [xth_me_cmds_get_line_option $opts size]
  if {[lindex $optl 2]} {
    set xth(me,cmds,$id,xsize) [lindex $optl 0]
    set xth(me,cmds,$id,ysize) [lindex $optl 0]
    set opts [lindex $optl 1]
  }
  set optl [xth_me_cmds_get_line_option $opts "x-size"]
  if {[lindex $optl 2]} {
    set xth(me,cmds,$id,xsize) [lindex $optl 0]
    set opts [lindex $optl 1]
  }

  # nastavit ysize
  if {$mode} {
    set xth(me,cmds,$id,ysize) $xth(me,dflt,point,ysize)
  } else {
    set xth(me,cmds,$id,ysize) {}
  }
  set optl [xth_me_cmds_get_line_option $opts "y-size"]
  if {[lindex $optl 2]} {
    set xth(me,cmds,$id,ysize) [lindex $optl 0]
    set opts [lindex $optl 1]
  }
  
#  if {([string length $xth(me,cmds,$id,ysize)] > 0) &&
#      ([string length $xth(me,cmds,$id,xsize)] == 0)} {
#    set xth(me,cmds,$id,xsize) $xth(me,cmds,$id,ysize)
#    set xth(me,cmds,$id,ysize) {}
#  }

  # nastavit options
  regsub {^\s*} $opts "" opts
  regsub {\s*$} $opts "" opts
  set xth(me,cmds,$id,options) $opts
  
  xth_me_cmds_draw_point $id
  if {$mode} {
    $xth(me,can) itemconfigure pt$id -fill lightBlue
  }
  xth_me_cmds_update_list $id
  xth_me_cmds_update_point_data $id
  if {$mode} {
    xth_me_unredo_action "creating point" "xth_me_cmds_delete $id" \
      "xth_me_cmds_undelete $id 0 [lsearch $xth(me,cmds,xlist) $id]"  
    xth_me_cmds_select $id
  }

}


proc xth_me_cmds_update_point_data {id} {

  global xth

  set d "point $xth(me,cmds,$id,x) $xth(me,cmds,$id,y) $xth(me,cmds,$id,type)"
  set xth(me,dflt,point,type) $xth(me,cmds,$id,type)

  if {[string length $xth(me,cmds,$id,name)] > 0} {
    set d "$d -id $xth(me,cmds,$id,name)"
  }
  
  if {[string length $xth(me,cmds,$id,rotation)] > 0} {
    set d "$d -orientation $xth(me,cmds,$id,rotation)"
  }
  set xth(me,dflt,point,rotation) $xth(me,cmds,$id,rotation)

  if {[string length $xth(me,cmds,$id,xsize)] > 0} {
    set d "$d -x-size $xth(me,cmds,$id,xsize)"
  }
  set xth(me,dflt,point,xsize) $xth(me,cmds,$id,xsize)

  if {[string length $xth(me,cmds,$id,ysize)] > 0} {
    set d "$d -y-size $xth(me,cmds,$id,ysize)"
  }
  set xth(me,dflt,point,ysize) $xth(me,cmds,$id,ysize)

  if {[string length $xth(me,cmds,$id,options)] > 0} {
    set d "$d $xth(me,cmds,$id,options)"
  }
  set xth(me,dflt,point,options) $xth(me,cmds,$id,options)

  set xth(me,cmds,$id,data) "$d"
  
}


proc xth_me_cmds_move_point_xctrl {id} {
  global xth
  set cx [xth_me_real2canx $xth(me,cmds,$id,x)]
  set cy [xth_me_real2cany $xth(me,cmds,$id,y)]
  $xth(me,can) coords $xth(me,canid,point,selector) [list \
    [expr $cx - 3 * $xth(gui,me,point,psize)] \
    [expr $cy - 3 * $xth(gui,me,point,psize)] \
    [expr $cx + 3 * $xth(gui,me,point,psize)] \
    [expr $cy + 3 * $xth(gui,me,point,psize)]
  ]
}

proc xth_me_cmds_show_point_xctrl {id} {
  global xth
  $xth(me,can) itemconfigure $xth(me,canid,point,selector) -state normal
  $xth(me,can) raise $xth(me,canid,point,selector)
  $xth(me,can) raise ptfill
  $xth(me,can) lower ptfill point
  xth_me_cmds_move_point_xctrl $id
  xth_me_cmds_show_point_fill_xctrl $id
  $xth(me,can) raise pt$id
}


proc xth_me_cmds_show_point_fill_xctrl {id} {
  global xth
  if {$xth(ctrl,me,point,xsid) || $xth(ctrl,me,point,ysid)} {
    xth_me_cmds_configure_point_fill_xctrl $id 1
    xth_me_cmds_move_point_fill_xctrl $id $xth(ctrl,me,point,rot) $xth(ctrl,me,point,xs) $xth(ctrl,me,point,ys)
  } elseif {$xth(ctrl,me,point,rotid)} {
    xth_me_cmds_configure_point_fill_xctrl $id 0
    xth_me_cmds_move_point_fill_xctrl $id $xth(ctrl,me,point,rot) $xth(ctrl,me,point,xs) $xth(ctrl,me,point,ys)
  } else {
    xth_me_cmds_configure_point_fill_xctrl {} 0
  }
}


proc xth_me_cmds_hide_point_xctrl {} {
  global xth
  $xth(me,can) itemconfigure $xth(me,canid,point,selector) -state hidden
  xth_me_cmds_configure_point_fill_xctrl {} {}
}


proc xth_me_cmds_update_point_ctrl {id} {
  global xth
  if {[string length $id] > 0} {

    $xth(ctrl,me,point).posl configure -state normal
    $xth(ctrl,me,point).posx configure -state normal
    $xth(ctrl,me,point).posy configure -state normal
    $xth(ctrl,me,point).upd configure -state normal
    $xth(ctrl,me,point).typl configure -state normal
    $xth(ctrl,me,point).typ configure -state normal
    $xth(ctrl,me,point).namel configure -state normal
    $xth(ctrl,me,point).name configure -state normal
    $xth(ctrl,me,point).optl configure -state normal
    $xth(ctrl,me,point).opt configure -state normal
    $xth(ctrl,me,point).rotc configure -state normal
    $xth(ctrl,me,point).rot configure -state normal
    $xth(ctrl,me,point).xszc configure -state normal
    $xth(ctrl,me,point).xsz configure -state normal
    $xth(ctrl,me,point).yszc configure -state normal
    $xth(ctrl,me,point).ysz configure -state normal
    
    set xth(ctrl,me,point,x) $xth(me,cmds,$id,x)
    set xth(ctrl,me,point,y) $xth(me,cmds,$id,y)
    set xth(ctrl,me,point,type) $xth(me,cmds,$id,type)
    set xth(ctrl,me,point,name) $xth(me,cmds,$id,name)
    set xth(ctrl,me,point,opts) $xth(me,cmds,$id,options)

    set xth(ctrl,me,point,rot) $xth(me,cmds,$id,rotation)
    if {[string length $xth(me,cmds,$id,rotation)] > 0} {
      set xth(ctrl,me,point,rotid) 1
    } else {
      set xth(ctrl,me,point,rotid) 0
    }

    set xth(ctrl,me,point,xs) $xth(me,cmds,$id,xsize)
    if {[string length $xth(me,cmds,$id,xsize)] > 0} {
      set xth(ctrl,me,point,xsid) 1
    } else {
      set xth(ctrl,me,point,xsid) 0
    }

    set xth(ctrl,me,point,ys) $xth(me,cmds,$id,ysize)
    if {[string length $xth(me,cmds,$id,ysize)] > 0} {
      set xth(ctrl,me,point,ysid) 1
    } else {
      set xth(ctrl,me,point,ysid) 0
    }
    
    xth_me_cmds_show_point_xctrl $id
    xth_me_prev_cmd $xth(me,cmds,$id,data)
    
  } else {
  
    set xth(ctrl,me,point,x) {}
    set xth(ctrl,me,point,y) {}
    set xth(ctrl,me,point,type) $xth(me,dflt,point,type)
    set xth(ctrl,me,point,name) {}
    set xth(ctrl,me,point,opts) $xth(me,dflt,point,options)

    set xth(ctrl,me,point,rot) $xth(me,dflt,point,rotation)
    if {[string length $xth(me,dflt,point,rotation)] > 0} {
      set xth(ctrl,me,point,rotid) 1
    } else {
      set xth(ctrl,me,point,rotid) 0
    }

    set xth(ctrl,me,point,xs) $xth(me,dflt,point,xsize)
    if {[string length $xth(me,dflt,point,xsize)] > 0} {
      set xth(ctrl,me,point,xsid) 1
    } else {
      set xth(ctrl,me,point,xsid) 0
    }

    set xth(ctrl,me,point,ys) $xth(me,dflt,point,ysize)
    if {[string length $xth(me,dflt,point,ysize)] > 0} {
      set xth(ctrl,me,point,ysid) 1
    } else {
      set xth(ctrl,me,point,ysid) 0
    }

    $xth(ctrl,me,point).posl configure -state disabled
    $xth(ctrl,me,point).posx configure -state disabled
    $xth(ctrl,me,point).posy configure -state disabled
    $xth(ctrl,me,point).upd configure -state disabled
    $xth(ctrl,me,point).typl configure -state disabled
    $xth(ctrl,me,point).typ configure -state disabled
    $xth(ctrl,me,point).namel configure -state disabled
    $xth(ctrl,me,point).name configure -state disabled
    $xth(ctrl,me,point).optl configure -state disabled
    $xth(ctrl,me,point).opt configure -state disabled
    $xth(ctrl,me,point).rotc configure -state disabled
    $xth(ctrl,me,point).rot configure -state disabled
    $xth(ctrl,me,point).xszc configure -state disabled
    $xth(ctrl,me,point).xsz configure -state disabled
    $xth(ctrl,me,point).yszc configure -state disabled
    $xth(ctrl,me,point).ysz configure -state disabled
    
    xth_me_cmds_hide_point_xctrl  
  }
}


proc xth_me_cmds_update_point_vars {id} {

  global xth
  set xth(ctrl,me,point,x) $xth(me,cmds,$id,x)
  set xth(ctrl,me,point,y) $xth(me,cmds,$id,y)
  set xth(ctrl,me,point,type) $xth(me,cmds,$id,type)
  set xth(ctrl,me,point,name) $xth(me,cmds,$id,name)
  set xth(ctrl,me,point,opts) $xth(me,cmds,$id,options)
  set xth(ctrl,me,point,rot) $xth(me,cmds,$id,rotation)
  
  if {[string length $xth(me,cmds,$id,rotation)] > 0} {
    set xth(ctrl,me,point,rotid) 1
  } else {
    set xth(ctrl,me,point,rotid) 0
  }
  
  set xth(ctrl,me,point,xs) $xth(me,cmds,$id,xsize)
  if {[string length $xth(me,cmds,$id,xsize)] > 0} {
    set xth(ctrl,me,point,xsid) 1
  } else {
    set xth(ctrl,me,point,xsid) 0
  }
  
  set xth(ctrl,me,point,ys) $xth(me,cmds,$id,ysize)
  if {[string length $xth(me,cmds,$id,ysize)] > 0} {
    set xth(ctrl,me,point,ysid) 1
  } else {
    set xth(ctrl,me,point,ysid) 0
  }

  xth_me_cmds_move_point_xctrl $id
  xth_me_cmds_show_point_fill_xctrl $id
  
}

proc xth_me_cmds_update_area {id ntype nopt} {

  global xth
  
  set otype $xth(me,cmds,$id,type)
  set oopt $xth(me,cmds,$id,options)

  regsub {^\s*} $nopt "" nopt
  regsub {\s*$} $nopt "" nopt

  if {[string length $ntype] < 1} {
    set ntype $otype
  }
  if {(![string equal $ntype $otype]) && [string equal $nopt $oopt]} {
    set nopt {}
  }
  
  if {![string equal "$ntype $nopt" "$otype $oopt"]} {
    xth_me_unredo_action "area changes" \
      "xth_me_cmds_update_area $id $otype [list $oopt]; xth_me_cmds_select $id" \
      "xth_me_cmds_update_area $id $ntype [list $nopt]; xth_me_cmds_select $id"
    set xth(me,cmds,$id,type) $ntype
    set xth(me,cmds,$id,options) $nopt
    xth_me_cmds_update_area_data $id
    xth_me_cmds_update_list $id
  }

}




proc xth_me_cmds_update_point {id nx ny ntype nname nopt nrot nxs nys} {

  global xth
  
  set ox $xth(me,cmds,$id,x)
  set oy $xth(me,cmds,$id,y)
  set otype $xth(me,cmds,$id,type)
  set oname $xth(me,cmds,$id,name)
  set oopt $xth(me,cmds,$id,options)
  set orot $xth(me,cmds,$id,rotation)
  set oxs $xth(me,cmds,$id,xsize)
  set oys $xth(me,cmds,$id,ysize)

  regsub {^\s*} $nopt "" nopt
  regsub {\s*$} $nopt "" nopt

  if {[string length $ntype] < 1} {
    set ntype $otype
  }
  if {(![string equal $ntype $otype]) && [string equal $nopt $oopt]} {
    set nopt {}
    set nrot {}
    set nxs {}
    set nys {}
  }
  
  if {[string length $nrot] > 0} {
    if {[catch {expr $nrot}]} {
      set nrot $orot
    } elseif {($nrot < 0.0) || ($nrot >= 360.0)} {
      set nrot $orot
    }
  }
  
  if {[catch {expr $nx}]} {
    set nx $ox
  }
  if {[catch {expr $ny}]} {
    set ny $oy
  }
  
  if {[string length $nxs] > 0} {
    if {[catch {expr $nxs}]} {
      set nxs $oxs
    } elseif {$nxs < 0.0} {
      set nxs $oxs
    }
  }
  if {[string length $nys] > 0} {
    if {[catch {expr $nys}]} {
      set nys $oys
    } elseif {$nys < 0.0} {
      set nys $oys
    }
  }
#  if {([string length $nys] > 0) && ([string length $nxs] == 0)} {
#    set nxs $nys
#    set nys {}
#  }
  
  if {![string equal "$nx $ny $ntype $nname $nopt $nrot $nxs $nys" "$ox $oy $otype $oname $oopt $orot $oxs $oys"]} {
    xth_me_unredo_action "point changes" \
      "xth_me_cmds_update_point $id $ox $oy $otype [list $oname] [list $oopt] [list $orot] [list $oxs] [list $oys]; xth_me_cmds_select $id" \
      "xth_me_cmds_update_point $id $nx $ny $ntype [list $nname] [list $nopt] [list $nrot] [list $nxs] [list $nys]; xth_me_cmds_select $id"
    set xth(me,cmds,$id,x) $nx
    set xth(me,cmds,$id,y) $ny
    set xth(me,cmds,$id,type) $ntype
    set xth(me,cmds,$id,name) $nname
    set xth(me,cmds,$id,options) $nopt
    set xth(me,cmds,$id,rotation) $nrot
    set xth(me,cmds,$id,xsize) $nxs
    set xth(me,cmds,$id,ysize) $nys
    $xth(me,can) coords pt$id [xth_me_cmds_calc_point_coords $id]
    xth_me_cmds_update_point_data $id
    xth_me_cmds_update_list $id
  }
  
}


proc xth_me_cmds_calc_point_coords {id} {
  global xth
  return [list \
    [expr [xth_me_real2canx $xth(me,cmds,$id,x)] - $xth(gui,me,point,psize)] \
    [expr [xth_me_real2cany $xth(me,cmds,$id,y)] - $xth(gui,me,point,psize)] \
    [expr [xth_me_real2canx $xth(me,cmds,$id,x)] + $xth(gui,me,point,psize)] \
    [expr [xth_me_real2cany $xth(me,cmds,$id,y)] + $xth(gui,me,point,psize)]
  ]
}


proc xth_me_cmds_draw_point {id} {
  global xth
  $xth(me,can) create oval [xth_me_cmds_calc_point_coords $id] \
    -tags "command point pt$id" -width 1 -outline blue -fill blue
  $xth(me,can) bind pt$id <Enter> "$xth(me,can) itemconfigure pt$id -fill cyan; xth_status_bar_push me; xth_status_bar_status me \"\$xth(me,cmds,$id,listix): \$xth(me,cmds,$id,data)\""
  $xth(me,can) bind pt$id <Leave> "$xth(me,can) itemconfigure pt$id -fill \[$xth(me,can) itemcget pt$id -outline\]; xth_status_bar_pop me"
  $xth(me,can) bind pt$id <1> "xth_me_cmds_click $id pt$id \$xth(me,cmds,$id,x) \$xth(me,cmds,$id,y) %x %y"
  $xth(me,can) bind pt$id <3> "xth_me_cmds_special_select $id %x %y"  
  $xth(me,can) bind pt$id <Shift-1> "xth_me_cmds_special_select $id %x %y"  
  $xth(me,can) bind pt$id <$xth(kb_control)-1> "xth_me_cmds_click_area pt$id %x %y"
}


proc xth_me_cmds_special_select {id x y} {
  global xth
  if {[llength $id] == 2} {
    set pid [lindex $id 1]
    set id [lindex $id 0]
  } else {
    set pid 0
  }
  $xth(me,can) raise point
  if {$xth(me,cmds,selid) != $id} {
    xth_me_cmds_select "$id $pid"
    if {$pid != 0} {
      xth_ctrl_scroll_to me line
      xth_ctrl_maximize me line
      xth_ctrl_maximize me linept
    } else {
      xth_ctrl_scroll_to me point
      xth_ctrl_maximize me point

    }
  } elseif {($xth(me,cmds,$id,ct) == 3) && ($xth(me,cmds,selpid) != $pid)} {
    xth_me_cmds_select_linept $id $pid
    xth_ctrl_scroll_to me line
    xth_ctrl_maximize me line
    xth_ctrl_maximize me linept
  } else {
    $xth(me,can) dtag all nearest
    if {$pid != 0} {
      set utag pt$id.$pid
    } else {
      set utag pt$id
    }
    $xth(me,can) addtag nearest closest [$xth(me,can) canvasx $x] [$xth(me,can) canvasy $y] 0 $utag
    set tgs [$xth(me,can) itemcget nearest -tags]
    #puts $tgs
    if {[regexp "(^|\\s)pt(\\d+)($|\\s)" $tgs d1 d2 nid]} {
      #puts "select $nid"
      xth_me_cmds_select $nid
      xth_ctrl_scroll_to me point
      xth_ctrl_maximize me point
      catch {$xth(me,can) lower $utag point}
      catch {$xth(me,can) raise $utag line}
    } elseif {[regexp "(^|\\s)pt(\\d+)\.(\\d+)($|\\s)" $tgs d1 d2 nid npid]} {
      #puts "select $nid $npid"
      xth_me_cmds_select "$nid $npid"
      if {$npid != 0} {
        xth_ctrl_scroll_to me line
        xth_ctrl_maximize me line
        xth_ctrl_maximize me linept
      } else {
        xth_ctrl_scroll_to me point
        xth_ctrl_maximize me point
      }
      catch {$xth(me,can) lower $utag point}
      catch {$xth(me,can) raise $utag line}
    }
  }
}


proc xth_me_cmds_start_point_drag {id x y} {
  global xth
  xth_me_cmds_update {}
  xth_me_cmds_drag_point_config_xctrl $id
  set xth(me,point,drag_mx) $x
  set xth(me,point,drag_my) $y
  set xth(me,point,drag_px) $xth(me,cmds,$id,x)
  set xth(me,point,drag_py) $xth(me,cmds,$id,y)
  set xth(me,point,drag_benter) [$xth(me,can) bind pt$id <Enter>]
  set xth(me,point,drag_bleave) [$xth(me,can) bind pt$id <Leave>]
  $xth(me,can) bind pt$id <Enter> ""
  $xth(me,can) bind pt$id <Leave> ""
  $xth(me,can) itemconfigure pt$id -fill {}
  $xth(me,can) bind pt$id <B1-Motion> "xth_me_cmds_point_drag $id %x %y 1"
  $xth(me,can) bind pt$id <B1-ButtonRelease> "xth_me_cmds_end_point_drag $id %x %y 1"
  $xth(me,can) bind pt$id <$xth(kb_control)-B1-Motion> "xth_me_cmds_point_drag $id %x %y 0"
  $xth(me,can) bind pt$id <$xth(kb_control)-B1-ButtonRelease> "xth_me_cmds_end_point_drag $id %x %y 0"
  $xth(me,can) configure -cursor {}
}


proc xth_me_cmds_drag_to {id pid x y} {
  global xth
  $xth(me,can) dtag all nearest
  if {[string length $pid] > 0} {
    set stt pt$id.$pid
  } else {
    set stt pt$id
  }
  $xth(me,can) addtag nearest closest [$xth(me,can) canvasx $x] \
    [$xth(me,can) canvasy $y] 0 $stt
  set tgs [$xth(me,can) itemcget nearest -tags]
  if {[regexp "(^|\\s)pt(\\d+)($|\\s)" $tgs d1 d2 nid]} {
    # je vybraty bod, nastavime suradnice podla neho
    set nx $xth(me,cmds,$nid,x)
    set ny $xth(me,cmds,$nid,y)
    return [list 1 $nx $ny]
  } elseif {[regexp "(^|\\s)pt(\\d+)\.(\\d+)($|\\s)" $tgs d1 d2 nid npid]} {
    # je vybraty bod na ciare, nastavime suradnice podla neho
    set nx $xth(me,cmds,$nid,$npid,x)
    set ny $xth(me,cmds,$nid,$npid,y)
    return [list 1 $nx $ny]
  }
  return 0
}


proc xth_me_cmds_point_drag {id x y dragto} {
  global xth
  set nx [expr $xth(me,point,drag_px) - [expr double($xth(me,point,drag_mx) - $x) * 100.0 / $xth(me,zoom)]]
  set ny [expr $xth(me,point,drag_py) + [expr double($xth(me,point,drag_my) - $y) * 100.0 / $xth(me,zoom)]]
  set dts 0
  if $dragto {
    set dtl [xth_me_cmds_drag_to $id {} $x $y]
    if {[lindex $dtl 0]} {
      set nx [lindex $dtl 1]
      set ny [lindex $dtl 2]
      set dts 1
    }
  }
  if $dts {
    $xth(me,can) itemconfigure pt$id -fill cyan
  } else {
    $xth(me,can) itemconfigure pt$id -fill {}
  }
  set xth(me,cmds,$id,x) $nx
  set xth(me,cmds,$id,y) $ny
  set xth(ctrl,me,point,x) $nx
  set xth(ctrl,me,point,y) $ny
  xth_me_cmds_move_point_xctrl $id
  xth_me_cmds_move_point_fill_xctrl $id $xth(me,cmds,$id,rotation) $xth(me,cmds,$id,xsize) $xth(me,cmds,$id,ysize) 
  $xth(me,can) coords pt$id [xth_me_cmds_calc_point_coords $id]
  update idletasks
}


proc xth_me_cmds_end_point_drag {id x y dragto} {
  global xth
  xth_me_cmds_point_drag $id $x $y $dragto
  set xth(me,cmds,$id,x) $xth(me,point,drag_px)
  set xth(me,cmds,$id,y) $xth(me,point,drag_py)
  $xth(me,can) bind pt$id <B1-Motion> ""
  $xth(me,can) bind pt$id <B1-ButtonRelease> ""
  $xth(me,can) bind pt$id <$xth(kb_control)-B1-Motion> ""
  $xth(me,can) bind pt$id <$xth(kb_control)-B1-ButtonRelease> ""
  $xth(me,can) bind pt$id <Enter> $xth(me,point,drag_benter)
  $xth(me,can) bind pt$id <Leave> $xth(me,point,drag_bleave)
  $xth(me,can) itemconfigure pt$id -fill cyan
  $xth(me,can) configure -cursor crosshair
  set xth(me,unredola) "point dragging"
  xth_me_cmds_update {}
  xth_me_cmds_end_drag_point_config_xctrl $id
}


proc xth_me_cmds_configure_point_fill_xctrl {id sid} {
  global xth
  if {[string length $id] > 0} {
    # $xth(me,can) itemconfigure $xth(me,canid,point,fx) -state normal
    $xth(me,can) bind $xth(me,canid,point,fx) <1> \
      "xth_me_cmds_start_point_fdrag $xth(me,canid,point,fx) $id x %x %y"
    $xth(me,can) bind $xth(me,canid,point,fx) <Enter> \
      "$xth(me,can) itemconfigure $xth(me,canid,point,fx) -fill #ffda00"
    $xth(me,can) bind $xth(me,canid,point,fx) <Leave> \
      "$xth(me,can) itemconfigure $xth(me,canid,point,fx) -fill red"
    $xth(me,can) itemconfigure $xth(me,canid,point,fy) -state normal
    $xth(me,can) bind $xth(me,canid,point,fy) <1> \
      "xth_me_cmds_start_point_fdrag $xth(me,canid,point,fy) $id y %x %y"
    $xth(me,can) bind $xth(me,canid,point,fy) <Enter> \
      "$xth(me,can) itemconfigure $xth(me,canid,point,fy) -fill #ffda00"
    $xth(me,can) bind $xth(me,canid,point,fy) <Leave> \
      "$xth(me,can) itemconfigure $xth(me,canid,point,fy) -fill red"
    #$xth(me,can) itemconfigure $xth(me,canid,point,fxc) -state normal
    #$xth(me,can) bind $xth(me,canid,point,fxc) <Enter> \
    #  "$xth(me,can) itemconfigure $xth(me,canid,point,fxc) -fill yellow"
    #$xth(me,can) bind $xth(me,canid,point,fxc) <Leave> \
    #  "$xth(me,can) itemconfigure $xth(me,canid,point,fxc) -fill red"
    #$xth(me,can) bind $xth(me,canid,point,fxc) <1> \
    #  "xth_me_cmds_start_point_fdrag $xth(me,canid,point,fxc) $id x %x %y"
    #$xth(me,can) itemconfigure $xth(me,canid,point,fyc) -state normal
    #$xth(me,can) bind $xth(me,canid,point,fyc) <Enter> \
    #  "$xth(me,can) itemconfigure $xth(me,canid,point,fyc) -fill yellow"
    #$xth(me,can) bind $xth(me,canid,point,fyc) <Leave> \
    #  "$xth(me,can) itemconfigure $xth(me,canid,point,fyc) -fill red"
    #$xth(me,can) bind $xth(me,canid,point,fyc) <1> \
    #  "xth_me_cmds_start_point_fdrag $xth(me,canid,point,fyc) $id y %x %y"
    if {$sid} {
      $xth(me,can) itemconfigure $xth(me,canid,point,fill) -state normal
      #$xth(me,can) bind $xth(me,canid,point,fill) <1> \
      #  "xth_me_cmds_start_point_fdrag $xth(me,canid,point,fill) $id z %x %y"
    } else {
      $xth(me,can) itemconfigure $xth(me,canid,point,fill) -state hidden
    }
  } else {
      # $xth(me,can) bind $xth(me,canid,point,fxc) <Enter> ""
      # $xth(me,can) bind $xth(me,canid,point,fxc) <Leave> ""
      # $xth(me,can) bind $xth(me,canid,point,fyc) <Enter> ""
      # $xth(me,can) bind $xth(me,canid,point,fyc) <Leave> ""
      $xth(me,can) bind $xth(me,canid,point,fx) <1> ""
      $xth(me,can) bind $xth(me,canid,point,fy) <1> ""
      $xth(me,can) bind $xth(me,canid,point,fx) <Enter> ""
      $xth(me,can) bind $xth(me,canid,point,fx) <Leave> ""
      $xth(me,can) bind $xth(me,canid,point,fy) <Enter> ""
      $xth(me,can) bind $xth(me,canid,point,fy) <Leave> ""
      #$xth(me,can) bind $xth(me,canid,point,fill) <1> ""
      $xth(me,can) itemconfigure ptfill -state hidden
  }
}


proc xth_me_cmds_move_point_fill_xctrl {id rot sx sy} {

  global xth
  
  if {[string length $rot] > 0} {
    set rot [expr double($rot) / 180 * 3.14159265359]
  } else {
    set rot 0.0
  }

  set setfsx 0
  if {[string length $sx] > 0} {
    set sx [expr $sx * 0.01 * $xth(me,zoom)]
    set fsx $sx
  } else {
    set sx 30.0
    set setfsx 1
  }

#  if {[string length $sy] > 0} {
#    set sy [expr $sy * 0.01 * $xth(me,zoom)]
#  } else {
#    if {[string length $sx] > 0} {
#      set sy $sx
#    } else {
#      set sy 30.0
#    }
#  }

  if {[string length $sy] > 0} {
    set sy [expr $sy * 0.01 * $xth(me,zoom)]
    set fsy $sy
  } else {
    set sy 30.0
    set fsy $sx
  }

  if {$setfsx} {
    set fsx $sy
  }

  set x [xth_me_real2canx $xth(me,cmds,$id,x)]
  set y [xth_me_real2cany $xth(me,cmds,$id,y)]
  set ca [expr cos($rot)]
  set sa [expr sin($rot)]
  
  set xvx [expr $ca * $sx]
  set xvy [expr $sa * $sx]
  set yvx [expr $sa * $sy]
  set yvy [expr - $ca * $sy]

  set fxvx [expr $ca * $fsx]
  set fxvy [expr $sa * $fsx]
  set fyvx [expr $sa * $fsy]
  set fyvy [expr - $ca * $fsy]
  
  
  $xth(me,can) coords $xth(me,canid,point,fx) $x $y [expr $x + $xvx] [expr $y + $xvy]
  set xth(me,canid,point,fx_tox) [expr $x + $xvx]
  set xth(me,canid,point,fx_toy) [expr $y + $xvy]
  #$xth(me,can) coords $xth(me,canid,point,fxc) [expr $x + $xvx - $xth(gui,me,point,cpsize)] [expr $y + $xvy - $xth(gui,me,point,cpsize)] [expr $x + $xvx + $xth(gui,me,point,cpsize)] [expr $y + $xvy + $xth(gui,me,point,cpsize)]
  $xth(me,can) coords $xth(me,canid,point,fy) $x $y [expr $x + $yvx] [expr $y + $yvy]
  set xth(me,canid,point,fy_tox) [expr $x + $yvx]
  set xth(me,canid,point,fy_toy) [expr $y + $yvy]
  #$xth(me,can) coords $xth(me,canid,point,fyc) [expr $x + $yvx - $xth(gui,me,point,cpsize)] [expr $y + $yvy - $xth(gui,me,point,cpsize)] [expr $x + $yvx + $xth(gui,me,point,cpsize)] [expr $y + $yvy + $xth(gui,me,point,cpsize)]
  $xth(me,can) coords $xth(me,canid,point,fill) [expr $x + $fxvx + $fyvx] [expr $y + $fxvy + $fyvy] \
    [expr $x + $fxvx - $fyvx] [expr $y + $fxvy - $fyvy] [expr $x - $fxvx - $fyvx] [expr $y - $fxvy - $fyvy] \
    [expr $x - $fxvx + $fyvx] [expr $y - $fxvy + $fyvy]

  update idletasks    
}


proc xth_me_cmds_point_change_state {} {

  global xth  
  set newrotid $xth(ctrl,me,point,rotid)
  set newxsid $xth(ctrl,me,point,xsid)
  set newysid $xth(ctrl,me,point,ysid)

  xth_me_cmds_update {}

  if {$newrotid && \
    ([string length $xth(ctrl,me,point,rot)] < 1)} {
    set xth(ctrl,me,point,rot) 0.0
  } elseif {(! $newrotid) && \
    ([string length $xth(ctrl,me,point,rot)] > 0)} {
    set xth(ctrl,me,point,rot) {}
  }

  if {$newxsid && \
    ([string length $xth(ctrl,me,point,xs)] < 1)} {
    set xth(ctrl,me,point,xs) 40.0
  } elseif {(! $newxsid) && \
    ([string length $xth(ctrl,me,point,xs)] > 0)} {
    set xth(ctrl,me,point,xs) {}
#    set xth(ctrl,me,point,ys) {}
#    set xth(ctrl,me,point,ysid) 0
  }

  if {$newysid && \
    ([string length $xth(ctrl,me,point,ys)] < 1)} {
    set xth(ctrl,me,point,ys) 40.0
  } elseif {(! $newysid) && \
    ([string length $xth(ctrl,me,point,ys)] > 0)} {
    set xth(ctrl,me,point,ys) {}
  }

#  if {$newysid && \
#      ([string length $xth(ctrl,me,point,ys)] < 1) && \
#      $newxsid} {
#    set xth(ctrl,me,point,ys) 40.0
#  } elseif {((! $newysid) && \
#      ([string length $xth(ctrl,me,point,ys)] > 0)) || \
#      (! $newxsid)} {
#    set xth(ctrl,me,point,ys) {}
#    set xth(ctrl,me,point,ysid) 0    
#  }
  
  xth_me_cmds_update {}
  
}


proc xth_me_cmds_start_point_fdrag {tagOrId id ax x y} {
  global xth
  xth_me_cmds_update {}
  #if {[string equal $ax z]} {
  #  set distx [expr hypot([$xth(me,can) canvasx $x] - $xth(me,canid,point,fx_tox), \
  #    [$xth(me,can) canvasy $y] - $xth(me,canid,point,fx_toy))]
  #  set disty [expr hypot([$xth(me,can) canvasx $x] - $xth(me,canid,point,fy_tox), \
  #    [$xth(me,can) canvasy $y] - $xth(me,canid,point,fy_toy))]
  #  if {$disty < $distx} {
  #    set ax y
  #  } else {
  #    set ax x
  #  }
  #}
  set dx [expr [xth_me_can2realx [$xth(me,can) canvasx $x]] - $xth(me,cmds,$id,x)]
  set dy [expr [xth_me_can2realy [$xth(me,can) canvasy $y]] - $xth(me,cmds,$id,y)] 
  if {[string length $xth(me,cmds,$id,rotation)] == 0} {
    set xth(me,point,fdrag_rot) 0
  } else {
    set xth(me,point,fdrag_rot) 1
    set xth(me,point,fdrag_orot) [expr atan2($dy,$dx)]
  }
  if {([string length $xth(me,cmds,$id,xsize)] == 0) && ([string length $xth(me,cmds,$id,ysize)] == 0)} {
    set xth(me,point,fdrag_size) 0
  } elseif {[string equal $ax y] && ([string length $xth(me,cmds,$id,ysize)] == 0)} {
    set xth(me,point,fdrag_size) 0
  } elseif {[string equal $ax x] && ([string length $xth(me,cmds,$id,xsize)] == 0)} {
    set xth(me,point,fdrag_size) 0
  } else {
    set xth(me,point,fdrag_ax) $ax
    set xth(me,point,fdrag_size) 1
    set xth(me,point,fdrag_osize) [expr hypot($dy,$dx)]
  }
  $xth(me,can) itemconfigure $tagOrId -fill #ffda00
  set xth(me,point,fdrag_benter) [$xth(me,can) bind $tagOrId <Enter>]
  set xth(me,point,fdrag_bleave) [$xth(me,can) bind $tagOrId <Leave>]
  $xth(me,can) bind $tagOrId <Enter> ""
  $xth(me,can) bind $tagOrId <Leave> ""
  $xth(me,can) bind $tagOrId <B1-Motion> "xth_me_cmds_point_fdrag $id %x %y"
  $xth(me,can) bind $tagOrId <B1-ButtonRelease> "xth_me_cmds_end_point_fdrag $tagOrId $id %x %y"
  $xth(me,can) configure -cursor {}
}

proc xth_me_cmds_point_fdrag {id x y} {
  global xth
  set dx [expr [xth_me_can2realx [$xth(me,can) canvasx $x]] - $xth(me,cmds,$id,x)]
  set dy [expr [xth_me_can2realy [$xth(me,can) canvasy $y]] - $xth(me,cmds,$id,y)] 
  if $xth(me,point,fdrag_rot) {
    set rot [expr double($xth(me,cmds,$id,rotation)) - 180.0 / 3.14159265359 * (atan2($dy,$dx) - $xth(me,point,fdrag_orot))]
    if {$rot < 0.0} {
      set rot [expr 360.0 + $rot]
    } elseif {$rot >= 360.0} {
      set rot [expr $rot - 360.0]
    }
    set rot [format "%.1f" $rot]
  } else {
    set rot $xth(me,cmds,$id,rotation)
  }
  set xth(ctrl,me,point,rot) $rot
  if {$xth(me,point,fdrag_size)} {
    set cs [expr hypot($dy,$dx)]
    switch $xth(me,point,fdrag_ax) {
      x {
        set ns [expr $xth(me,cmds,$id,xsize) - $xth(me,point,fdrag_osize) + $cs]
        if {$ns <= 0.0} {set ns 0.1}
        set ns [format "%.1f" $ns]
        set xth(ctrl,me,point,xs) $ns
      }
      y {
        set ns [expr $xth(me,cmds,$id,ysize) - $xth(me,point,fdrag_osize) + $cs]
        if {$ns <= 0.0} {set ns 0.1}
        set ns [format "%.1f" $ns]
        set xth(ctrl,me,point,ys) $ns
      }
    }
  }
  xth_me_cmds_move_point_fill_xctrl $id $xth(ctrl,me,point,rot) $xth(ctrl,me,point,xs) $xth(ctrl,me,point,ys)
}

proc xth_me_cmds_end_point_fdrag {tagOrId id x y} {
  global xth
  xth_me_cmds_point_fdrag $id $x $y
  $xth(me,can) configure -cursor crosshair
  if {$xth(me,point,fdrag_size)} {
    set xth(me,unredola) "point resizing"
  } else {
    set xth(me,unredola) "point rotation"
  }
  $xth(me,can) bind $tagOrId <B1-Motion> ""
  $xth(me,can) bind $tagOrId <B1-ButtonRelease> ""
  if {[lsearch [$xth(me,can) itemcget $tagOrId -tags] current] > -1} {
    $xth(me,can) itemconfigure $tagOrId -fill #ffda00
  }
  $xth(me,can) bind $tagOrId <Enter> $xth(me,point,fdrag_benter)
  $xth(me,can) bind $tagOrId <Leave> $xth(me,point,fdrag_bleave)
  xth_me_cmds_update {}
}

proc xth_me_cmds_drag_point_config_xctrl {id} {
  global xth
  set xth(me,point,drag_stsel) [$xth(me,can) itemcget $xth(me,canid,point,selector) -state]
  $xth(me,can) itemconfigure $xth(me,canid,point,selector) -state hidden
  set xth(me,point,drag_stfx) [$xth(me,can) itemcget $xth(me,canid,point,fx) -state]
  $xth(me,can) itemconfigure $xth(me,canid,point,fx) -width 1 -arrow none
  #$xth(me,can) itemconfigure $xth(me,canid,point,fxc) -state hidden
  set xth(me,point,drag_stfy) [$xth(me,can) itemcget $xth(me,canid,point,fy) -state]
  $xth(me,can) itemconfigure $xth(me,canid,point,fy) -width 1 -arrow none
  #$xth(me,can) itemconfigure $xth(me,canid,point,fyc) -state hidden
  $xth(me,can) itemconfigure $xth(me,canid,point,fill) -fill {} -outline red
}


proc xth_me_cmds_end_drag_point_config_xctrl {id} {
  global xth
  $xth(me,can) itemconfigure $xth(me,canid,point,selector) -state $xth(me,point,drag_stsel)
  $xth(me,can) itemconfigure $xth(me,canid,point,fx) -width 5 -arrow last
  #$xth(me,can) itemconfigure $xth(me,canid,point,fxc) -state $xth(me,point,drag_stfx)
  $xth(me,can) itemconfigure $xth(me,canid,point,fy) -width 5 -arrow last
  #$xth(me,can) itemconfigure $xth(me,canid,point,fyc) -state $xth(me,point,drag_stfy)
  $xth(me,can) itemconfigure $xth(me,canid,point,fill) -fill red -outline {}
}

proc xth_me_cmds_select_nopoint {} {
  global xth
  set id $xth(me,cmds,selid)
  set ix [lsearch $xth(me,cmds,xlist) $id]
  set xl [llength $xth(me,cmds,xlist)]
  for {set ii $ix} {$ii < $xl} {incr ii} {
    set nid [lindex $xth(me,cmds,xlist) $ii]
    switch $xth(me,cmds,$nid,ct) {
      3 {
        xth_me_cmds_select "$nid 0"
        break
      }
      2 {}
      default {
        xth_me_cmds_select $nid
        break
      }
    }
  }
}







proc xth_me_cmds_get_option {ln opt} {
  set rxl [list [list "^\\s*$opt\\s+\\\[(\[^\\\]\]*)\\\]" "\["]\
    [list "^\\s*$opt\\s+\\\"((\\\"\\\"|\[^\\\"])+)\\\"" "\""]\
    [list "^\\s*$opt\\s+(\\S+)" {}]]
  set rln $ln
  set val {}
  set sep {}
  set res 0
  foreach rx $rxl {
    if {[regexp [lindex $rx 0] $ln dump val]} {
      regsub [lindex $rx 0] $ln {} rln
      regsub {^\s*} $rln {} rln
      set sep [lindex $rx 1]
      set res 1
      break
    }
  }
  return [list $val $rln $res]
}


proc xth_me_cmds_get_onoffauto {opt} {
  switch $opt {
    on {return 1}
    off {return 0}
    default {return -1}
  }
}


proc xth_me_cmds_get_bool {opt} {
  if {[lsearch {on 1 true yes} $opt] > -1} {
    return 1
  } else {
    return 0
  }
}


proc xth_me_cmds_update_line_ctrl {id} {

  global xth
  
  if {[string length $id] > 0} {

    $xth(ctrl,me,line).typl configure -state normal    
    $xth(ctrl,me,line).typ configure -state normal    
    $xth(ctrl,me,line).namel configure -state normal    
    $xth(ctrl,me,line).name configure -state normal    
    $xth(ctrl,me,line).optl configure -state normal    
    $xth(ctrl,me,line).opt configure -state normal    
    $xth(ctrl,me,line).rev configure -state normal    
    $xth(ctrl,me,line).cls configure -state normal    
#    $xth(ctrl,me,line).insp configure -state normal    
#    $xth(ctrl,me,line).delp configure -state normal    
    $xth(ctrl,me,line).lpa configure -state normal    
    $xth(ctrl,me,line).upd configure -state normal    
    $xth(ctrl,me,line).lpa.m entryconfigure "Insert point" -state normal    
    $xth(ctrl,me,line).lpa.m entryconfigure "Delete point" -state normal    
    $xth(ctrl,me,line).pl.l configure -takefocus 1 \
      -listvariable xth(me,cmds,$id,plist)

    set xth(ctrl,me,line,type) $xth(me,cmds,$id,type)
    set xth(ctrl,me,line,name) $xth(me,cmds,$id,name)
    set xth(ctrl,me,line,opts) $xth(me,cmds,$id,options)
    set xth(ctrl,me,line,reverse) $xth(me,cmds,$id,reverse)
    set xth(ctrl,me,line,close) $xth(me,cmds,$id,close)

    xth_me_prev_cmd $xth(me,cmds,$id,data)

    catch {$xth(me,can) raise lnln$id line}
    catch {$xth(me,can) raise lnpt$id point}
    
  } else {
  
    set xth(ctrl,me,line,name) {}
    set xth(ctrl,me,line,reverse) 0
    set xth(ctrl,me,line,close) 0
    set xth(ctrl,me,line,type) $xth(me,dflt,line,type)
    set xth(ctrl,me,line,opts) $xth(me,dflt,line,options)

    $xth(ctrl,me,line).typl configure -state disabled    
    $xth(ctrl,me,line).typ configure -state disabled    
    $xth(ctrl,me,line).namel configure -state disabled    
    $xth(ctrl,me,line).name configure -state disabled    
    $xth(ctrl,me,line).optl configure -state disabled    
    $xth(ctrl,me,line).opt configure -state disabled    
    $xth(ctrl,me,line).rev configure -state disabled    
    $xth(ctrl,me,line).cls configure -state disabled    
#    $xth(ctrl,me,line).insp configure -state disabled    
#    $xth(ctrl,me,line).delp configure -state disabled    
    $xth(ctrl,me,line).lpa configure -state disabled    
    $xth(ctrl,me,line).upd configure -state disabled
    $xth(ctrl,me,line).lpa.m entryconfigure "Insert point" -state disabled
    $xth(ctrl,me,line).lpa.m entryconfigure "Delete point" -state disabled   
    $xth(ctrl,me,line).pl.l configure -takefocus 0 \
      -listvariable xth(ctrl,me,line,empty)
    $xth(ctrl,me,line).pl.l selection clear 0 end
      
  }
  
}



proc xth_me_cmds_update_area_ctrl {id} {

  global xth
  
  if {[string length $id] > 0} {

    $xth(ctrl,me,ac).typl configure -state normal    
    $xth(ctrl,me,ac).typ configure -state normal    
    $xth(ctrl,me,ac).optl configure -state normal    
    $xth(ctrl,me,ac).opt configure -state normal    
    $xth(ctrl,me,ac).ins configure -state normal    
    $xth(ctrl,me,ac).del configure -state normal    
    $xth(ctrl,me,ac).insid configure -state normal    
    $xth(ctrl,me,ac).inside configure -state normal    
    $xth(ctrl,me,ac).upd configure -state normal    
    $xth(ctrl,me,ac).shw configure -state normal    
    $xth(ctrl,me,ac).ll.l configure -takefocus 1 \
      -listvariable xth(me,cmds,$id,llist)
    $xth(ctrl,me,ac).ll.l selection clear 0 end
    $xth(ctrl,me,ac).ll.l selection set end end
    $xth(ctrl,me,ac).ll.l see end
    
    set xth(ctrl,me,ac,type) $xth(me,cmds,$id,type)
    set xth(ctrl,me,ac,name) $xth(me,cmds,$id,name)
    set xth(ctrl,me,ac,opts) $xth(me,cmds,$id,options)
    set xth(ctrl,me,ac,insid) {}
    xth_me_prev_cmd $xth(me,cmds,$id,data)

  } else {
  
    set xth(ctrl,me,ac,name) {}
    set xth(ctrl,me,ac,insid) {}
    set xth(ctrl,me,ac,type) $xth(me,dflt,area,type)
    set xth(ctrl,me,ac,opts) $xth(me,dflt,area,options)

    $xth(ctrl,me,ac).typl configure -state disabled    
    $xth(ctrl,me,ac).typ configure -state disabled    
    $xth(ctrl,me,ac).optl configure -state disabled    
    $xth(ctrl,me,ac).opt configure -state disabled    
    $xth(ctrl,me,ac).ins configure -state disabled    
    $xth(ctrl,me,ac).del configure -state disabled    
    $xth(ctrl,me,ac).insid configure -state disabled    
    $xth(ctrl,me,ac).inside configure -state disabled    
    $xth(ctrl,me,ac).upd configure -state disabled    
    $xth(ctrl,me,ac).shw configure -state disabled    
    $xth(ctrl,me,ac).ll.l configure -takefocus 0 \
      -listvariable xth(ctrl,me,ac,empty)
    $xth(ctrl,me,ac).ll.l selection clear 0 end
      
  }
  
}



proc xth_me_cmds_move_lineptcp_xctrl {id ppid pid npid} {
  global xth
  
  set px [xth_me_real2canx $xth(me,cmds,$id,$pid,x)]
  set py [xth_me_real2cany $xth(me,cmds,$id,$pid,y)]
  
  if {$xth(me,cmds,$id,$pid,idp)} {
    set x [xth_me_real2canx $xth(me,cmds,$id,$pid,xp)]
    set y [xth_me_real2cany $xth(me,cmds,$id,$pid,yp)]
    $xth(me,can) coords $xth(me,canid,linept,pcp) [list \
      [expr $x - $xth(gui,me,line,cpsize)] \
      [expr $y - $xth(gui,me,line,cpsize)] \
      [expr $x + $xth(gui,me,line,cpsize)] \
      [expr $y + $xth(gui,me,line,cpsize)]]
    $xth(me,can) coords $xth(me,canid,linept,pcpl) $px $py $x $y
  }
  
  if {$xth(me,cmds,$id,$pid,idn)} {
    set x [xth_me_real2canx $xth(me,cmds,$id,$pid,xn)]
    set y [xth_me_real2cany $xth(me,cmds,$id,$pid,yn)]
    $xth(me,can) coords $xth(me,canid,linept,ncp) [list \
      [expr $x - $xth(gui,me,line,cpsize)] \
      [expr $y - $xth(gui,me,line,cpsize)] \
      [expr $x + $xth(gui,me,line,cpsize)] \
      [expr $y + $xth(gui,me,line,cpsize)]]
    $xth(me,can) coords $xth(me,canid,linept,ncpl) $px $py $x $y
  }

  if {($npid > 0) && $xth(me,cmds,$id,$npid,idp)} {
    set px [xth_me_real2canx $xth(me,cmds,$id,$npid,x)]
    set py [xth_me_real2cany $xth(me,cmds,$id,$npid,y)]
    set x [xth_me_real2canx $xth(me,cmds,$id,$npid,xp)]
    set y [xth_me_real2cany $xth(me,cmds,$id,$npid,yp)]
    $xth(me,can) coords $xth(me,canid,linept,nncp) [list \
      [expr $x - $xth(gui,me,line,cpsize)] \
      [expr $y - $xth(gui,me,line,cpsize)] \
      [expr $x + $xth(gui,me,line,cpsize)] \
      [expr $y + $xth(gui,me,line,cpsize)]]
    $xth(me,can) coords $xth(me,canid,linept,nncpl) $px $py $x $y
  }

  if {($ppid > 0) && $xth(me,cmds,$id,$ppid,idn)} {
    set px [xth_me_real2canx $xth(me,cmds,$id,$ppid,x)]
    set py [xth_me_real2cany $xth(me,cmds,$id,$ppid,y)]
    set x [xth_me_real2canx $xth(me,cmds,$id,$ppid,xn)]
    set y [xth_me_real2cany $xth(me,cmds,$id,$ppid,yn)]
    $xth(me,can) coords $xth(me,canid,linept,ppcp) [list \
      [expr $x - $xth(gui,me,line,cpsize)] \
      [expr $y - $xth(gui,me,line,cpsize)] \
      [expr $x + $xth(gui,me,line,cpsize)] \
      [expr $y + $xth(gui,me,line,cpsize)]]
    $xth(me,can) coords $xth(me,canid,linept,ppcpl) $px $py $x $y
  }

  xth_me_cmds_move_linept_size_xctrl $id $pid $xth(me,cmds,$id,$pid,rotation) \
    $xth(me,cmds,$id,$pid,rs) $xth(me,cmds,$id,$pid,ls)
  xth_me_cmds_move_line_xctrl $id
}


proc xth_me_cmds_move_linept_xctrl {id pid} {
  global xth
  set x [xth_me_real2canx $xth(me,cmds,$id,$pid,x)]
  set y [xth_me_real2cany $xth(me,cmds,$id,$pid,y)]
  $xth(me,can) coords $xth(me,canid,linept,selector) [list \
    [expr $x - 3 * $xth(gui,me,line,psize)] \
    [expr $y - 3 * $xth(gui,me,line,psize)] \
    [expr $x + 3 * $xth(gui,me,line,psize)] \
    [expr $y + 3 * $xth(gui,me,line,psize)]]
}


proc xth_me_cmds_move_line_xctrl {id} {
  global xth
  set pid [lindex $xth(me,cmds,$id,xplist) 0]
  set rot [xth_me_cmds_get_default_rotation $id $pid]
  if {$xth(me,cmds,$id,reverse)} {
    set rot [expr $rot + 180.0]
  }
  set x [xth_me_real2canx $xth(me,cmds,$id,$pid,x)]
  set y [xth_me_real2cany $xth(me,cmds,$id,$pid,y)]
  $xth(me,can) coords $xth(me,canid,line,tick) [list $x $y \
      [expr $x + sin($rot/180.0*3.14159265259) * $xth(gui,me,line,ticksize)] \
      [expr $y - cos($rot/180.0*3.14159265259) * $xth(gui,me,line,ticksize)]]
}


proc xth_me_cmds_show_line_xctrl {id} {
  global xth
  if {[llength $xth(me,cmds,$id,xplist)] < 3} {
    xth_me_cmds_hide_line_xctrl    
    return
  }
  xth_me_cmds_move_line_xctrl $id
  $xth(me,can) itemconfigure entirelinectrl -state normal
  $xth(me,can) raise entirelinectrl
  $xth(me,can) lower entirelinectrl point
}

proc xth_me_cmds_hide_line_xctrl {} {
  global xth
  $xth(me,can) itemconfigure entirelinectrl -state hidden
}

proc xth_me_cmds_show_linept_xctrl {id pid} {
  global xth
  set x [xth_me_real2canx $xth(me,cmds,$id,$pid,x)]
  set y [xth_me_real2cany $xth(me,cmds,$id,$pid,y)]
  set xl $xth(me,cmds,$id,xplist)
  $xth(me,can) raise linectrl
  $xth(me,can) lower linectrl point

  $xth(me,can) itemconfigure $xth(me,canid,linept,selector) -state normal
  xth_me_cmds_move_linept_xctrl $id $pid

  if {$xth(me,cmds,$id,$pid,idp)} {
    $xth(me,can) itemconfigure $xth(me,canid,linept,pcpl) -state normal
    $xth(me,can) itemconfigure $xth(me,canid,linept,pcp) -state normal
  } else {
    $xth(me,can) itemconfigure $xth(me,canid,linept,pcpl) -state hidden
    $xth(me,can) itemconfigure $xth(me,canid,linept,pcp) -state hidden
  }
  if {$xth(me,cmds,$id,$pid,idn)} {
    $xth(me,can) itemconfigure $xth(me,canid,linept,ncpl) -state normal
    $xth(me,can) itemconfigure $xth(me,canid,linept,ncp) -state normal
  } else {
    $xth(me,can) itemconfigure $xth(me,canid,linept,ncpl) -state hidden
    $xth(me,can) itemconfigure $xth(me,canid,linept,ncp) -state hidden
  }
  set ix [lsearch $xl $pid]
  set lix [expr [llength $xl] - 2]
  if {$ix > 0} {
    set ppid [lindex $xl [expr $ix - 1]]
  } elseif {$xth(me,cmds,$id,close) && ($lix > 0)} {
    set ppid [lindex $xl [expr $lix - 1]]
  } else {
    set ppid 0
  }
  if {$ix < $lix} {
    set npid [lindex $xl [expr $ix + 1]]
  } elseif {$xth(me,cmds,$id,close) && ($lix > 0)} {
    set npid [lindex $xl 1]
  } else {
    set npid 0
  }
  if {($npid > 0) && $xth(me,cmds,$id,$npid,idp)} {
    $xth(me,can) itemconfigure $xth(me,canid,linept,nncpl) -state normal
    $xth(me,can) itemconfigure $xth(me,canid,linept,nncp) -state normal
  } else {
    $xth(me,can) itemconfigure $xth(me,canid,linept,nncpl) -state hidden
    $xth(me,can) itemconfigure $xth(me,canid,linept,nncp) -state hidden
  }
  if {($ppid > 0) && $xth(me,cmds,$id,$ppid,idn)} {
    $xth(me,can) itemconfigure $xth(me,canid,linept,ppcpl) -state normal
    $xth(me,can) itemconfigure $xth(me,canid,linept,ppcp) -state normal
  } else {
    $xth(me,can) itemconfigure $xth(me,canid,linept,ppcpl) -state hidden
    $xth(me,can) itemconfigure $xth(me,canid,linept,ppcp) -state hidden
  }
  xth_me_cmds_move_lineptcp_xctrl $id $ppid $pid $npid
  $xth(me,can) raise pt$id.$pid
  $xth(me,can) bind $xth(me,canid,linept,pcp) <Enter> \
    "$xth(me,can) itemconfigure $xth(me,canid,linept,pcp) -fill yellow"
  $xth(me,can) bind $xth(me,canid,linept,pcp) <Leave> \
    "$xth(me,can) itemconfigure $xth(me,canid,linept,pcp) -fill red"
  $xth(me,can) bind $xth(me,canid,linept,pcp) <1> \
    "xth_me_cmds_start_linecp_drag $xth(me,canid,linept,pcp) $id $ppid $pid $npid p %x %y"
  $xth(me,can) bind $xth(me,canid,linept,ncp) <Enter> \
    "$xth(me,can) itemconfigure $xth(me,canid,linept,ncp) -fill yellow"
  $xth(me,can) bind $xth(me,canid,linept,ncp) <Leave> \
    "$xth(me,can) itemconfigure $xth(me,canid,linept,ncp) -fill red"
  $xth(me,can) bind $xth(me,canid,linept,ncp) <1> \
    "xth_me_cmds_start_linecp_drag $xth(me,canid,linept,ncp) $id $ppid $pid $npid n %x %y"
  $xth(me,can) bind $xth(me,canid,linept,ppcp) <Enter> \
    "$xth(me,can) itemconfigure $xth(me,canid,linept,ppcp) -fill yellow"
  $xth(me,can) bind $xth(me,canid,linept,ppcp) <Leave> \
    "$xth(me,can) itemconfigure $xth(me,canid,linept,ppcp) -fill magenta"
  $xth(me,can) bind $xth(me,canid,linept,ppcp) <1> \
    "xth_me_cmds_start_linecp_drag $xth(me,canid,linept,ppcp) $id $ppid $pid $npid pp %x %y"
  $xth(me,can) bind $xth(me,canid,linept,nncp) <Enter> \
    "$xth(me,can) itemconfigure $xth(me,canid,linept,nncp) -fill yellow"
  $xth(me,can) bind $xth(me,canid,linept,nncp) <Leave> \
    "$xth(me,can) itemconfigure $xth(me,canid,linept,nncp) -fill magenta"
  $xth(me,can) bind $xth(me,canid,linept,nncp) <1> \
    "xth_me_cmds_start_linecp_drag $xth(me,canid,linept,nncp) $id $ppid $pid $npid nn %x %y"
    
  xth_me_cmds_configure_linept_size_xctrl $id $pid
  xth_me_cmds_move_linept_size_xctrl $id $pid $xth(me,cmds,$id,$pid,rotation) \
    $xth(me,cmds,$id,$pid,rs) $xth(me,cmds,$id,$pid,ls)
  xth_me_cmds_move_line_xctrl $id
    
}


proc xth_me_cmds_hide_linept_xctrl {} {
  global xth
  $xth(me,can) itemconfigure linectrl -state hidden
  $xth(me,can) bind $xth(me,canid,linept,pcp) <Enter> ""
  $xth(me,can) bind $xth(me,canid,linept,pcp) <Leave> ""
  $xth(me,can) bind $xth(me,canid,linept,ncp) <Enter> ""
  $xth(me,can) bind $xth(me,canid,linept,ncp) <Leave> ""
  $xth(me,can) bind $xth(me,canid,linept,ppcp) <Enter> ""
  $xth(me,can) bind $xth(me,canid,linept,ppcp) <Leave> ""
  $xth(me,can) bind $xth(me,canid,linept,nncp) <Enter> ""
  $xth(me,can) bind $xth(me,canid,linept,nncp) <Leave> ""
  $xth(me,can) bind $xth(me,canid,linept,pcp) <1> ""
  $xth(me,can) bind $xth(me,canid,linept,ncp) <1> ""
  $xth(me,can) bind $xth(me,canid,linept,ppcp) <1> ""
  $xth(me,can) bind $xth(me,canid,linept,nncp) <1> ""
  xth_me_cmds_configure_linept_size_xctrl {} 0
}

proc xth_me_cmds_update_linept_ctrl {id pid} {

  global xth
  
  if {[string length $id] > 0} {
    xth_me_cmds_show_line_xctrl $id
  } else {
    xth_me_cmds_hide_line_xctrl
  }

  if {([string length $id] > 0) && ($pid > 0)} {

    $xth(ctrl,me,linept).posl configure -state normal
    $xth(ctrl,me,linept).posx configure -state normal
    $xth(ctrl,me,linept).posy configure -state normal
    $xth(ctrl,me,linept).xp configure -state normal
    $xth(ctrl,me,linept).yp configure -state normal
    $xth(ctrl,me,linept).xn configure -state normal
    $xth(ctrl,me,linept).yn configure -state normal
    $xth(ctrl,me,linept).cbp configure -state normal
    $xth(ctrl,me,linept).cbn configure -state normal
    $xth(ctrl,me,linept).cbs configure -state normal
    $xth(ctrl,me,linept).rotc configure -state normal
    $xth(ctrl,me,linept).rot configure -state normal
    $xth(ctrl,me,linept).rszc configure -state normal
    $xth(ctrl,me,linept).rsz configure -state normal
    $xth(ctrl,me,linept).lszc configure -state normal
    $xth(ctrl,me,linept).lsz configure -state normal
    $xth(ctrl,me,linept).optl configure -state normal
    $xth(ctrl,me,linept).upd configure -state normal

    $xth(ctrl,me,line).lpa.m entryconfigure "Delete point" -state normal    
    set xpid [lsearch -exact $xth(me,cmds,$id,xplist) $pid]
    if {($xpid > 0) && ($xpid < ([llength $xth(me,cmds,$id,xplist)] - 2))} {
      $xth(ctrl,me,line).lpa.m entryconfigure "Split line" -state normal
    } else {
      $xth(ctrl,me,line).lpa.m entryconfigure "Split line" -state disabled
    }

    $xth(ctrl,me,linept).oe.txt configure -state normal
    $xth(ctrl,me,linept).oe.txt delete 1.0 end
    $xth(ctrl,me,linept).oe.txt insert 1.0 $xth(me,cmds,$id,$pid,options)
    $xth(ctrl,me,linept).oe.txt mark set insert $xth(me,cmds,$id,$pid,optpos)
    $xth(ctrl,me,linept).oe.txt see $xth(me,cmds,$id,$pid,optpos)
    
    set xth(ctrl,me,linept,x) $xth(me,cmds,$id,$pid,x)
    set xth(ctrl,me,linept,y) $xth(me,cmds,$id,$pid,y)
    set xth(ctrl,me,linept,idn) $xth(me,cmds,$id,$pid,idn)
    set xth(ctrl,me,linept,idp) $xth(me,cmds,$id,$pid,idp)
    
    if $xth(me,cmds,$id,$pid,idp) {
      set xth(ctrl,me,linept,xp) $xth(me,cmds,$id,$pid,xp)
      set xth(ctrl,me,linept,yp) $xth(me,cmds,$id,$pid,yp)
    } else {
      set xth(ctrl,me,linept,xp) {}
      set xth(ctrl,me,linept,yp) {}
    }
    if $xth(me,cmds,$id,$pid,idn) {
      set xth(ctrl,me,linept,xn) $xth(me,cmds,$id,$pid,xn)
      set xth(ctrl,me,linept,yn) $xth(me,cmds,$id,$pid,yn)
    } else {
      set xth(ctrl,me,linept,xn) {}
      set xth(ctrl,me,linept,yn) {}
    }    
    set xth(ctrl,me,linept,smooth) $xth(me,cmds,$id,$pid,smooth)
    set xth(ctrl,me,linept,rot) $xth(me,cmds,$id,$pid,rotation)
    if {[string length $xth(me,cmds,$id,$pid,rotation)] > 0} {
      set xth(ctrl,me,linept,rotid) 1
    } else {
      set xth(ctrl,me,linept,rotid) 0
    }

    set xth(ctrl,me,linept,rs) $xth(me,cmds,$id,$pid,rs)
    if {[string length $xth(me,cmds,$id,$pid,rs)] > 0} {
      set xth(ctrl,me,linept,rsid) 1
    } else {
      set xth(ctrl,me,linept,rsid) 0
    }

    set xth(ctrl,me,linept,ls) $xth(me,cmds,$id,$pid,ls)
    if {[string length $xth(me,cmds,$id,$pid,ls)] > 0} {
      set xth(ctrl,me,linept,lsid) 1
    } else {
      set xth(ctrl,me,linept,lsid) 0
    }
    
    xth_me_cmds_show_linept_xctrl $id $pid
    
  } else {

    set xth(ctrl,me,linept,x) {}
    set xth(ctrl,me,linept,y) {}
    set xth(ctrl,me,linept,xp) {}
    set xth(ctrl,me,linept,yp) {}
    set xth(ctrl,me,linept,xn) {}
    set xth(ctrl,me,linept,yn) {}
    set xth(ctrl,me,linept,idn) 0
    set xth(ctrl,me,linept,idp) 0
    set xth(ctrl,me,linept,smooth) 0
    set xth(ctrl,me,linept,rot) {}
    set xth(ctrl,me,linept,rotid) 0
    set xth(ctrl,me,linept,rs) {}
    set xth(ctrl,me,linept,rsid) 0
    set xth(ctrl,me,linept,ls) {}
    set xth(ctrl,me,linept,lsid) 0

    $xth(ctrl,me,linept).posl configure -state disabled
    $xth(ctrl,me,linept).posx configure -state disabled
    $xth(ctrl,me,linept).posy configure -state disabled
    $xth(ctrl,me,linept).xp configure -state disabled
    $xth(ctrl,me,linept).upd configure -state disabled
    $xth(ctrl,me,linept).yp configure -state disabled
    $xth(ctrl,me,linept).xn configure -state disabled
    $xth(ctrl,me,linept).yn configure -state disabled
    $xth(ctrl,me,linept).cbp configure -state disabled
    $xth(ctrl,me,linept).cbn configure -state disabled
    $xth(ctrl,me,linept).cbs configure -state disabled
    $xth(ctrl,me,linept).rotc configure -state disabled
    $xth(ctrl,me,linept).rot configure -state disabled
    $xth(ctrl,me,linept).rszc configure -state disabled
    $xth(ctrl,me,linept).rsz configure -state disabled
    $xth(ctrl,me,linept).lszc configure -state disabled
    $xth(ctrl,me,linept).lsz configure -state disabled
    $xth(ctrl,me,linept).optl configure -state disabled
    $xth(ctrl,me,linept).oe.txt configure -state normal
    $xth(ctrl,me,linept).oe.txt delete 1.0 end
    $xth(ctrl,me,linept).oe.txt see 1.0
    $xth(ctrl,me,linept).oe.txt configure -state disabled

    $xth(ctrl,me,line).lpa.m entryconfigure "Delete point" -state disabled
    $xth(ctrl,me,line).lpa.m entryconfigure "Split line" -state disabled
    
    xth_me_cmds_hide_linept_xctrl  
    
  }
  
}


proc xth_me_cmds_delete_linept {id pid} {

  global xth
  
  if {[string length $id] < 1} {
    set id $xth(me,cmds,selid)
  }
  if {[string length $pid] < 1} {
    set pid $xth(me,cmds,selpid)
  }
  if {$pid == 0} {
    return
  }

  set oldselpid $xth(me,cmds,selpid)
  if {$xth(me,unredook)} {
    xth_me_cmds_update {}
  }
  
  # ak mazeme prvy alebo posledny, tak zrusime close ak je nastaveny
  set closerem 0
  if {$xth(me,cmds,$id,close) && ([llength $xth(me,cmds,$id,xplist)] > 2)} {
    set fpid [lindex $xth(me,cmds,$id,xplist) 0]
    set lpid [lindex $xth(me,cmds,$id,xplist) [expr [llength $xth(me,cmds,$id,xplist)] - 2]]
    if {$pid == $fpid} {
      set closerem 1
    } elseif {$pid == $lpid} {
      set closerem 1
    }
  }
  
  if {$closerem} {
    set closeremstr "set xth(me,cmds,$id,close) 0\nxth_me_cmds_update_line_vars $id $pid"
    set closeaddstr "set xth(me,cmds,$id,close) 1\nxth_me_cmds_update_line_vars $id $pid"
  } else {
    set closeremstr {}
    set closeaddstr {}
  }
  
  eval $closeremstr
  
  # odstrani ho zo zoznamu
  set ix [lsearch $xth(me,cmds,$id,xplist) $pid]
  set xth(me,cmds,$id,xplist) [lreplace $xth(me,cmds,$id,xplist) $ix $ix]
  set xth(me,cmds,$id,plist) [lreplace $xth(me,cmds,$id,plist) $ix $ix]
  $xth(me,can) delete pt$id.$pid
  $xth(me,can) delete ln$id.$pid
  xth_me_cmds_move_line $id
  if {$oldselpid == $pid} {
    set nwpid [lindex $xth(me,cmds,$id,xplist) $ix]
  } else {
    set nwpid $oldselpid
  }
  xth_me_cmds_update_line_data $id
  xth_me_prev_cmd $xth(me,cmds,$id,data)
  
  # BUG FIX when deleting last point
  if {$nwpid == 0} {
    set xth(me,cmds,selpid) $nwpid
  }
  xth_me_cmds_select_linept $id $nwpid
    
  xth_me_unredo_action "deleting line point" "xth_me_cmds_undelete_linept $id $pid $ix\n$closeaddstr" \
    "$closeremstr\nxth_me_cmds_delete_linept $id $pid"
  
}


proc xth_me_cmds_undelete_linept {id pid ix} {
  global xth
  set oldpid [lindex $xth(me,cmds,$id,xplist) $ix]
  set xth(me,cmds,$id,xplist) [linsert $xth(me,cmds,$id,xplist) $ix $pid]
  set xth(me,cmds,$id,plist) [linsert $xth(me,cmds,$id,plist) $ix {}]
  xth_me_cmds_update_linept_list $id $pid
  if {$ix > 0} {
    set ppid [lindex $xth(me,cmds,$id,xplist) [expr $ix - 1]]
  } else {
    set ppid 0
  }
  xth_me_cmds_draw_linept $id $pid
  xth_me_cmds_draw_lineln $id $ppid $pid 
  xth_me_cmds_move_line $id
  xth_me_cmds_update_line_data $id
  xth_me_prev_cmd $xth(me,cmds,$id,data)
  xth_me_cmds_select_linept $id $pid
  
}


proc xth_me_cmds_create_line_point {id ix mode x y xp yp xn yn smooth rot rs ls opts optpos} {

  global xth
  
  incr xth(me,cmds,$id,lpid)
  set pid $xth(me,cmds,$id,lpid)
  set xth(me,cmds,$id,$pid,x) [expr double($x)]
  set xth(me,cmds,$id,$pid,y) [expr double($y)]

  if {([string length $xp] > 0) && ((![string equal $xp $x]) || (![string equal $yp $y]))} {
    set xth(me,cmds,$id,$pid,xp) [expr double($xp)]
    set xth(me,cmds,$id,$pid,yp) [expr double($yp)]
    set xth(me,cmds,$id,$pid,idp) 1
  } else {
    set xth(me,cmds,$id,$pid,xp) {}
    set xth(me,cmds,$id,$pid,yp) {}
    set xth(me,cmds,$id,$pid,idp) 0
  }
  
  if {([string length $xn] > 0) && ((![string equal $xn $x]) || (![string equal $yn $y]))} {
    set xth(me,cmds,$id,$pid,xn) [expr double($xn)]
    set xth(me,cmds,$id,$pid,yn) [expr double($yn)]
    set xth(me,cmds,$id,$pid,idn) 1
  } else {
    set xth(me,cmds,$id,$pid,xn) {}
    set xth(me,cmds,$id,$pid,yn) {}
    set xth(me,cmds,$id,$pid,idn) 0
  }
  
  if {[string length $smooth] < 1} {
    set xth(me,cmds,$id,$pid,smooth) -1
  } else {
    set xth(me,cmds,$id,$pid,smooth) $smooth
  }
  
  if {[string length $rot] > 0} {
    set rot [expr double($rot)]
  }
  set xth(me,cmds,$id,$pid,rotation) $rot

  if {[string length $ls] > 0} {
    set ls [expr double($ls)]
  }
  set xth(me,cmds,$id,$pid,ls) $ls

  if {[string length $rs] > 0} {
    set rs [expr double($rs)]
  }
  set xth(me,cmds,$id,$pid,rs) $rs
  
  regsub {\s*$} $opts "" opts
  if {[string length $opts] > 0} {
    regsub {$} $opts "\n" opts
  }
  set xth(me,cmds,$id,$pid,options) $opts
  set xth(me,cmds,$id,$pid,optpos) $optpos
  
  # vlozi ho do zoznamu
  set xth(me,cmds,$id,plist) [linsert $xth(me,cmds,$id,plist) $ix {}]
  set xth(me,cmds,$id,xplist) [linsert $xth(me,cmds,$id,xplist) $ix $pid]
  xth_me_cmds_update_linept_list $id $pid
  
  # vytvori ho
  if {$ix > 0} {
    set ppid [lindex $xth(me,cmds,$id,xplist) [expr $ix - 1]]
  } else {
    set ppid 0
  }
  xth_me_cmds_draw_lineln $id $ppid $pid
  xth_me_cmds_draw_linept $id $pid
  
}



proc xth_me_cmds_create_area_line {id ix mode txt} {

  global xth
  incr xth(me,cmds,$id,llid)
  set lid $xth(me,cmds,$id,llid)
  regsub {\s*$} $txt "" txt
  regsub {^\s*} $txt "" txt
  set xth(me,cmds,$id,$lid,txt) $txt
  # vlozi ho do zoznamu
  set xth(me,cmds,$id,llist) [linsert $xth(me,cmds,$id,llist) $ix $txt]
  set xth(me,cmds,$id,xllist) [linsert $xth(me,cmds,$id,xllist) $ix $lid]
  
}


proc xth_me_cmds_insert_area_lineid {id mx my} {
  global xth
  if {$xth(me,unredook)} {
    xth_me_cmds_update {}
  }
  if {[string length $xth(me,cmds,$id,name)] == 0} {
    set nn [format "l%d-%.0f-%.0f" $id [xth_me_can2realx [$xth(me,can) canvasx $mx]] [xth_me_can2realy [$xth(me,can) canvasy $my]]]
    set unspec "set xth(me,cmds,$id,name) {}\nxth_me_cmds_update_line_data $id\nxth_me_cmds_update_list $id"
    set respec "set xth(me,cmds,$id,name) [list $nn]\nxth_me_cmds_update_line_data $id\nxth_me_cmds_update_list $id"
    eval $respec
  } else {
    set nn $xth(me,cmds,$id,name)
    set unspec {}
    set respec {}
  }    
  xth_me_cmds_insert_area_line $nn $unspec $respec
}


proc xth_me_cmds_insert_area_line {txt unspec respec} {

  global xth
  if {$xth(me,unredook)} {
    xth_me_cmds_update {}
  }
  regsub {\s*$} $txt "" txt
  regsub {^\s*} $txt "" txt  
  if {[string length $txt] == 0} {
    return;
  }
  set id $xth(me,cmds,selid)
  set lid [lindex $xth(me,cmds,$id,xllist) [$xth(ctrl,me,ac).ll.l curselection]]
  set ix [lsearch $xth(me,cmds,$id,xllist) $lid]
  xth_me_cmds_create_area_line $id $ix 1 $txt
  set lid $xth(me,cmds,$id,llid)
  xth_me_cmds_update_area_data $id
  xth_me_prev_cmd $xth(me,cmds,$id,data)
  $xth(ctrl,me,ac).ll.l selection clear 0 end
  $xth(ctrl,me,ac).ll.l selection set [expr $ix + 1] [expr $ix + 1]
  $xth(ctrl,me,ac).ll.l see [expr $ix + 1]

  xth_me_unredo_action "inserting area border" "xth_me_cmds_select $id\nxth_me_cmds_delete_area_line $id $lid\n$unspec" \
    "xth_me_cmds_select $id\n$respec\nxth_me_cmds_undelete_area_line 1 $id $lid $ix"
      
}


proc xth_me_cmds_delete_area_line {id lid} {

  global xth
  
  if {[string length $id] < 1} {
    set id $xth(me,cmds,selid)
  }
  if {[string length $lid] < 1} {
    set lid [lindex $xth(me,cmds,$id,xllist) [$xth(ctrl,me,ac).ll.l curselection]]
  }
  if {$lid == 0} {
    return
  }

  if {$xth(me,unredook)} {
    xth_me_cmds_update {}
  }
  
  # odstrani ho zo zoznamu
  set ix [lsearch $xth(me,cmds,$id,xllist) $lid]
  set xth(me,cmds,$id,xllist) [lreplace $xth(me,cmds,$id,xllist) $ix $ix]
  set xth(me,cmds,$id,llist) [lreplace $xth(me,cmds,$id,llist) $ix $ix]
  xth_me_cmds_update_area_data $id
  xth_me_prev_cmd $xth(me,cmds,$id,data)
  $xth(ctrl,me,ac).ll.l selection clear 0 end
  $xth(ctrl,me,ac).ll.l selection set $ix $ix
  $xth(ctrl,me,ac).ll.l see $ix
    
  xth_me_unredo_action "deleting area border" "xth_me_cmds_undelete_area_line 0 $id $lid $ix" \
    "xth_me_cmds_delete_area_line $id $lid"
  
}


proc xth_me_cmds_undelete_area_line {cr id lid ix} {

  global xth
  set xth(me,cmds,$id,xllist) [linsert $xth(me,cmds,$id,xllist) $ix $lid]
  set xth(me,cmds,$id,llist) [linsert $xth(me,cmds,$id,llist) $ix $xth(me,cmds,$id,$lid,txt)]
  xth_me_cmds_update_area_data $id
  xth_me_prev_cmd $xth(me,cmds,$id,data)
  $xth(ctrl,me,ac).ll.l selection clear 0 end
  $xth(ctrl,me,ac).ll.l selection set [expr $ix + $cr] [expr $ix + $cr]
  $xth(ctrl,me,ac).ll.l see [expr $ix + $cr]
  
}



proc xth_me_cmds_create_area {ix mode type opts lines} {

  global xth
  if {$mode} {
    xth_me_cmds_update {}
  }
  set id [xth_me_cmds_create 6 {} $ix]
  set xth(me,cmds,$id,llid) 0
  set xth(me,cmds,$id,llist) {"end of area"}
  set xth(me,cmds,$id,xllist) {0}

  if {$mode && ([string length $opts] < 1)} {
    set opts $xth(me,dflt,area,options)
  }

  if {[string length $type] > 0} {
    set xth(me,cmds,$id,type) $type
  } else {
    set xth(me,cmds,$id,type) $xth(me,dflt,area,type)
  }  

  foreach ln $lines {
    xth_me_cmds_create_area_line $id \
          [expr [llength $xth(me,cmds,$id,xllist)] - 1] $mode $ln
  }
  
  # nastavit options
  regsub {^\s*} $opts "" opts
  regsub {\s*$} $opts "" opts
  set xth(me,cmds,$id,options) $opts

  xth_me_cmds_update_list $id
  xth_me_cmds_update_area_data $id
  if {$mode} {
    xth_me_unredo_action "creating area" "xth_me_cmds_delete $id\nxth_me_cmds_set_mode 0" \
      "xth_me_cmds_undelete $id 0 [lsearch $xth(me,cmds,xlist) $id]\nxth_me_cmds_set_mode 3"  
    xth_me_cmds_select $id
    xth_me_cmds_start_area_insert 0
  }


}




proc xth_me_cmds_create_line {ix mode type opts lines} {

  global xth
  if {$mode} {
    xth_me_cmds_update {}
  }
  set id [xth_me_cmds_create 3 {} $ix]
  set xth(me,cmds,$id,lpid) 0
  set xth(me,cmds,$id,plist) {"end of line"}
  set xth(me,cmds,$id,xplist) {0}

  if {$mode && ([string length $opts] < 1)} {
    set opts $xth(me,dflt,line,options)
  }

  if {[string length $type] > 0} {
    set xth(me,cmds,$id,type) $type
  } else {
    set xth(me,cmds,$id,type) $xth(me,dflt,line,type)
  }
  
  # nastavit meno
  set optl [xth_me_cmds_get_line_option $opts id]
  if {[lindex $optl 2]} {
    set xth(me,cmds,$id,name) [lindex $optl 0]
    set opts [lindex $optl 1]
  }
  # prejde vsetky riadky a pohlada meno tam
  set newlines {}
  foreach ln $lines {
    set optl [xth_me_cmds_get_option $ln id]
    if {[lindex $optl 2]} {
      set xth(me,cmds,$id,name) [lindex $optl 0]
      set ln [lindex $optl 1]
      if {[string length $ln] > 0} {
        lappend newlines $ln
      }
    } else {
      lappend newlines $ln
    }
  }
  set lines $newlines
  
  # nastavit reversion
  set xth(me,cmds,$id,reverse) 0
  set optl [xth_me_cmds_get_line_option $opts reverse]
  if {[lindex $optl 2]} {
    #puts ">>$opts<< = >>$optl<<"
    set xth(me,cmds,$id,reverse) [xth_me_cmds_get_bool [lindex $optl 0]]
    set opts [lindex $optl 1]
    #puts "$xth(me,cmds,$id,reverse) >>$opts<<"
  }
  # prejde vsetky riadky a pohlada reverse tam
  set newlines {}
  foreach ln $lines {
    set optl [xth_me_cmds_get_option $ln reverse]
    if {[lindex $optl 2]} {
      set xth(me,cmds,$id,reverse) [xth_me_cmds_get_bool [lindex $optl 0]]
      set ln [lindex $optl 1]
      if {[string length $ln] > 0} {
        lappend newlines $ln
      }
    } else {
      lappend newlines $ln
    }
  }
  set lines $newlines
  
  # nastavit close
  set xth(me,cmds,$id,close) -1
  set optl [xth_me_cmds_get_line_option $opts close]
  if {[lindex $optl 2]} {
    set xth(me,cmds,$id,close) [xth_me_cmds_get_onoffauto [lindex $optl 0]]
    set opts [lindex $optl 1]
  }
  # prejde vsetky riadky a pohlada reverse tam
  set newlines {}
  foreach ln $lines {
    set optl [xth_me_cmds_get_option $ln close]
    if {[lindex $optl 2]} {
      set xth(me,cmds,$id,close) [xth_me_cmds_get_onoffauto [lindex $optl 0]]
      set ln [lindex $optl 1]
      if {[string length $ln] > 0} {
        lappend newlines $ln
      }
    } else {
      lappend newlines $ln
    }
  }
  set lines $newlines
  
  # nastavit options
  regsub {^\s*} $opts "" opts
  regsub {\s*$} $opts "" opts
  set xth(me,cmds,$id,options) $opts

  # vlozi body
  set has_some 0
  set opts {}
  set rsz {}
  set lsz {}
  set smth {}
  set rot {}
  foreach ln $lines {
    set what 0
    set cmt 0
    if {[regexp {^\s*\!?\s*(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s*(\#.*)?$} \
          $ln dum x1 y1 x2 y2 x y cmt] && (![catch {expr $x * $y * $x1 * $y1 * $x2 * $y2}])} {
      set what 2
    } elseif {[regexp {^\s*\!?\s*(\S+)\s+(\S+)\s*(\#.*)?$} $ln dum x y cmt] && (![catch {expr $x * $y}])} {
      set x1 {}
      set y1 {}
      set x2 {}
      set y2 {}
      set what 1
    } elseif {$has_some} {
      # skusi jednotlive options rotation size r-size l-size smooth
      set cmt $ln
      set optl [xth_me_cmds_get_option $ln orientation]
      if {[lindex $optl 2]} {
        set rot [lindex $optl 0]
        set cmt [lindex $optl 1]
      } else {      
        set optl [xth_me_cmds_get_option $ln orient]
        if {[lindex $optl 2]} {
          set rot [lindex $optl 0]
          set cmt [lindex $optl 1]
        } else {
          set optl [xth_me_cmds_get_option $ln smooth]
          if {[lindex $optl 2]} {
            set smth [xth_me_cmds_get_onoffauto [lindex $optl 0]]
            set cmt [lindex $optl 1]
          } else {
            set optl [xth_me_cmds_get_option $ln size]
            if {[lindex $optl 2]} {
              switch $xth(me,cmds,$id,type) {
                slope {
                  set lsz [expr [lindex $optl 0]]
                }
                default {
                  set rsz [expr [lindex $optl 0] / 2.0]
                  set lsz [expr [lindex $optl 0] / 2.0]
                }
              }
              set cmt [lindex $optl 1]
            } else {
              set optl [xth_me_cmds_get_option $ln r-size]
              if {[lindex $optl 2]} {
                set rsz [lindex $optl 0]
                set cmt [lindex $optl 1]
              } else {
                set optl [xth_me_cmds_get_option $ln l-size]
                if {[lindex $optl 2]} {
                  set lsz [lindex $optl 0]
                  set cmt [lindex $optl 1]
                }
              }
            }
          }
        }
      }
      regsub {^\s*} $cmt {} cmt
    } else {
      regsub {^\s*} $ln {} ln
      set cmt $ln
    }
    if {$what == 0} {
      if {[string length $cmt] > 0} {
        if {[string length $opts] > 0} {
          set opts "$opts\n$cmt"
        } else {
          set opts "$cmt"
        }
      }
    } else {
      if {$has_some} {
        xth_me_cmds_create_line_point $id \
          [expr [llength $xth(me,cmds,$id,xplist)] - 1] $mode \
          $px $py $px2 $py2 $x1 $y1 $smth $rot $rsz $lsz $opts 1.0
        set opts {}
        set rsz {}
        set lsz {}
        set smth {}
        set rot {}
      }
      set has_some 1
      set px $x
      set py $y
      set px1 $x1
      set py1 $y1
      set px2 $x2
      set py2 $y2
    }
  }
  if {$has_some} {
    xth_me_cmds_create_line_point $id \
      [expr [llength $xth(me,cmds,$id,xplist)] - 1] $mode \
      $px $py $px2 $py2 {} {} $smth $rot $rsz $lsz $opts 1.0
  }

  if {$mode} {
    set xth(me,cmds,$id,close) 0
  } else {
    xth_me_cmds_postprocess_line $id
  }
  xth_me_cmds_update_list $id
  xth_me_cmds_update_line_data $id
  if {$mode} {
    xth_me_unredo_action "creating line" "xth_me_cmds_delete $id\nxth_me_cmds_set_mode 0" \
      "xth_me_cmds_undelete $id 0 [lsearch $xth(me,cmds,xlist) $id]\nxth_me_cmds_set_mode 2"  
    xth_me_cmds_select $id
    xth_me_cmds_start_linept_insert
  }
}


proc xth_me_cmds_postprocess_line {id} {
  global xth
  set xl $xth(me,cmds,$id,xplist)
  set lix [expr [llength $xl] - 2]
  if {$lix < 0} {
    return
  }

  # overi uzavretie
  if {$xth(me,cmds,$id,close) != 0} {
      if {($xth(me,cmds,$id,[lindex $xl 0],x) == $xth(me,cmds,$id,[lindex $xl $lix],x)) && \
        ($xth(me,cmds,$id,[lindex $xl 0],y) == $xth(me,cmds,$id,[lindex $xl $lix],y)) && \
        ($lix > 0)} {
        set xth(me,cmds,$id,close) 1
      } else {
        set xth(me,cmds,$id,close) 0
      }
  }
  
  if {$xth(me,cmds,$id,close)} {
    set fid [lindex $xl 0]
    set lid [lindex $xl $lix]
    if {$xth(me,cmds,$id,$fid,idn)} {
      set xth(me,cmds,$id,$lid,idn) $xth(me,cmds,$id,$fid,idn)
      set xth(me,cmds,$id,$lid,xn) $xth(me,cmds,$id,$fid,xn)
      set xth(me,cmds,$id,$lid,yn) $xth(me,cmds,$id,$fid,yn)
    }
    if {$xth(me,cmds,$id,$lid,idp)} {
      set xth(me,cmds,$id,$fid,idp) $xth(me,cmds,$id,$lid,idp)
      set xth(me,cmds,$id,$fid,xp) $xth(me,cmds,$id,$lid,xp)
      set xth(me,cmds,$id,$fid,yp) $xth(me,cmds,$id,$lid,yp)
    }
  }

  # overi smoothness
  if {$lix == 0} {
    set pid [lindex $xth(me,cmds,$id,xplist) 0]
    if {($xth(me,cmds,$id,$pid,smooth) == -1) && \
        $xth(me,cmds,$id,$pid,idp) && \
        $xth(me,cmds,$id,$pid,idn)} {
      set xth(me,cmds,$id,$pid,smooth) [xth_me_cmds_are_smooth \
        $xth(me,cmds,$id,$pid,xp) $xth(me,cmds,$id,$pid,yp) \
        $xth(me,cmds,$id,$pid,x) $xth(me,cmds,$id,$pid,y) \
        $xth(me,cmds,$id,$pid,xn) $xth(me,cmds,$id,$pid,yn)]
    } elseif {$xth(me,cmds,$id,$pid,smooth) == -1} {
      set xth(me,cmds,$id,$pid,smooth) 0
    }
    return
  }
  
  # prejde vsetky body
  set lid [lindex $xl $lix]
  set fid [lindex $xl 0]
  set cls $xth(me,cmds,$id,close)
  for {set ix 0} {$ix <= $lix} {incr ix} {
    set pid [lindex $xl $ix]
    if {($ix == 0) && $cls} {
      set idp $xth(me,cmds,$id,$lid,idp)
    } else {
      set idp $xth(me,cmds,$id,$pid,idp)
    }
    if {($ix == $lix) && $cls} {
      set idn $xth(me,cmds,$id,$fid,idn)
    } else {
      set idn $xth(me,cmds,$id,$pid,idn)
    }
    if {$idn && $idp && ($xth(me,cmds,$id,$pid,smooth) == -1)} {
      set x $xth(me,cmds,$id,$pid,x)
      set y $xth(me,cmds,$id,$pid,y)
      if {($ix == 0) && $cls} {
        set xp $xth(me,cmds,$id,$lid,xp)
        set yp $xth(me,cmds,$id,$lid,yp)
      } else {
        set xp $xth(me,cmds,$id,$pid,xp)
        set yp $xth(me,cmds,$id,$pid,yp)
      }
      if {($ix == $lix) && $cls} {
        set xn $xth(me,cmds,$id,$fid,xn)
        set yn $xth(me,cmds,$id,$fid,yn)
      } else {
        set xn $xth(me,cmds,$id,$pid,xn)
        set yn $xth(me,cmds,$id,$pid,yn)
      }
      set xth(me,cmds,$id,$pid,smooth) [xth_me_cmds_are_smooth $xp $yp $x $y $xn $yn]
    } elseif {$xth(me,cmds,$id,$pid,smooth) == -1} {
      set xth(me,cmds,$id,$pid,smooth) 0
    }
  }
  
}


proc xth_me_cmds_update_area_data {id} {

  global xth
  set xl $xth(me,cmds,$id,xllist)
  set lix [expr [llength $xl] - 2]

  set d "area $xth(me,cmds,$id,type)"
  set xth(me,dflt,area,type) $xth(me,cmds,$id,type)

  # options
  if {[string length $xth(me,cmds,$id,options)] > 0} {
    set d "$d $xth(me,cmds,$id,options)"
  }
  set xth(me,dflt,area,options) $xth(me,cmds,$id,options)

  for {set ix 0} {$ix <= $lix} {incr ix} {
    set lid [lindex $xl $ix]
    set d "$d\n  $xth(me,cmds,$id,$lid,txt)"
  }

  set xth(me,cmds,$id,data) "$d\nendarea"
  
}



proc xth_me_cmds_update_line_data {id} {
  global xth
  set xl $xth(me,cmds,$id,xplist)
  set lix [expr [llength $xl] - 2]

  set d "line $xth(me,cmds,$id,type)"
  set xth(me,dflt,line,type) $xth(me,cmds,$id,type)

  # id
  if {[string length $xth(me,cmds,$id,name)] > 0} {
    set d "$d -id $xth(me,cmds,$id,name)"
  }
  
  if {$lix > -1} {
  
    # close
    if {$xth(me,cmds,$id,close)} {
      set d "$d -close on"
    } elseif {($xth(me,cmds,$id,[lindex $xl 0],x) == $xth(me,cmds,$id,[lindex $xl $lix],x)) && \
        ($xth(me,cmds,$id,[lindex $xl 0],y) == $xth(me,cmds,$id,[lindex $xl $lix],y))} {
      set d "$d -close off"
    }

    # reverse
    if {$xth(me,cmds,$id,reverse)} {
      set d "$d -reverse on"
    }
    
  }
  
  if {[string length $xth(me,cmds,$id,options)] > 0} {
    set d "$d $xth(me,cmds,$id,options)"
  }
  set xth(me,dflt,line,options) $xth(me,cmds,$id,options)
  
  set xth(me,cmds,$id,data_ln) "$d\nendline"
  set xth(me,cmds,$id,data_pt) {}
  
  for {set ix 0} {$ix <= $lix} {incr ix} {
    set cto 0
    set pid [lindex $xl $ix]
    if {$ix == 0} {
      set crd [format "  %s %s" $xth(me,cmds,$id,$pid,x) $xth(me,cmds,$id,$pid,y)]
    } else {
      if {$xth(me,cmds,$id,$pid,idp) || $xth(me,cmds,$id,$ppid,idn)} {
        if {$xth(me,cmds,$id,$ppid,idn)} {
          set x1 $xth(me,cmds,$id,$ppid,xn)
          set y1 $xth(me,cmds,$id,$ppid,yn)
        } else {
          set x1 $xth(me,cmds,$id,$ppid,x)
          set y1 $xth(me,cmds,$id,$ppid,y)
        }
        if {$xth(me,cmds,$id,$pid,idp)} {
          set x2 $xth(me,cmds,$id,$pid,xp)
          set y2 $xth(me,cmds,$id,$pid,yp)
        } else {
          set x2 $xth(me,cmds,$id,$pid,x)
          set y2 $xth(me,cmds,$id,$pid,y)
        }
        set crd [format "  %s %s %s %s" $x1 $y1 $x2 $y2]
        set cto 1
      } else {
        set crd " "
      }
      set crd "$crd [format "%s %s" $xth(me,cmds,$id,$pid,x) $xth(me,cmds,$id,$pid,y)]"
    }
    set ptd "$crd"
    # rotation lsize rsize smooth options
    if {[string length $xth(me,cmds,$id,$pid,rotation)] > 0} {
      set ptd "$ptd\n  orientation $xth(me,cmds,$id,$pid,rotation)"
    }

    if {$cto && (! $xth(me,cmds,$id,$pid,smooth))} {
      set ptd "$ptd\n  smooth off"
    }
    
    if {[string length $xth(me,cmds,$id,$pid,ls)] > 0} {
      set ptd "$ptd\n  l-size $xth(me,cmds,$id,$pid,ls)"
    }

    if {[string length $xth(me,cmds,$id,$pid,rs)] > 0} {
      set ptd "$ptd\n  r-size $xth(me,cmds,$id,$pid,rs)"
    }
    
    if {[string length $xth(me,cmds,$id,$pid,options)] > 0} {
      set popts $xth(me,cmds,$id,$pid,options)
      regsub {\s*$} $popts {} popts
      if {[string length $popts] > 0} {
        regsub -all -line {^\s*} $popts {  } popts
      }
      set ptd "$ptd\n$popts"
    }
    
    lappend xth(me,cmds,$id,data_pt) $ptd
    
    set d "$d\n$ptd"
    set ppid $pid
  }
  set xth(me,cmds,$id,data) "$d\nendline"
  
}

proc xth_me_cmds_are_smooth {xp yp x y xn yn} {
  set rv 1
  set d1 [expr hypot($x - $xp,$y - $yp)]
  set d2 [expr hypot($xn - $x,$yn - $y)]
  if {($d2 > 0) && ($d1 > 0)} {
    set a1 [expr atan2($y - $yp, $x - $xp) / 3.14159265359 * 180.0];                        
    set a2 [expr atan2($yn - $y, $xn - $x) / 3.14159265359 * 180.0];
    if {($a2 - $a1) > 180.0} {
      set a2 [expr $a2 - 360.0]
    }
    if {($a2 - $a1) < -180.0} {
      set a2 [expr $a2 + 360.0]
    }
    if {($a2 > ($a1 + 5.0)) || ($a2 < ($a1 - 5.0))} {
      set rv 0
    }
  }        
  return $rv
}


proc xth_me_cmds_select_linept {id pid} {
  global xth
  if {$xth(me,unredook)} {
    xth_me_cmds_update {}
  }
  xth_me_cmds_update_linept_ctrl $id $pid
  set ix [lsearch $xth(me,cmds,$id,xplist) $pid]
  $xth(ctrl,me,line).pl.l selection clear 0 end
  $xth(ctrl,me,line).pl.l selection set $ix $ix
  $xth(ctrl,me,line).pl.l see $ix
  set xth(me,cmds,selpid) $pid
}


proc xth_me_cmds_toggle_line_close {} {
  global xth
  set id $xth(me,cmds,selid)
  set ncls $xth(ctrl,me,line,close)
  set xth(ctrl,me,line,close_tmp) $xth(ctrl,me,line,close)
  set xth(ctrl,me,line,close) $xth(me,cmds,$id,close)
  $xth(ctrl,me,line).cls configure -variable xth(ctrl,me,line,close_tmp)
  xth_me_cmds_update {}
  set xth(ctrl,me,line,close) $ncls
  if {$ncls && (!$xth(me,cmds,$id,close))} {
    xth_me_cmds_close_line $id
  } elseif {(!$ncls) && $xth(me,cmds,$id,close)} {
    xth_me_cmds_open_line $id
  }
  $xth(ctrl,me,line).cls configure -variable xth(ctrl,me,line,close)

}


proc xth_me_cmds_toggle_line_reverse {} {
  global xth
  set id $xth(me,cmds,selid)
  set nrev $xth(ctrl,me,line,reverse)
  set xth(ctrl,me,line,reverse_tmp) $xth(ctrl,me,line,reverse)
  set xth(ctrl,me,line,reverse) $xth(me,cmds,$id,reverse)
  $xth(ctrl,me,line).rev configure -variable xth(ctrl,me,line,reverse_tmp)
  xth_me_cmds_update {}
  set xth(ctrl,me,line,reverse) $nrev
  set xth(me,unredola) "line reversion"
  xth_me_cmds_update {}
  if {[llength $xth(me,cmds,$id,xplist)] > 1} {
    xth_me_cmds_move_lineln $id [lindex $xth(me,cmds,$id,xplist) 0] [lindex $xth(me,cmds,$id,xplist) 1]
  }
  $xth(ctrl,me,line).rev configure -variable xth(ctrl,me,line,reverse)
}


proc xth_me_cmds_toggle_linept {} {

  global xth

  set nidp $xth(ctrl,me,linept,idp)
  set xth(ctrl,me,linept,idp_tmp) $nidp
  set nidn $xth(ctrl,me,linept,idn)
  set xth(ctrl,me,linept,idn_tmp) $nidn
  set nsmooth $xth(ctrl,me,linept,smooth)
  set xth(ctrl,me,linept,smooth_tmp) $nsmooth
  set nrotid $xth(ctrl,me,linept,rotid)
  set xth(ctrl,me,linept,rotid_tmp) $nrotid
  set nrsid $xth(ctrl,me,linept,rsid)
  set xth(ctrl,me,linept,rsid_tmp) $nrsid
  set nlsid $xth(ctrl,me,linept,lsid)
  set xth(ctrl,me,linept,lsid_tmp) $nlsid

  set lpc $xth(ctrl,me,linept)
  $lpc.cbp configure -variable xth(ctrl,me,linept,idp_tmp)
  $lpc.cbn configure -variable xth(ctrl,me,linept,idn_tmp)
  $lpc.cbs configure -variable xth(ctrl,me,linept,smooth_tmp)
  $lpc.rotc configure -variable xth(ctrl,me,linept,rotid_tmp)
  $lpc.rszc configure -variable xth(ctrl,me,linept,rsid_tmp)
  $lpc.lszc configure -variable xth(ctrl,me,linept,lsid_tmp)

  update idletasks
  xth_me_cmds_update {}
  
  set id $xth(me,cmds,selid)
  set pid $xth(me,cmds,selpid)

  if {(!$nidp) && $xth(me,cmds,$id,$pid,idp)} {
    set xth(ctrl,me,linept,xp) {}
    set xth(ctrl,me,linept,yp) {}
    set xth(ctrl,me,linept,smooth) 0
  } elseif {$nidp && (!$xth(me,cmds,$id,$pid,idp))} {
    set crds [xth_me_cmds_get_default_linept_cp 1 $id $pid]
    set xth(ctrl,me,linept,xp) [lindex $crds 0]
    set xth(ctrl,me,linept,yp) [lindex $crds 1]
  }

  if {(!$nidn) && $xth(me,cmds,$id,$pid,idn)} {
    set xth(ctrl,me,linept,xn) {}
    set xth(ctrl,me,linept,yn) {}
    set xth(ctrl,me,linept,smooth) 0
  } elseif {$nidn && (!$xth(me,cmds,$id,$pid,idn))} {
    set crds [xth_me_cmds_get_default_linept_cp 0 $id $pid]
    set xth(ctrl,me,linept,xn) [lindex $crds 0]
    set xth(ctrl,me,linept,yn) [lindex $crds 1]
  }

  if {$nsmooth != $xth(me,cmds,$id,$pid,smooth)} {
    if {$nsmooth} {
      if {!$xth(me,cmds,$id,$pid,idp)} {
        set crds [xth_me_cmds_get_default_linept_cp 1 $id $pid]
        set xth(ctrl,me,linept,xp) [lindex $crds 0]
        set xth(ctrl,me,linept,yp) [lindex $crds 1]
      }
      if {!$xth(me,cmds,$id,$pid,idn)} {
        set crds [xth_me_cmds_get_default_linept_cp 0 $id $pid]
        set xth(ctrl,me,linept,xn) [lindex $crds 0]
        set xth(ctrl,me,linept,yn) [lindex $crds 1]
      }
    }
    set xth(ctrl,me,linept,smooth) $nsmooth
  }
  
  if {(!$nrotid) && ([string length $xth(me,cmds,$id,$pid,rotation)] > 0)} {
    set xth(ctrl,me,linept,rot) {}
  } elseif {$nrotid && ([string length $xth(me,cmds,$id,$pid,rotation)] < 1)} {
    set xth(ctrl,me,linept,rot) [xth_me_cmds_get_default_rotation $id $pid]
  }
  
  if {(!$nrsid) && ([string length $xth(me,cmds,$id,$pid,rs)] > 0)} {
    set xth(ctrl,me,linept,rs) {}
  } elseif {$nrsid && ([string length $xth(me,cmds,$id,$pid,rs)] < 1)} {
    set xth(ctrl,me,linept,rs) 40.0
  }
  
  if {(!$nlsid) && ([string length $xth(me,cmds,$id,$pid,ls)] > 0)} {
    set xth(ctrl,me,linept,ls) {}
  } elseif {$nlsid && ([string length $xth(me,cmds,$id,$pid,ls)] < 1)} {
    set xth(ctrl,me,linept,ls) 40.0
  }
  
  xth_me_cmds_update {}

  $lpc.cbp configure -variable xth(ctrl,me,linept,idp)
  $lpc.cbn configure -variable xth(ctrl,me,linept,idn)
  $lpc.cbs configure -variable xth(ctrl,me,linept,smooth)
  $lpc.rotc configure -variable xth(ctrl,me,linept,rotid)
  $lpc.rszc configure -variable xth(ctrl,me,linept,rsid)
  $lpc.lszc configure -variable xth(ctrl,me,linept,lsid)
  update idletasks
}

proc xth_me_cmds_update_line {id pid ntype nname nopts nrev nx ny nxp nyp \
  nxn nyn nsmth nrot nrs nls nptopts nptoptpos} {

  global xth
  
  set otype $xth(me,cmds,$id,type)
  set oname $xth(me,cmds,$id,name)
  set oopts $xth(me,cmds,$id,options)
  set orev $xth(me,cmds,$id,reverse)
  set oline "$otype $oname $oopts $orev"
  
  if {$pid > 0} {
    set ox $xth(me,cmds,$id,$pid,x)
    set oy $xth(me,cmds,$id,$pid,y)
    set oxp $xth(me,cmds,$id,$pid,xp)
    set oyp $xth(me,cmds,$id,$pid,yp)
    set oxn $xth(me,cmds,$id,$pid,xn)
    set oyn $xth(me,cmds,$id,$pid,yn)
    set osmth $xth(me,cmds,$id,$pid,smooth)
    set orot $xth(me,cmds,$id,$pid,rotation)
    set ors $xth(me,cmds,$id,$pid,rs)
    set ols $xth(me,cmds,$id,$pid,ls)
    set optopts $xth(me,cmds,$id,$pid,options)
    set optoptpos $xth(me,cmds,$id,$pid,optpos)
    set olinept "$ox $oy $oxp $oyp $oxn $oyn $osmth $orot $ors $ols $optopts"
  } else {
    set ox {}
    set oy {}
    set oxp {}
    set oyp {}
    set oxn {}
    set oyn {}
    set osmth {}
    set orot {}
    set ors {}
    set ols {}
    set optopts {}
    set optoptpos {}
    set olinept ""
  }


  if {[string length $ntype] < 1} {
    set ntype $otype
  }

  set optsredo {}
  set optsundo {}

  if {(![string equal $ntype $otype]) && [string equal $nopts $oopts]} {
    set nopts {}
    set nrs {}
    set nls {}
    set nrot {} 
    foreach xpid $xth(me,cmds,$id,xplist) {
      if {$xpid > 0} {
        foreach item {rs ls rotation} {
          if {[string length $xth(me,cmds,$id,$xpid,$item)] > 0} {
            set optsredo "$optsredo set xth(me,cmds,$id,$xpid,$item) {}; "
            set optsundo "$optsundo set xth(me,cmds,$id,$xpid,$item) [list $xth(me,cmds,$id,$xpid,$item)]; "
          }
        }
      }
    }
  }

  # uprav options
  regsub {^\s*} $nopts "" nopts
  regsub {\s*$} $nopts "" nopts
  
  set nline "$ntype $nname $nopts $nrev"
  
  if {$pid > 0} {
    
    if {[catch {expr $nx}]} {
      set nx $ox
    }
    set nx [expr double($nx)]
    if {[catch {expr $ny}]} {
      set ny $oy
    }
    set ny [expr double($ny)]

    if {[string length $nxp] > 0} {
      if {[catch {expr $nxp}]} {
        set nxp $oxp
      }
      set nxp [expr double($nxp)]
    }
    if {[string length $nyp] > 0} {
      if {[catch {expr $nyp}]} {
        set nyp $oyp
      }
      set nyp [expr double($nyp)]
    }    
    if {([string length $nxp] < 1) || ([string length $nyp] < 1)} {
      set nxp {}
      set nyp {}
      set nsmth 0
    }
    
    if {[string length $nxn] > 0} {
      if {[catch {expr $nxn}]} {
        set nxn $oxn
      }
      set nxn [expr double($nxn)]
    }
    if {[string length $nyn] > 0} {
      if {[catch {expr $nyn}]} {
        set nyn $oyn
      }
      set nyn [expr double($nyn)]
    }    
    if {([string length $nxn] < 1) || ([string length $nyn] < 1)} {
      set nxn {}
      set nyn {}
      set nsmth 0
    }
    
    if {$nsmth} {
      set crds [xth_me_cmds_get_smoothed_cp 0 $nxp $nyp $nx $ny $nxn $nyn]
      set nxp [lindex $crds 0]
      set nyp [lindex $crds 1]
      set nxn [lindex $crds 2]
      set nyn [lindex $crds 3]
    }
    
    if {[string length $nrot] > 0} {
      if {[catch {expr $nrot}]} {
        set nrot $orot
      } elseif {($nrot < 0.0) || ($nrot >= 360.0)} {
        set nrot $orot
      } else {
        set nrot [expr double($nrot)]
      }
    }

    if {[string length $nrs] > 0} {
      if {[catch {expr $nrs}]} {
        set nrs $ors
      } elseif {$nrs <= 0.0} {
        set nrs $ors
      } else {
        set nrs [expr double($nrs)]
      }
    }

    if {[string length $nls] > 0} {
      if {[catch {expr $nls}]} {
        set nls $ols
      } elseif {$nls <= 0.0} {
        set nls $ols
      } else {
        set nls [expr double($nls)]
      }
    }
    
    # uprav options
    regsub {\s*$} $nptopts "" nptopts
    if {[string length $nptopts] > 0} {
      regsub {$} $nptopts "\n" nptopts
    }

    set nlinept "$nx $ny $nxp $nyp $nxn $nyn $nsmth $nrot $nrs $nls $nptopts"
  } else {
    set nlinept ""
  }

  # ak je v niecom rozdiel, tak to updatni
  if {![string equal "$nline $nlinept" "$oline $olinept"]} {
    #puts "new\n{$nline}\n===\n{$nlinept}\n===\nold\n{$oline}\n===\n{$olinept}\n===\n"
    xth_me_unredo_action "line changes" \
      "xth_me_cmds_update_line $id $pid $otype [list $oname] [list $oopts] $orev {$ox} {$oy} {$oxp} {$oyp} {$oxn} {$oyn} {$osmth} {$orot} {$ors} {$ols} [list $optopts] {$optoptpos}; $optsundo xth_me_cmds_select {$id $pid}" \
      "xth_me_cmds_update_line $id $pid $ntype [list $nname] [list $nopts] $nrev {$nx} {$ny} {$nxp} {$nyp} {$nxn} {$nyn} {$nsmth} {$nrot} {$nrs} {$nls} [list $nptopts] {$nptoptpos}; $optsredo xth_me_cmds_select {$id $pid}"    

    set xth(me,cmds,$id,type) $ntype
    set xth(me,cmds,$id,name) $nname 
    set xth(me,cmds,$id,options) $nopts 
    set xth(me,cmds,$id,reverse) $nrev 
  
    if {[string length $optsredo] > 0} {
      eval $optsredo
    }
  
    if {$pid > 0} {
      set xth(me,cmds,$id,$pid,x) $nx
      set xth(me,cmds,$id,$pid,y) $ny
      set xth(me,cmds,$id,$pid,xp) $nxp
      set xth(me,cmds,$id,$pid,yp) $nyp
      if {[string length "$nxp$nyp"] > 0} {
        set xth(me,cmds,$id,$pid,idp) 1
      } else {
        set xth(me,cmds,$id,$pid,idp) 0
      }
      set xth(me,cmds,$id,$pid,xn) $nxn
      set xth(me,cmds,$id,$pid,yn) $nyn
      if {[string length "$nxn$nyn"] > 0} {
        set xth(me,cmds,$id,$pid,idn) 1
      } else {
        set xth(me,cmds,$id,$pid,idn) 0
      }
      set xth(me,cmds,$id,$pid,smooth) $nsmth 
      set xth(me,cmds,$id,$pid,rotation) $nrot
      set xth(me,cmds,$id,$pid,rs) $nrs
      set xth(me,cmds,$id,$pid,ls) $nls
      set xth(me,cmds,$id,$pid,options) $nptopts 
      set xth(me,cmds,$id,$pid,optpos) $nptoptpos 
      xth_me_cmds_update_linept_list $id $pid
      set cpid 0
      if {$xth(me,cmds,$id,close)} {
        set fpid [lindex $xth(me,cmds,$id,xplist) 0]
        set lpid [lindex $xth(me,cmds,$id,xplist) [expr [llength $xth(me,cmds,$id,xplist)] - 2]]
        if {$pid == $fpid} {
          set cpid $lpid
        } elseif {$pid == $lpid} {
          set cpid $fpid
        }
      }
      if {$cpid > 0} {
        set xth(me,cmds,$id,$cpid,x) $nx
        set xth(me,cmds,$id,$cpid,y) $ny
        xth_me_cmds_move_linept $id $cpid
        set xth(me,cmds,$id,$cpid,xp) $nxp
        set xth(me,cmds,$id,$cpid,yp) $nyp
        set xth(me,cmds,$id,$cpid,idp) $xth(me,cmds,$id,$pid,idp)
        set xth(me,cmds,$id,$cpid,xn) $nxn
        set xth(me,cmds,$id,$cpid,yn) $nyn
        set xth(me,cmds,$id,$cpid,idn) $xth(me,cmds,$id,$pid,idn)
        set xth(me,cmds,$id,$cpid,smooth) $nsmth 
        set ix [lsearch $xth(me,cmds,$id,xplist) $cpid]
        xth_me_cmds_update_linept_list $id $cpid
      }
      xth_me_cmds_move_linelnpt $id $pid
    }  
    xth_me_cmds_update_line_data $id
    xth_me_cmds_update_list $id    
  }
  
}


proc xth_me_cmds_update_line_vars {id pid} {

  global xth
  set xth(ctrl,me,line,type) $xth(me,cmds,$id,type)
  set xth(ctrl,me,line,name) $xth(me,cmds,$id,name)
  set xth(ctrl,me,line,opts) $xth(me,cmds,$id,options)
  set xth(ctrl,me,line,reverse) $xth(me,cmds,$id,reverse)
  set xth(ctrl,me,line,close) $xth(me,cmds,$id,close)
  xth_me_cmds_update_linept_ctrl $id $pid
    
}

proc xth_me_cmds_update_area_vars {id} {

  global xth
  set xth(ctrl,me,ac,type) $xth(me,cmds,$id,type)
  set xth(ctrl,me,ac,opts) $xth(me,cmds,$id,options)
    
}





proc xth_me_cmds_get_default_linept_cp {prv id pid} {
  global xth

  set x $xth(me,cmds,$id,$pid,x)
  set y $xth(me,cmds,$id,$pid,y)
  
  if {$prv} {
    if {$xth(me,cmds,$id,$pid,idn)} {
      set dx [expr $x - $xth(me,cmds,$id,$pid,xn)]
      set dy [expr $y - $xth(me,cmds,$id,$pid,yn)]
    } else {
      set dx 0.0
      set dy 0.0
    }
  } else {
    if {$xth(me,cmds,$id,$pid,idp)} {
      set dx [expr $x - $xth(me,cmds,$id,$pid,xp)]
      set dy [expr $y - $xth(me,cmds,$id,$pid,yp)]
    } else {
      set dx 0.0
      set dy 0.0
    }
  }
  set dd [expr hypot($dy, $dx)]
  set rd $dd

  if {$dd == 0.0} {

    set ppix [expr [lsearch $xth(me,cmds,$id,xplist) $pid] - 1]
    if {$ppix >= 0} {  
      set ppid [lindex $xth(me,cmds,$id,xplist) $ppix]
      set xp $xth(me,cmds,$id,$ppid,x)
      set yp $xth(me,cmds,$id,$ppid,y)
    } else {
      set xp $x
      set yp $y
    }
  
    set npix [expr [lsearch $xth(me,cmds,$id,xplist) $pid] + 1]
    set npid [lindex $xth(me,cmds,$id,xplist) $npix]
    if {$npid > 0} {
      set xn $xth(me,cmds,$id,$npid,x)
      set yn $xth(me,cmds,$id,$npid,y)
    } else {
      set xn $x
      set yn $y
    }

    if {$prv} {
      set dx [expr $xp - $xn]
      set dy [expr $yp - $yn]
    } else {
      set dx [expr $xn - $xp]
      set dy [expr $yn - $yp]
    }
    set dd [expr hypot($dy, $dx)]
 
  }
  
  if {$dd == 0.0} {
    set dx 0.0
    set dy 1.0
    set dd 1.0
    set rd 40.0
  }
  
  if {$rd == 0.0} {
    if {$prv} {
      set ppix [expr [lsearch $xth(me,cmds,$id,xplist) $pid] - 1]
      if {$ppix >= 0} {
        set ppid [lindex $xth(me,cmds,$id,xplist) $ppix]
        if {$xth(me,cmds,$id,$ppid,idn)} {
          set rdx [expr $xth(me,cmds,$id,$ppid,xn) - $xth(me,cmds,$id,$ppid,x)]
          set rdy [expr $xth(me,cmds,$id,$ppid,yn) - $xth(me,cmds,$id,$ppid,y)]
          set rd [expr hypot($rdy,$rdx)]
        }
      }        
    } else {
      set npix [expr [lsearch $xth(me,cmds,$id,xplist) $pid] + 1]
      set npid [lindex $xth(me,cmds,$id,xplist) $npix]
      if {$npid > 0} {
        if {$xth(me,cmds,$id,$npid,idp)} {
          set rdx [expr $xth(me,cmds,$id,$npid,xp) - $xth(me,cmds,$id,$npid,x)]
          set rdy [expr $xth(me,cmds,$id,$npid,yp) - $xth(me,cmds,$id,$npid,y)]
          set rd [expr hypot($rdy,$rdx)]
        }
      }        
    }
  }
  
  if {$rd == 0.0} {
    set rd 40.0
  }
  
  return [list [expr double([format "%.2f" [expr $x + $dx / $dd * $rd]])] \
    [expr double([format "%.2f" [expr $y + $dy / $dd * $rd]])]]
  
}


proc xth_me_cmds_get_smoothed_cp {which xp yp x y xn yn} {

  set dxp [expr $x - $xp]
  set dyp [expr $y - $yp]
  set dp [expr hypot($dxp,$dyp)]

  set dxn [expr $xn - $x]
  set dyn [expr $yn - $y]
  set dn [expr hypot($dxn,$dyn)]
  
  if {($dp == 0.0) || ($dn == 0.0)} {
    return [list $xp $yp $xn $yn]
  }
  
  if {$which < 0} {
    set xp [expr $x - $dxn / $dn * $dp]
    set yp [expr $y - $dyn / $dn * $dp]
  } elseif {$which > 0} {
    set xn [expr $x + $dxp / $dp * $dn]
    set yn [expr $y + $dyp / $dp * $dn]
  } else {
    set dx [expr $xn - $xp]
    set dy [expr $yn - $yp]
    set d [expr hypot($dx,$dy)]
    if {$d == 0.0} {
       set dx [expr -1.0 * $dyp]
       set dy $dxp
       set d $dp
    }
    set xp [expr $x - $dx / $d * $dp]
    set yp [expr $y - $dy / $d * $dp]      
    set xn [expr $x + $dx / $d * $dn]
    set yn [expr $y + $dy / $d * $dn]
  }

  return [list [expr double([format "%.2f" $xp])] \
     [expr double([format "%.2f" $yp])] [expr double([format "%.2f" $xn])] \
     [expr double([format "%.2f" $yn])]]
}


proc xth_me_cmds_get_default_rotation {id pid} {

  global xth

  set x $xth(me,cmds,$id,$pid,x)
  set y $xth(me,cmds,$id,$pid,y)
  set dp 0.0
  set dn 0.0

  if {$xth(me,cmds,$id,$pid,idp) || $xth(me,cmds,$id,$pid,idn)} {

    set xp $xth(me,cmds,$id,$pid,xp)
    set yp $xth(me,cmds,$id,$pid,yp)
    set dp [expr hypot($xp - $x, $yp - $y)]
    set xn $xth(me,cmds,$id,$pid,xn)
    set yn $xth(me,cmds,$id,$pid,yn)
    set dn [expr hypot($xn - $x, $yn - $y)]
    
  } else {

    set ppix [expr [lsearch $xth(me,cmds,$id,xplist) $pid] - 1]
    if {$ppix >= 0} {
      set ppid [lindex $xth(me,cmds,$id,xplist) $ppix]
      set xp $xth(me,cmds,$id,$ppid,x)
      set yp $xth(me,cmds,$id,$ppid,y)
      set dp [expr hypot($xp - $x, $yp - $y)]
    } else {
      set xp {}
      set yp {}
    }
    
    set npix [expr [lsearch $xth(me,cmds,$id,xplist) $pid] + 1]
    set npid [lindex $xth(me,cmds,$id,xplist) $npix]
    if {$npid > 0} {
      set xn $xth(me,cmds,$id,$npid,x)
      set yn $xth(me,cmds,$id,$npid,y)
      set dn [expr hypot($xn - $x, $yn - $y)]
    } else {
      set xn {}
      set yn {}
    }
  }
  
  if {($dp > 0.0) && ($dn > 0.0)} {
    if {$dp > $dn} {
      set xn [expr $x + ($xn - $x) / $dn * $dp]
      set yn [expr $y + ($yn - $y) / $dn * $dp]
    } else {
      set xp [expr $x + ($xp - $x) / $dp * $dn]
      set yp [expr $y + ($yp - $y) / $dp * $dn]
    }
  }

  if {[string length $xn] < 1} {
    set xn $x
    set yn $y
  } 

  if {[string length $xp] < 1} {
    set xp $x
    set yp $y
  } 

  set rr [expr 360.0 - atan2($yn - $yp,$xn - $xp) / 3.14159265359 * 180.0];
  while {$rr >= 360.0} {set rr [expr $rr - 360.0]};
  while {$rr < 0.0} {set rr [expr $rr + 360.0]};
  return [format "%.1f" $rr]
  
}


proc xth_me_cmds_update_linept_list {id pid} {
  global xth
  set ix [lsearch $xth(me,cmds,$id,xplist) $pid]
  set xth(me,cmds,$id,plist) \
    [lreplace $xth(me,cmds,$id,plist) $ix $ix [format "%7.2f %7.2f" $xth(me,cmds,$id,$pid,x) $xth(me,cmds,$id,$pid,y)]]
}


proc xth_me_cmds_close_line {id} {
  global xth
  # prida bod ak treba, ak je novy, oznaci ho
  set xl $xth(me,cmds,$id,xplist)
  set lix [expr [llength $xl] - 2]
  set fpid [lindex $xl 0]
  set nwpid $xth(me,cmds,selpid)
  set olpid $xth(me,cmds,selpid)
  if {($lix < 2) || \
    ($xth(me,cmds,$id,$fpid,x) != $xth(me,cmds,$id,[lindex $xl $lix],x)) || \
    ($xth(me,cmds,$id,$fpid,y) != $xth(me,cmds,$id,[lindex $xl $lix],y))} {
    set oldurok $xth(me,unredook)
    set xth(me,unredook) 0
    set iix [expr $lix + 1]
    xth_me_cmds_create_line_point $id $iix 0 \
      $xth(me,cmds,$id,$fpid,x) $xth(me,cmds,$id,$fpid,y) $xth(me,cmds,$id,$fpid,xp) $xth(me,cmds,$id,$fpid,yp) \
      $xth(me,cmds,$id,$fpid,xn) $xth(me,cmds,$id,$fpid,yn) $xth(me,cmds,$id,$fpid,smooth) {} {} {} {} 1.0
    set xth(me,unredook) $oldurok
    set nwpid $xth(me,cmds,$id,lpid)
    xth_me_cmds_select_linept $id $nwpid
    set unpoint "xth_me_cmds_delete_linept $id $nwpid"
    set repoint "xth_me_cmds_undelete_linept $id $nwpid $iix"
  } else {
    set lpid [lindex $xl $lix]
    set unpoint "xth_me_cmds_select $id\nset xth(me,cmds,$id,$lpid,xp) {$xth(me,cmds,$id,$lpid,xp)}\nset xth(me,cmds,$id,$lpid,yp) {$xth(me,cmds,$id,$lpid,yp)}\nset xth(me,cmds,$id,$lpid,idp) {$xth(me,cmds,$id,$lpid,idp)}\nset xth(me,cmds,$id,$lpid,xn) {$xth(me,cmds,$id,$lpid,xn)}\nset xth(me,cmds,$id,$lpid,yn) {$xth(me,cmds,$id,$lpid,yn)}\nset xth(me,cmds,$id,$lpid,idn) {$xth(me,cmds,$id,$lpid,idn)}\nset xth(me,cmds,$id,$lpid,smooth) {$xth(me,cmds,$id,$lpid,smooth)}\nxth_me_cmds_move_linelnpt $id $lpid"
    set repoint "xth_me_cmds_select $id\nset xth(me,cmds,$id,$lpid,xp) {$xth(me,cmds,$id,$fpid,xp)}\nset xth(me,cmds,$id,$lpid,yp) {$xth(me,cmds,$id,$fpid,yp)}\nset xth(me,cmds,$id,$lpid,idp) {$xth(me,cmds,$id,$fpid,idp)}\nset xth(me,cmds,$id,$lpid,xn) {$xth(me,cmds,$id,$fpid,xn)}\nset xth(me,cmds,$id,$lpid,yn) {$xth(me,cmds,$id,$fpid,yn)}\nset xth(me,cmds,$id,$lpid,idn) {$xth(me,cmds,$id,$fpid,idn)}\nset xth(me,cmds,$id,$lpid,smooth) {$xth(me,cmds,$id,$fpid,smooth)}\nxth_me_cmds_move_linelnpt $id $lpid"
    eval $repoint
  }
  # nastavi close
  set xth(me,cmds,$id,close) 1
  # update vars
  xth_me_cmds_update_line_vars $id $nwpid
  xth_me_cmds_update_line_data $id
  xth_me_prev_cmd $xth(me,cmds,$id,data)
  if {$xth(me,cmds,mode) == 2} {
    set remode "xth_me_cmds_set_mode 0"
    set unmode "xth_me_cmds_set_mode 2"
    eval $remode
  } else {
    set remode ""
    set unmode ""
  }
  xth_me_unredo_action "line closing" \
  "$unpoint\nset xth(me,cmds,$id,close) 0\nxth_me_cmds_update_line_vars $id $olpid\nxth_me_cmds_update_line_data $id\nxth_me_prev_cmd \$xth(me,cmds,$id,data)\n$unmode" \
  "$repoint\nset xth(me,cmds,$id,close) 1\nxth_me_cmds_update_line_vars $id $nwpid\nxth_me_cmds_update_line_data $id\nxth_me_prev_cmd \$xth(me,cmds,$id,data)\n$remode"
  
}


proc xth_me_cmds_open_line {id} {
  global xth
  set xth(me,cmds,$id,close) 0
  xth_me_cmds_update_line_vars $id $xth(me,cmds,selpid)
  xth_me_cmds_update_line_data $id
  xth_me_prev_cmd $xth(me,cmds,$id,data)
  xth_me_unredo_action "line opening" "xth_me_cmds_reclose_line $id" \
    "xth_me_cmds_open_line $id"
}

proc xth_me_cmds_reclose_line {id} {
  global xth
  set xth(me,cmds,$id,close) 1
  xth_me_cmds_update_line_data $id
  xth_me_prev_cmd $xth(me,cmds,$id,data)
  xth_me_cmds_update_line_vars $id $xth(me,cmds,selpid)
}


proc xth_me_cmds_get_bezier_coords {x1 y1 c1x c1y c2x c2y x2 y2} {
#  if {[llength $x1] > 1} {
#    set tlen [lindex $x1 2]
#    set rotation [lindex $x1 1]
#    set x1 [lindex $x1 0]
#  } else {
#    set rotation {}
#  }
  if {[string length $c1x] < 1} {
    set c1x $x1
    set c1y $y1
  }
  if {[string length $c2x] < 1} {
    set c2x $x2
    set c2y $y2
  }
  set q 20
#  if {[string length $rotation] > 0} {    
#    set crds [list [expr $x1 + $tlen * sin(double($rotation)/180.0*3.14159265359)] \
#      [expr $y1 + $tlen * cos(double($rotation)/180.0*3.14159265359)]]
#  } else {
    set crds {}
#  }
  for {set i 0} {$i <= $q} {incr i} {
    set t [expr $i.0 / $q.0]
    set t2 [expr pow($t,2.0)]
    set t3 [expr pow($t,3.0)]
    set t_ [expr 1.0 - $t]
    set t_2 [expr pow($t_,2.0)]
    set t_3 [expr pow($t_,3.0)]
    lappend crds [expr $t_3 * $x1 + 3.0 * $t * $t_2 * $c1x + 3.0 * $t2 * $t_ * $c2x + $t3 * $x2] \
      [expr $t_3 * $y1 + 3.0 * $t * $t_2 * $c1y + 3.0 * $t2 * $t_ * $c2y + $t3 * $y2]
  }
  return $crds
}


proc xth_me_cmds_real2can_coords {crds} {
  set x 1
  set r {}
  foreach c $crds {
    if $x {
      lappend r [xth_me_real2canx $c]
      set x 0
    } else {
      lappend r [xth_me_real2cany $c]
      set x 1
    }
  }
  return $r
}


proc xth_me_cmds_get_crds2state {id ppid pid} {
  global xth
#  set tlen [expr 0.01 * $xth(me,zoom) * $xth(gui,me,line,ticksize)]

  if {$ppid > 0} {

#    if {[lsearch $xth(me,cmds,$id,xplist) $ppid] == 0} {
#      set rot [xth_me_cmds_get_default_rotation $id $ppid]
#      set x1 [list $xth(me,cmds,$id,$ppid,x) $rot $tlen]
#    } else {
#      set rot {}
      set x1 $xth(me,cmds,$id,$ppid,x)
#    }

    set st normal
    if {$xth(me,cmds,$id,$ppid,idn) || $xth(me,cmds,$id,$pid,idp)} {
      set crds [xth_me_cmds_get_bezier_coords $x1 \
        $xth(me,cmds,$id,$ppid,y) $xth(me,cmds,$id,$ppid,xn) \
        $xth(me,cmds,$id,$ppid,yn) $xth(me,cmds,$id,$pid,xp) \
        $xth(me,cmds,$id,$pid,yp) $xth(me,cmds,$id,$pid,x) \
        $xth(me,cmds,$id,$pid,y)]
    } else {
#      if {[string length $rot] > 0} {
#        set crds [list [expr $xth(me,cmds,$id,$ppid,x) + $tlen * sin(double($rot)/180.0*3.14159265359)] \
#          [expr $xth(me,cmds,$id,$ppid,y) + $tlen * cos(double($rot)/180.0*3.14159265359)]]
#      } else {
        set crds {}
#      }
      lappend crds $xth(me,cmds,$id,$ppid,x) $xth(me,cmds,$id,$ppid,y) \
        $xth(me,cmds,$id,$pid,x) $xth(me,cmds,$id,$pid,y)
    }
  } else {
    set crds {0 0 10 10}
    set st hidden
  }
  return [list $st $crds]
}



proc xth_me_cmds_draw_lineln {id ppid pid} {
  global xth
  set st2crds [xth_me_cmds_get_crds2state $id $ppid $pid]
  set st [lindex $st2crds 0]
  set crds [lindex $st2crds 1]
  $xth(me,can) create line [xth_me_cmds_real2can_coords $crds] -width $xth(gui,me,line,width) -fill $xth(gui,me,activefill) \
    -tags "line ln$id lnln$id ln$id.$pid command" -state $st
  xth_me_bind_area_drag ln$id.$pid {}
  $xth(me,can) bind ln$id.$pid <1> "xth_me_cmds_click_lineln {$id $pid} pt$id.$pid %x %y"
  set highlight_on "if {\$xth(me,cmds,selid) != $id} {\$xth(me,can) itemconfigure lnln$id -fill \$xth(gui,me,highlightfill)}"
  set highlight_off "if {\$xth(me,cmds,selid) != $id} {\$xth(me,can) itemconfigure lnln$id -fill \[$xth(me,can) itemcget pt$id.$pid -outline\]}"
  $xth(me,can) bind ln$id.$pid <Enter> "$highlight_on\nxth_status_bar_push me; xth_status_bar_status me \"\$xth(me,cmds,$id,listix): \[lindex \[regexp -inline -- {^\[^\\n\]*} \$xth(me,cmds,$id,data)\] 0\]\""
  $xth(me,can) bind ln$id.$pid <Leave> "$highlight_off\nxth_status_bar_pop me"
  catch {$xth(me,can) lower ln$id.$pid point}
}


proc xth_me_cmds_move_lineln {id ppid pid} {
  global xth
  set st2crds [xth_me_cmds_get_crds2state $id $ppid $pid]
  set st [lindex $st2crds 0]
  set crds [lindex $st2crds 1]
  $xth(me,can) coords ln$id.$pid [xth_me_cmds_real2can_coords $crds]
  $xth(me,can) itemconfigure ln$id.$pid -state $st
}


proc xth_me_cmds_draw_linept {id pid} {
  global xth
  $xth(me,can) create oval [expr [xth_me_real2canx $xth(me,cmds,$id,$pid,x)] - $xth(gui,me,line,psize)] \
  [expr [xth_me_real2cany $xth(me,cmds,$id,$pid,y)] - $xth(gui,me,line,psize)] [expr [xth_me_real2canx $xth(me,cmds,$id,$pid,x)] + $xth(gui,me,line,psize)] \
  [expr [xth_me_real2cany $xth(me,cmds,$id,$pid,y)] + $xth(gui,me,line,psize)] -width 1 -outline blue -fill $xth(gui,me,activefill) \
  -tags "point ln$id lnpt$id pt$id.$pid command"
  set highlight_on "if {\$xth(me,cmds,selid) != $id} {\$xth(me,can) itemconfigure lnln$id -fill \$xth(gui,me,highlightfill)}"
  set highlight_off "if {\$xth(me,cmds,selid) != $id} {\$xth(me,can) itemconfigure lnln$id -fill \[$xth(me,can) itemcget pt$id.$pid -outline\]}"
  $xth(me,can) bind pt$id.$pid <Enter> "$highlight_on\n$xth(me,can) itemconfigure pt$id.$pid -fill cyan; xth_status_bar_push me; xth_status_bar_status me \"\$xth(me,cmds,$id,listix): \[lindex \[regexp -inline -- {^\[^\\n\]*} \$xth(me,cmds,$id,data)\] 0\]\""
  $xth(me,can) bind pt$id.$pid <Leave> "$highlight_off\n$xth(me,can) itemconfigure pt$id.$pid -fill \[$xth(me,can) itemcget ln$id.$pid -fill\]; xth_status_bar_pop me"
  $xth(me,can) bind pt$id.$pid <1> "xth_me_cmds_click {$id $pid} pt$id.$pid \$xth(me,cmds,$id,$pid,x) \$xth(me,cmds,$id,$pid,y) %x %y"
  $xth(me,can) bind pt$id.$pid <3> "xth_me_cmds_special_select {$id $pid} %x %y"  
  $xth(me,can) bind pt$id.$pid <Shift-1> "xth_me_cmds_special_select {$id $pid} %x %y"  
  $xth(me,can) bind pt$id.$pid <$xth(kb_control)-1> "xth_me_cmds_click_area pt$id.$pid %x %y"
}


proc xth_me_cmds_move_linept {id pid} {
  global xth
  $xth(me,can) coords pt$id.$pid [expr [xth_me_real2canx $xth(me,cmds,$id,$pid,x)] - $xth(gui,me,line,psize)] \
  [expr [xth_me_real2cany $xth(me,cmds,$id,$pid,y)] - $xth(gui,me,line,psize)] [expr [xth_me_real2canx $xth(me,cmds,$id,$pid,x)] + $xth(gui,me,line,psize)] \
  [expr [xth_me_real2cany $xth(me,cmds,$id,$pid,y)] + $xth(gui,me,line,psize)]
}


proc xth_me_cmds_draw_line {id} {
  global xth
  set ppid 0
  foreach pid $xth(me,cmds,$id,xplist) {
    if {($pid > 0)} {
      xth_me_cmds_draw_lineln $id $ppid $pid
      xth_me_cmds_draw_linept $id $pid
    }
    set ppid $pid
  }
  catch {$xth(me,can) raise lnpt$id point}
}


proc xth_me_cmds_move_line {id} {
  global xth
  set ppid 0
  foreach pid $xth(me,cmds,$id,xplist) {
    if {($pid > 0)} {
      xth_me_cmds_move_lineln $id $ppid $pid
      xth_me_cmds_move_linept $id $pid
    }
    set ppid $pid
  }
}


proc xth_me_cmds_move_linelnpt {id pid} {
  global xth
  set xl $xth(me,cmds,$id,xplist)
  set ix [lsearch $xl $pid]
  if {($ix < 0) || ($pid == 0)} {
    return
  }
  
  set pix [expr $ix - 1]
  set nix [expr $ix + 1]
    
  set fix 0
  set lix [expr [llength $xl] - 2]
  
  set cpid 0
  set mpix 0
  set mnix 0
  
  if {$xth(me,cmds,$id,close)} {
    if {$ix == $fix} {
      set cpid [lindex $xl $lix]
      set pix [expr $lix - 1]
      set mpix 1
    } elseif {$ix == $lix} {
      set cpid [lindex $xl $fix]
      set nix [expr $fix + 1]
      set mnix 1
    }
  }
  xth_me_cmds_move_linept $id $pid
  if {$cpid > 0} {
    xth_me_cmds_move_linept $id $cpid
  }
  
  if {($pix >= $fix) && ($pix <= $lix)} {
    set ppid [lindex $xl $pix]
  } else {
    set ppid 0
  }
  if {$mpix} {
    xth_me_cmds_move_lineln $id $ppid $cpid
  } else {
    xth_me_cmds_move_lineln $id $ppid $pid
  }


  if {($nix >= $fix) && ($nix <= $lix)} {
    set npid [lindex $xl $nix]
    if {$mnix} {
      xth_me_cmds_move_lineln $id $cpid $npid
    } else {
      xth_me_cmds_move_lineln $id $pid $npid
    }
  }
  
}

proc xth_me_cmds_start_create_linept {tagOrId x y mx my} {

  global xth

  set xth(me,lptc,id) $xth(me,cmds,selid)
  set id $xth(me,lptc,id)
  if {$xth(me,cmds,$id,ct) != 3} {
    return
  }
  set xl $xth(me,cmds,$id,xplist)
  set inspid $xth(me,cmds,inspid)
  set oldpid $xth(me,cmds,selpid)
  set ix [lsearch $xl $inspid]
  set xth(me,lptc,mx) $mx
  set xth(me,lptc,my) $my
  set xth(me,lptc,tagOrId) $tagOrId
  if {($ix == 0) && $xth(me,cmds,$id,close)} {
    set unclosecmd "xth_me_cmds_reclose_line $id"
    set reclosecmd "xth_me_cmds_open_line $id"
    set ook $xth(me,unredook)
    set xth(me,unredook) 0
    eval $reclosecmd
    set xth(me,unredook) $ook
  } else {
    set unclosecmd ""
    set reclosecmd ""
  }

  xth_me_cmds_create_line_point $id $ix 0 $x $y {} {} {} {} 0 {} {} {} {} 1.0
  xth_me_cmds_hide_linept_xctrl  
  set pid $xth(me,cmds,$id,lpid)
  set pnpid [xth_me_cmds_get_line_pnpid $id $pid]
  set xth(me,lptc,ppid) [lindex $pnpid 0]
  set ppid $xth(me,lptc,ppid)
  set xth(me,lptc,npid) [lindex $pnpid 1]
  set npid $xth(me,lptc,npid)
  set xth(me,lptc,pid) $pid
  set xth(me,lptc,oldm) [$xth(me,can) bind $tagOrId <B1-Motion>]
  set xth(me,lptc,oldr) [$xth(me,can) bind $tagOrId <B1-ButtonRelease>]
  $xth(me,can) itemconfigure $xth(me,canid,linept,ncp) -fill yellow
  $xth(me,can) bind $tagOrId <B1-Motion> "xth_me_cmds_continue_linept_creation %x %y 1"
  $xth(me,can) bind $tagOrId <$xth(kb_control)-B1-Motion> "xth_me_cmds_continue_linept_creation %x %y 0"
  $xth(me,can) bind $tagOrId <B1-ButtonRelease> "xth_me_cmds_end_create_linept %x %y 1"
  $xth(me,can) bind $tagOrId <$xth(kb_control)-B1-ButtonRelease> "xth_me_cmds_end_create_linept %x %y 0"
  xth_me_cmds_continue_linept_creation $mx $my 1
  xth_me_unredo_action "inserting line point" "xth_me_cmds_delete_linept $id $pid\n$unclosecmd\nxth_me_cmds_select_linept $id $oldpid" \
    "$reclosecmd\nxth_me_cmds_undelete_linept $id $pid $ix"
  if {($ppid > 0) && $xth(me,cmds,$id,$ppid,idn)} {
    $xth(me,can) itemconfigure lineptppcp -state normal
  }
  if {($npid > 0) && $xth(me,cmds,$id,$npid,idp)} {
    $xth(me,can) itemconfigure lineptnncp -state normal
  }
  xth_me_cmds_continue_linept_creation $mx $my 1
}


proc xth_me_cmds_continue_linept_creation {x y motionID} {
  global xth
  set id $xth(me,lptc,id)
  set pid $xth(me,lptc,pid)
  set ppid $xth(me,lptc,ppid)
  set npid $xth(me,lptc,npid)
  set dx [expr $x - $xth(me,lptc,mx)]
  set dy [expr $y - $xth(me,lptc,my)]
  set dst [expr hypot($dy,$dx)]
  if {$dst > $xth(gui,me,line,psize)} {
    set xn [xth_me_can2realx [$xth(me,can) canvasx $x]]
    set yn [xth_me_can2realy [$xth(me,can) canvasy $y]]
    set xth(me,cmds,$id,$pid,idn) 1
    set xth(me,cmds,$id,$pid,xn) [expr double([format %.2f $xn])]
    set xth(me,cmds,$id,$pid,yn) [expr double([format %.2f $yn])]
    set xth(me,cmds,$id,$pid,idp) 1
    set x $xth(me,cmds,$id,$pid,x)
    set y $xth(me,cmds,$id,$pid,y)
    set dx [expr $xn - $x]
    set dy [expr $yn - $y]
    $xth(me,can) itemconfigure lineptpcp -state normal
    $xth(me,can) itemconfigure lineptncp -state normal
    if {($ppid > 0) && $xth(me,cmds,$id,$ppid,idn)} {
      $xth(me,can) itemconfigure lineptppcp -state normal
    }
    set d [expr hypot($dy,$dx)]
    if {$motionID} {
      set xd $d
      set xth(me,lptc,xd) $d
    } else {
      if {[info exist xth(me,lptc,xd)]} {
        set xd $xth(me,lptc,xd)
      } else {
        set xd $d
      }
    }
    if {(!$motionID)} {
      set dx [expr $dx / $d * $xd]
      set dy [expr $dy / $d * $xd]
    }
    set xth(me,cmds,$id,$pid,xp) [expr double([format %.2f [expr $x - $dx]])]
    set xth(me,cmds,$id,$pid,yp) [expr double([format %.2f [expr $y - $dy]])]
    set xth(me,cmds,$id,$pid,smooth) 1
  } else {
    set xth(me,cmds,$id,$pid,idn) 0
    set xth(me,cmds,$id,$pid,xn) {}
    set xth(me,cmds,$id,$pid,yn) {}
    set xth(me,cmds,$id,$pid,idp) 0
    set xth(me,cmds,$id,$pid,xp) {}
    set xth(me,cmds,$id,$pid,yp) {}
    $xth(me,can) itemconfigure lineptpcp -state hidden
    $xth(me,can) itemconfigure lineptncp -state hidden
  }
  xth_me_cmds_move_lineptcp_xctrl $id $ppid $pid $npid
  xth_me_cmds_move_line_xctrl $id
  xth_me_cmds_move_linelnpt $id $pid
  update idletasks
}


proc xth_me_cmds_end_create_linept {x y motionID} {
  global xth
  xth_me_cmds_continue_linept_creation $x $y $motionID
  set tagOrId $xth(me,lptc,tagOrId)
  set id $xth(me,lptc,id)
  set pid $xth(me,lptc,pid)
  $xth(me,can) bind $tagOrId <B1-Motion> $xth(me,lptc,oldm)
  $xth(me,can) bind $tagOrId <B1-ButtonRelease> $xth(me,lptc,oldr)
  $xth(me,can) bind $tagOrId <$xth(kb_control)-B1-Motion> ""
  $xth(me,can) bind $tagOrId <$xth(kb_control)-B1-ButtonRelease> ""
  xth_me_cmds_hide_linept_xctrl  
  set ook $xth(me,unredook)
  set xth(me,unredook) 0
  if {$xth(me,cmds,$id,$pid,idn)} {
    $xth(me,can) itemconfigure $xth(me,canid,linept,ncp) -fill yellow
  } else {
    $xth(me,can) itemconfigure $xth(me,canid,linept,ncp) -fill red
  }
  xth_me_cmds_select_linept $id $pid
  xth_me_cmds_update_line_data $id
  xth_me_prev_cmd $xth(me,cmds,$id,data)
  set xth(me,unredook) $ook
}


proc xth_me_cmds_end_line {} {
  set recmds "xth_me_cmds_set_mode 0"
  set uncmds "xth_me_cmds_set_mode 2"
  eval $recmds
  xth_me_unredo_action "line ending" $uncmds $recmds
}


proc xth_me_cmds_start_linept_insert {} {
  global xth
  set xth(me,cmds,inspid) $xth(me,cmds,selpid)
  xth_me_cmds_set_mode 2
}


proc xth_me_cmds_start_area_insert {btn} {
  global xth
  if {$btn && ($xth(me,cmds,mode) == 3)} {
    xth_me_cmds_set_mode 0
  } else {
    xth_me_cmds_set_mode 3
  }
}


proc xth_me_cmds_get_line_pnpid {id pid} {
  global xth
  set xl $xth(me,cmds,$id,xplist)
  set ix [lsearch $xl $pid]
  set lix [expr [llength $xl] - 2]
  if {$ix > 0} {
    set ppid [lindex $xl [expr $ix - 1]]
  } elseif {$xth(me,cmds,$id,close) && ($lix > 0)} {
    set ppid [lindex $xl [expr $lix - 1]]
  } else {
    set ppid 0
  }
  if {$ix < $lix} {
    set npid [lindex $xl [expr $ix + 1]]
  } elseif {$xth(me,cmds,$id,close) && ($lix > 0)} {
    set npid [lindex $xl 1]
  } else {
    set npid 0
  }
  return [list $ppid $npid]
}


proc xth_me_cmds_start_linecp_drag {tagOrId id ppid pid npid which x y} {

  global xth
  
  xth_me_cmds_update {}

  set xth(me,lcpd,tagOrId) $tagOrId
  set xth(me,lcpd,id) $id
  set xth(me,lcpd,pid) $pid
  set xth(me,lcpd,ppid) $ppid
  set xth(me,lcpd,npid) $npid
  set xth(me,lcpd,which) $which
  set xth(me,lcpd,mx) $x
  set xth(me,lcpd,my) $y
  
  set lix [expr [llength $xth(me,cmds,$id,xplist)] - 2]
  if {$lix > 0} {
    set fpid [lindex $xth(me,cmds,$id,xplist) 0]
    set lpid [lindex $xth(me,cmds,$id,xplist) $lix] 
  }
  set altpid 0
  set altppid 0
  set altnpid 0
  if {($lix > 0) && $xth(me,cmds,$id,close)} {
    if {$pid == $fpid} {
      set altpid $lpid
    } elseif {$pid == $lpid} {
      set altpid $fpid
    }
    if {$ppid == $fpid} {
      set altppid $lpid
    } elseif {$ppid == $lpid} {
      set altppid $fpid
    }
    if {$npid == $fpid} {
      set altnpid $lpid
    } elseif {$npid == $lpid} {
      set altnpid $fpid
    }
  }
  
  set xth(me,lcpd,altpid) $altpid
  set xth(me,lcpd,altppid) $altppid
  set xth(me,lcpd,altnpid) $altnpid

  set xth(me,lcpd,oldenter) [$xth(me,can) bind $tagOrId <Enter>]
  $xth(me,can) bind $tagOrId <Enter> ""
  set xth(me,lcpd,oldleave) [$xth(me,can) bind $tagOrId <Leave>]
  $xth(me,can) bind $tagOrId <Leave> ""
  set xth(me,lcpd,oldfill) [$xth(me,can) itemcget $tagOrId -fill]
  $xth(me,can) itemconfigure $tagOrId -fill {}
  $xth(me,can) bind $tagOrId <B1-Motion> "xth_me_cmds_continue_linecp_drag %x %y 0"
  $xth(me,can) bind $tagOrId <B1-ButtonRelease> "xth_me_cmds_end_linecp_drag %x %y 0"

  set dragto 0

  switch $which {
    x {
      set dragto 1
      $xth(me,can) bind $tagOrId <B1-Motion> "xth_me_cmds_continue_linecp_drag %x %y 1"
      $xth(me,can) bind $tagOrId <B1-ButtonRelease> "xth_me_cmds_end_linecp_drag %x %y 1"
      $xth(me,can) bind $tagOrId <$xth(kb_control)-B1-Motion> "xth_me_cmds_continue_linecp_drag %x %y 0"
      $xth(me,can) bind $tagOrId <$xth(kb_control)-B1-ButtonRelease> "xth_me_cmds_end_linecp_drag %x %y 0"
      set xth(me,lcpd,oldmove,pcplstate) [$xth(me,can) itemcget $xth(me,canid,linept,pcpl) -state]
      $xth(me,can) itemconfigure $xth(me,canid,linept,pcpl) -state hidden
      set xth(me,lcpd,oldmove,ncplstate) [$xth(me,can) itemcget $xth(me,canid,linept,ncpl) -state]
      $xth(me,can) itemconfigure $xth(me,canid,linept,ncpl) -state hidden
      set xth(me,lcpd,oldmove,selstate) [$xth(me,can) itemcget $xth(me,canid,linept,selector) -state]
      $xth(me,can) itemconfigure $xth(me,canid,linept,selector) -state hidden
      set xth(me,lcpd,oldmove,pcpfill) [$xth(me,can) itemcget $xth(me,canid,linept,pcp) -fill]
      $xth(me,can) itemconfigure $xth(me,canid,linept,pcp) -fill {}
      set xth(me,lcpd,oldmove,ncpfill) [$xth(me,can) itemcget $xth(me,canid,linept,ncp) -fill]
      $xth(me,can) itemconfigure $xth(me,canid,linept,ncp) -fill {}
      $xth(me,can) itemconfigure $xth(me,canid,linept,fr) -width 1 -arrow none
      $xth(me,can) itemconfigure $xth(me,canid,linept,fl) -width 1 -arrow none
      set xth(me,lcpd,oldx) $xth(me,cmds,$id,$pid,x)
      set xth(me,lcpd,oldy) $xth(me,cmds,$id,$pid,y)
      set xth(me,lcpd,oldxp) $xth(me,cmds,$id,$pid,xp)
      set xth(me,lcpd,oldyp) $xth(me,cmds,$id,$pid,yp)
      set xth(me,lcpd,oldxn) $xth(me,cmds,$id,$pid,xn)
      set xth(me,lcpd,oldyn) $xth(me,cmds,$id,$pid,yn)
    }
    p {
      set xth(me,lcpd,oldxp) $xth(me,cmds,$id,$pid,xp)
      set xth(me,lcpd,oldyp) $xth(me,cmds,$id,$pid,yp)
      set xth(me,lcpd,oldxn) $xth(me,cmds,$id,$pid,xn)
      set xth(me,lcpd,oldyn) $xth(me,cmds,$id,$pid,yn)
    }
    n {
      set xth(me,lcpd,oldxp) $xth(me,cmds,$id,$pid,xp)
      set xth(me,lcpd,oldyp) $xth(me,cmds,$id,$pid,yp)
      set xth(me,lcpd,oldxn) $xth(me,cmds,$id,$pid,xn)
      set xth(me,lcpd,oldyn) $xth(me,cmds,$id,$pid,yn)
    }
    pp {
      set xth(me,lcpd,oldxpp) $xth(me,cmds,$id,$ppid,xn)
      set xth(me,lcpd,oldypp) $xth(me,cmds,$id,$ppid,yn)
    }
    nn {
      set xth(me,lcpd,oldxnn) $xth(me,cmds,$id,$npid,xp)
      set xth(me,lcpd,oldynn) $xth(me,cmds,$id,$npid,yp)
    }
  }
  
  xth_me_cmds_continue_linecp_drag $x $y $dragto
  $xth(me,can) configure -cursor {}
  
}


proc xth_me_cmds_continue_linecp_drag {x y dragto} {
  global xth
  set id $xth(me,lcpd,id)
  set pid $xth(me,lcpd,pid)
  set ppid $xth(me,lcpd,ppid)
  set npid $xth(me,lcpd,npid)
  set tagOrId $xth(me,lcpd,tagOrId)
  set altpid $xth(me,lcpd,altpid)
  set altppid $xth(me,lcpd,altppid)
  set altnpid $xth(me,lcpd,altnpid)
  set nx [expr double([format %.2f [xth_me_can2realx [$xth(me,can) canvasx $x]]])]
  set ny [expr double([format %.2f [xth_me_can2realy [$xth(me,can) canvasy $y]]])]
  set dts 0
  if $dragto {
    set dtl [xth_me_cmds_drag_to $id $pid $x $y]
    if {[lindex $dtl 0]} {
      set nx [lindex $dtl 1]
      set ny [lindex $dtl 2]
      set dts 1
    }
  }
  if $dts {
    $xth(me,can) itemconfigure $tagOrId -fill cyan
  } else {
    $xth(me,can) itemconfigure $tagOrId -fill {}
  }
  switch $xth(me,lcpd,which) {
    x {
      set xth(ctrl,me,linept,x) $nx
      set xth(me,cmds,$id,$pid,x) $nx
      set xth(ctrl,me,linept,y) $ny
      set xth(me,cmds,$id,$pid,y) $ny
      if {$altpid > 0} {
        set xth(me,cmds,$id,$altpid,y) $ny
        set xth(me,cmds,$id,$altpid,x) $nx
      }
      
      if {$xth(me,cmds,$id,$pid,idp)} {
        set nxp [expr double([format %.2f [expr $nx + $xth(me,lcpd,oldxp) - $xth(me,lcpd,oldx)]])]
        set nyp [expr double([format %.2f [expr $ny + $xth(me,lcpd,oldyp) - $xth(me,lcpd,oldy)]])]
        set xth(ctrl,me,linept,xp) $nxp
        set xth(me,cmds,$id,$pid,xp) $nxp
        set xth(ctrl,me,linept,yp) $nyp
        set xth(me,cmds,$id,$pid,yp) $nyp
        if {$altpid > 0} {
          set xth(me,cmds,$id,$altpid,xp) $nxp
          set xth(me,cmds,$id,$altpid,yp) $nyp
        }
      }
      
      if {$xth(me,cmds,$id,$pid,idn)} {
        set nxn [expr double([format %.2f [expr $nx + $xth(me,lcpd,oldxn) - $xth(me,lcpd,oldx)]])]
        set nyn [expr double([format %.2f [expr $ny + $xth(me,lcpd,oldyn) - $xth(me,lcpd,oldy)]])]
        set xth(ctrl,me,linept,xn) $nxn
        set xth(me,cmds,$id,$pid,xn) $nxn
        set xth(ctrl,me,linept,yn) $nyn
        set xth(me,cmds,$id,$pid,yn) $nyn
        if {$altpid > 0} {
          set xth(me,cmds,$id,$altpid,xn) $nxn
          set xth(me,cmds,$id,$altpid,yn) $nyn
        }
      }
      xth_me_cmds_move_linept_xctrl $id $pid
      xth_me_cmds_move_line_xctrl $id
    }
    p {
      set xth(ctrl,me,linept,xp) $nx
      set xth(me,cmds,$id,$pid,xp) $nx
      set xth(ctrl,me,linept,yp) $ny
      set xth(me,cmds,$id,$pid,yp) $ny
      if {$altpid > 0} {
        set xth(me,cmds,$id,$altpid,xp) $nx
        set xth(me,cmds,$id,$altpid,yp) $ny
      }
      if {$xth(me,cmds,$id,$pid,idn) && $xth(me,cmds,$id,$pid,smooth)} {
        set ncn [xth_me_cmds_get_smoothed_cp 1 $nx $ny \
          $xth(me,cmds,$id,$pid,x) $xth(me,cmds,$id,$pid,y) \
          $xth(me,cmds,$id,$pid,xn) $xth(me,cmds,$id,$pid,yn)]
        set nxn [lindex $ncn 2]
        set nyn [lindex $ncn 3]
        set xth(ctrl,me,linept,xn) $nxn
        set xth(me,cmds,$id,$pid,xn) $nxn
        set xth(ctrl,me,linept,yn) $nyn
        set xth(me,cmds,$id,$pid,yn) $nyn
        if {$altpid > 0} {
          set xth(me,cmds,$id,$altpid,xn) $nxn
          set xth(me,cmds,$id,$altpid,yn) $nyn
        }
      }
    }
    n {
      set xth(ctrl,me,linept,xn) $nx
      set xth(me,cmds,$id,$pid,xn) $nx
      set xth(ctrl,me,linept,yn) $ny
      set xth(me,cmds,$id,$pid,yn) $ny
      if {$altpid > 0} {
        set xth(me,cmds,$id,$altpid,xn) $nx
        set xth(me,cmds,$id,$altpid,yn) $ny
      }
      if {$xth(me,cmds,$id,$pid,idp) && $xth(me,cmds,$id,$pid,smooth)} {
        set ncp [xth_me_cmds_get_smoothed_cp -1 \
          $xth(me,cmds,$id,$pid,xp) $xth(me,cmds,$id,$pid,yp) \
          $xth(me,cmds,$id,$pid,x) $xth(me,cmds,$id,$pid,y) \
          $nx $ny]
        set nxp [lindex $ncp 0]
        set nyp [lindex $ncp 1]
        set xth(ctrl,me,linept,xp) $nxp
        set xth(me,cmds,$id,$pid,xp) $nxp
        set xth(ctrl,me,linept,yp) $nyp
        set xth(me,cmds,$id,$pid,yp) $nyp
        if {$altpid > 0} {
          set xth(me,cmds,$id,$altpid,xp) $nxp
          set xth(me,cmds,$id,$altpid,yp) $nyp
        }
      }
    }
    pp {
      if {$xth(me,cmds,$id,$ppid,smooth)} {
        set ncp [xth_me_cmds_get_smoothed_cp 1 \
          $xth(me,cmds,$id,$ppid,xp) $xth(me,cmds,$id,$ppid,yp) \
          $xth(me,cmds,$id,$ppid,x) $xth(me,cmds,$id,$ppid,y) \
          $nx $ny]
        set xth(me,cmds,$id,$ppid,xn) [lindex $ncp 2]
        set xth(me,cmds,$id,$ppid,yn) [lindex $ncp 3]
      } else {
        set xth(me,cmds,$id,$ppid,xn) $nx
        set xth(me,cmds,$id,$ppid,yn) $ny
      }
      if {$altppid > 0} {
        set xth(me,cmds,$id,$altppid,xn) $xth(me,cmds,$id,$ppid,xn)
        set xth(me,cmds,$id,$altppid,yn) $xth(me,cmds,$id,$ppid,yn)
      }
    }
    nn {
      if {$xth(me,cmds,$id,$npid,smooth)} {
        set ncp [xth_me_cmds_get_smoothed_cp -1 \
          $nx $ny \
          $xth(me,cmds,$id,$npid,x) $xth(me,cmds,$id,$npid,y) \
          $xth(me,cmds,$id,$npid,xn) $xth(me,cmds,$id,$npid,yn)]
        set xth(me,cmds,$id,$npid,xp) [lindex $ncp 0]
        set xth(me,cmds,$id,$npid,yp) [lindex $ncp 1]
      } else {
        set xth(me,cmds,$id,$npid,xp) $nx
        set xth(me,cmds,$id,$npid,yp) $ny
      }
      if {$altnpid > 0} {
        set xth(me,cmds,$id,$altnpid,xp) $xth(me,cmds,$id,$npid,xp)
        set xth(me,cmds,$id,$altnpid,yp) $xth(me,cmds,$id,$npid,yp)
      }
    }
  }
  xth_me_cmds_move_lineptcp_xctrl $id $ppid $pid $npid
  xth_me_cmds_move_linelnpt $id $pid
  update idletasks
}


proc xth_me_cmds_end_linecp_drag {x y dragto} {
  global xth

  xth_me_cmds_continue_linecp_drag $x $y $dragto
  set id $xth(me,lcpd,id)
  set pid $xth(me,lcpd,pid)
  set ppid $xth(me,lcpd,ppid)
  set npid $xth(me,lcpd,npid)
  set altpid $xth(me,lcpd,altpid)
  set altppid $xth(me,lcpd,altppid)
  set altnpid $xth(me,lcpd,altnpid)
  set tagOrId $xth(me,lcpd,tagOrId)

  set movecmd "xth_me_cmds_move_lineptcp_xctrl $id $ppid $pid $npid\nxth_me_cmds_move_linept_xctrl $id $pid\nxth_me_cmds_move_linelnpt $id $pid"

  switch $xth(me,lcpd,which) {
    x {
      set xth(me,cmds,$id,$pid,x) $xth(me,lcpd,oldx)
      set xth(me,cmds,$id,$pid,y) $xth(me,lcpd,oldy)
      set xth(me,cmds,$id,$pid,xp) $xth(me,lcpd,oldxp)
      set xth(me,cmds,$id,$pid,yp) $xth(me,lcpd,oldyp)
      set xth(me,cmds,$id,$pid,xn) $xth(me,lcpd,oldxn)
      set xth(me,cmds,$id,$pid,yn) $xth(me,lcpd,oldyn)
      if {$altpid > 0} {
        set xth(me,cmds,$id,$altpid,x) $xth(me,lcpd,oldx)
        set xth(me,cmds,$id,$altpid,y) $xth(me,lcpd,oldy)
        set xth(me,cmds,$id,$altpid,xp) $xth(me,lcpd,oldxp)
        set xth(me,cmds,$id,$altpid,yp) $xth(me,lcpd,oldyp)
        set xth(me,cmds,$id,$altpid,xn) $xth(me,lcpd,oldxn)
        set xth(me,cmds,$id,$altpid,yn) $xth(me,lcpd,oldyn)
      }
      set xth(me,unredola) "moving line point"
      $xth(me,can) itemconfigure $xth(me,canid,linept,pcpl) -state $xth(me,lcpd,oldmove,pcplstate)
      $xth(me,can) itemconfigure $xth(me,canid,linept,ncpl) -state $xth(me,lcpd,oldmove,ncplstate)
      $xth(me,can) itemconfigure $xth(me,canid,linept,selector) -state $xth(me,lcpd,oldmove,selstate)
      $xth(me,can) itemconfigure $xth(me,canid,linept,pcp) -fill $xth(me,lcpd,oldmove,pcpfill)
      $xth(me,can) itemconfigure $xth(me,canid,linept,ncp) -fill $xth(me,lcpd,oldmove,ncpfill)
      $xth(me,can) itemconfigure $xth(me,canid,linept,fr) -width 5 -arrow last
      $xth(me,can) itemconfigure $xth(me,canid,linept,fl) -width 5 -arrow last
    }
    p {
      set xth(me,cmds,$id,$pid,xp) $xth(me,lcpd,oldxp)
      set xth(me,cmds,$id,$pid,yp) $xth(me,lcpd,oldyp)
      set xth(me,cmds,$id,$pid,xn) $xth(me,lcpd,oldxn)
      set xth(me,cmds,$id,$pid,yn) $xth(me,lcpd,oldyn)
      if {$altpid > 0} {
        set xth(me,cmds,$id,$altpid,xp) $xth(me,lcpd,oldxp)
        set xth(me,cmds,$id,$altpid,yp) $xth(me,lcpd,oldyp)
        set xth(me,cmds,$id,$altpid,xn) $xth(me,lcpd,oldxn)
        set xth(me,cmds,$id,$altpid,yn) $xth(me,lcpd,oldyn)
      }
      set xth(me,unredola) "moving control pint"
    }
    n {
      set xth(me,cmds,$id,$pid,xp) $xth(me,lcpd,oldxp)
      set xth(me,cmds,$id,$pid,yp) $xth(me,lcpd,oldyp)
      set xth(me,cmds,$id,$pid,xn) $xth(me,lcpd,oldxn)
      set xth(me,cmds,$id,$pid,yn) $xth(me,lcpd,oldyn)
      if {$altpid > 0} {
        set xth(me,cmds,$id,$altpid,xp) $xth(me,lcpd,oldxp)
        set xth(me,cmds,$id,$altpid,yp) $xth(me,lcpd,oldyp)
        set xth(me,cmds,$id,$altpid,xn) $xth(me,lcpd,oldxn)
        set xth(me,cmds,$id,$altpid,yn) $xth(me,lcpd,oldyn)
      }
      set xth(me,unredola) "moving control pint"
    }
    pp {
      if {$altppid > 0} {
        set unaltcmd "set xth(me,cmds,$id,$altppid,xn) $xth(me,lcpd,oldxpp)\nset xth(me,cmds,$id,$altppid,yn) $xth(me,lcpd,oldypp)"
        set realtcmd "set xth(me,cmds,$id,$altppid,xn) $xth(me,cmds,$id,$ppid,xn)\nset xth(me,cmds,$id,$altppid,yn) $xth(me,cmds,$id,$ppid,yn)"
      } else {
        set unaltcmd ""
        set realtcmd ""
      }
      xth_me_unredo_action "moving control point" \
      "xth_me_cmds_select {$id $pid}\nset xth(me,cmds,$id,$ppid,xn) $xth(me,lcpd,oldxpp)\nset xth(me,cmds,$id,$ppid,yn) $xth(me,lcpd,oldypp)\n$unaltcmd\n$movecmd\nxth_me_cmds_update_line_data $id\nxth_me_prev_cmd [list $xth(me,cmds,$id,data)]" \
      "xth_me_cmds_select {$id $pid}\nset xth(me,cmds,$id,$ppid,xn) $xth(me,cmds,$id,$ppid,xn)\nset xth(me,cmds,$id,$ppid,yn) $xth(me,cmds,$id,$ppid,yn)\n$realtcmd\n$movecmd\nxth_me_cmds_update_line_data $id\nxth_me_prev_cmd [list $xth(me,cmds,$id,data)]"
    }
    nn {
      if {$altnpid > 0} {
        set unaltcmd "set xth(me,cmds,$id,$altnpid,xp) $xth(me,lcpd,oldxnn)\nset xth(me,cmds,$id,$altnpid,yp) $xth(me,lcpd,oldynn)"
        set realtcmd "set xth(me,cmds,$id,$altnpid,xp) $xth(me,cmds,$id,$npid,xp)\nset xth(me,cmds,$id,$altnpid,yp) $xth(me,cmds,$id,$npid,yp)"
      } else {
        set unaltcmd ""
        set realtcmd ""
      }
      xth_me_unredo_action "moving control point" \
      "xth_me_cmds_select {$id $pid}\nset xth(me,cmds,$id,$npid,xp) $xth(me,lcpd,oldxnn)\nset xth(me,cmds,$id,$npid,yp) $xth(me,lcpd,oldynn)\n$unaltcmd\n$movecmd\nxth_me_cmds_update_line_data $id\nxth_me_prev_cmd [list $xth(me,cmds,$id,data)]" \
      "xth_me_cmds_select {$id $pid}\nset xth(me,cmds,$id,$npid,xp) $xth(me,cmds,$id,$npid,xp)\nset xth(me,cmds,$id,$npid,yp) $xth(me,cmds,$id,$npid,yp)\n$realtcmd\n$movecmd\nxth_me_cmds_update_line_data $id\nxth_me_prev_cmd [list $xth(me,cmds,$id,data)]"
    }
  }

  $xth(me,can) bind $tagOrId <Enter> $xth(me,lcpd,oldenter)
  $xth(me,can) bind $tagOrId <Leave> $xth(me,lcpd,oldleave)
  $xth(me,can) itemconfigure $tagOrId -fill $xth(me,lcpd,oldfill)
  $xth(me,can) bind $tagOrId <B1-Motion> ""
  $xth(me,can) bind $tagOrId <B1-ButtonRelease> ""
  $xth(me,can) bind $tagOrId <$xth(kb_control)-B1-Motion> ""
  $xth(me,can) bind $tagOrId <$xth(kb_control)-B1-ButtonRelease> ""
  $xth(me,can) configure -cursor crosshair
  xth_me_cmds_update_line_data $id
  xth_me_prev_cmd $xth(me,cmds,$id,data)  
  xth_me_cmds_move_line_xctrl $id
  xth_me_cmds_update {}
  
}


proc xth_me_cmds_configure_linept_size_xctrl {id pid} {

  global xth
  
  if {([string length $id] > 0) && ($pid > 0)} {
    if {([string length $xth(me,cmds,$id,$pid,rs)] > 0)} {
      $xth(me,can) itemconfigure $xth(me,canid,linept,fr) -state normal
      $xth(me,can) bind $xth(me,canid,linept,fr) <1> \
        "xth_me_cmds_start_linept_fdrag $xth(me,canid,linept,fr) $id $pid r %x %y"
      $xth(me,can) bind $xth(me,canid,linept,fr) <Enter> \
        "$xth(me,can) itemconfigure $xth(me,canid,linept,fr) -fill #ffda00"
      $xth(me,can) bind $xth(me,canid,linept,fr) <Leave> \
        "$xth(me,can) itemconfigure $xth(me,canid,linept,fr) -fill red"
    } else {
      $xth(me,can) bind $xth(me,canid,linept,fr) <1> ""
      $xth(me,can) bind $xth(me,canid,linept,fr) <Enter> ""
      $xth(me,can) bind $xth(me,canid,linept,fr) <Leave> ""
      $xth(me,can) itemconfigure $xth(me,canid,linept,fr) -state hidden
    }
    if {([string length $xth(me,cmds,$id,$pid,ls)] > 0) || \
      (([string length $xth(me,cmds,$id,$pid,rotation)] > 0) && \
       ([string length $xth(me,cmds,$id,$pid,rs)] < 1))} {
      $xth(me,can) itemconfigure $xth(me,canid,linept,fl) -state normal
      $xth(me,can) bind $xth(me,canid,linept,fl) <1> \
        "xth_me_cmds_start_linept_fdrag $xth(me,canid,linept,fl) $id $pid l %x %y"
      $xth(me,can) bind $xth(me,canid,linept,fl) <Enter> \
        "$xth(me,can) itemconfigure $xth(me,canid,linept,fl) -fill #ffda00"
      $xth(me,can) bind $xth(me,canid,linept,fl) <Leave> \
        "$xth(me,can) itemconfigure $xth(me,canid,linept,fl) -fill red"
    } else {
      $xth(me,can) bind $xth(me,canid,linept,fl) <1> ""
      $xth(me,can) bind $xth(me,canid,linept,fl) <Enter> ""
      $xth(me,can) bind $xth(me,canid,linept,fl) <Leave> ""
      $xth(me,can) itemconfigure $xth(me,canid,linept,fl) -state hidden
    }
  } else {
      $xth(me,can) bind $xth(me,canid,linept,fr) <1> ""
      $xth(me,can) bind $xth(me,canid,linept,fr) <Enter> ""
      $xth(me,can) bind $xth(me,canid,linept,fr) <Leave> ""
      $xth(me,can) itemconfigure $xth(me,canid,linept,fr) -state hidden
      $xth(me,can) bind $xth(me,canid,linept,fl) <1> ""
      $xth(me,can) bind $xth(me,canid,linept,fl) <Enter> ""
      $xth(me,can) bind $xth(me,canid,linept,fl) <Leave> ""
      $xth(me,can) itemconfigure $xth(me,canid,linept,fl) -state hidden
  }
}


proc xth_me_cmds_move_linept_size_xctrl {id pid rot rs ls} {

  global xth
  
  set rotng 1
  if {[string length $rot] > 0} {
    set rot [expr double($rot) / 180.0 * 3.14159265359]
    set rotng 0
  } else {
    set rot [expr double([xth_me_cmds_get_default_rotation $id $pid]) / 180 * 3.14159265359]
  }

  if {[string length $rs] > 0} {
    set rs [expr 0.01 * $rs * $xth(me,zoom)]
  } else {
    set rs 30.0
  }

  if {[string length $ls] > 0} {
    set ls [expr 0.01 * $ls * $xth(me,zoom)]
  } else {
    set ls 30.0
  }


  set x [xth_me_real2canx $xth(me,cmds,$id,$pid,x)]
  set y [xth_me_real2cany $xth(me,cmds,$id,$pid,y)]
  set ca [expr cos($rot)]
  set sa [expr sin($rot)]
  
  set yvx [expr $sa * $ls]
  set yvy [expr - $ca * $ls]
  set xvx [expr - $sa * $rs]
  set xvy [expr $ca * $rs]
  
  if {$xth(me,cmds,$id,reverse) && $rotng} {
    set xvx [expr -1.0 * $xvx]
    set xvy [expr -1.0 * $xvy]
    set yvx [expr -1.0 * $yvx]
    set yvy [expr -1.0 * $yvy]
  }
  
  $xth(me,can) coords $xth(me,canid,linept,fr) $x $y [expr $x + $xvx] [expr $y + $xvy]
  $xth(me,can) coords $xth(me,canid,linept,fl) $x $y [expr $x + $yvx] [expr $y + $yvy]
  update idletasks    
}


proc xth_me_cmds_start_linept_fdrag {tagOrId id pid side x y} {
  global xth
  xth_me_cmds_update {}
  set xth(me,lptfd,tagOrId) $tagOrId
  set xth(me,lptfd,id) $id
  set xth(me,lptfd,pid) $pid
  set xth(me,lptfd,side) $side
  set dx [expr [xth_me_can2realx [$xth(me,can) canvasx $x]] - $xth(me,cmds,$id,$pid,x)]
  set dy [expr [xth_me_can2realy [$xth(me,can) canvasy $y]] - $xth(me,cmds,$id,$pid,y)] 

  if {[string length $xth(me,cmds,$id,$pid,rotation)] == 0} {
    set xth(me,lptfd,rot) 0
  } else {
    set xth(me,lptfd,rot) 1
    set xth(me,lptfd,orot) [expr atan2($dy,$dx)]
  }

  if {[string length $xth(me,cmds,$id,$pid,[format "%ss" $side])] == 0} {
    set xth(me,lptfd,size) 0
  } else {
    set xth(me,lptfd,size) 1
    set xth(me,lptfd,osize) [expr hypot($dy,$dx)]
  }

  $xth(me,can) itemconfigure $tagOrId -fill #ffda00
  set xth(me,lptfd,benter) [$xth(me,can) bind $tagOrId <Enter>]
  set xth(me,lptfd,bleave) [$xth(me,can) bind $tagOrId <Leave>]
  $xth(me,can) bind $tagOrId <Enter> ""
  $xth(me,can) bind $tagOrId <Leave> ""
  $xth(me,can) bind $tagOrId <B1-Motion> "xth_me_cmds_linept_fdrag %x %y"
  $xth(me,can) bind $tagOrId <B1-ButtonRelease> "xth_me_cmds_end_linept_fdrag %x %y"
  xth_me_cmds_linept_fdrag $x $y
  $xth(me,can) configure -cursor {}
}

proc xth_me_cmds_linept_fdrag {x y} {
  global xth
  set id $xth(me,lptfd,id)
  set pid $xth(me,lptfd,pid)
  set side $xth(me,lptfd,side)

  set dx [expr [xth_me_can2realx [$xth(me,can) canvasx $x]] - $xth(me,cmds,$id,$pid,x)]
  set dy [expr [xth_me_can2realy [$xth(me,can) canvasy $y]] - $xth(me,cmds,$id,$pid,y)]
  
  if $xth(me,lptfd,rot) {
    set rot [expr double($xth(me,cmds,$id,$pid,rotation)) - 180.0 / 3.14159265359 * (atan2($dy,$dx) - $xth(me,lptfd,orot))]
    if {$rot < 0.0} {
      set rot [expr 360.0 + $rot]
    } elseif {$rot >= 360.0} {
      set rot [expr $rot - 360.0]
    }
    set rot [format "%.1f" $rot]
    set xth(ctrl,me,linept,rot) $rot
  }
  
  if {$xth(me,lptfd,size)} {
    set cs [expr hypot($dy,$dx)]
    set ns [expr $xth(me,cmds,$id,$pid,[format "%ss" $side]) - $xth(me,lptfd,osize) + $cs]
    if {$ns <= 0.0} {set ns 0.1}
    set xth(ctrl,me,linept,[format "%ss" $side]) [format "%.1f" $ns]
  }

  xth_me_cmds_move_linept_size_xctrl $id $pid $xth(ctrl,me,linept,rot) $xth(ctrl,me,linept,rs) $xth(ctrl,me,linept,ls)
  xth_me_cmds_move_line_xctrl $id
}

proc xth_me_cmds_end_linept_fdrag {x y} {
  global xth

  xth_me_cmds_linept_fdrag $x $y

  set id $xth(me,lptfd,id)
  set pid $xth(me,lptfd,pid)
  set side $xth(me,lptfd,side)
  set tagOrId $xth(me,lptfd,tagOrId)

  $xth(me,can) configure -cursor crosshair
  if {$xth(me,lptfd,size)} {
    set xth(me,unredola) "line point resizing"
  } else {
    set xth(me,unredola) "line point rotation"
  }
  $xth(me,can) bind $tagOrId <B1-Motion> ""
  $xth(me,can) bind $tagOrId <B1-ButtonRelease> ""
  if {[lsearch [$xth(me,can) itemcget $tagOrId -tags] current] > -1} {
    $xth(me,can) itemconfigure $tagOrId -fill #ffda00
  }
  
  $xth(me,can) bind $tagOrId <Enter> $xth(me,lptfd,benter)
  $xth(me,can) bind $tagOrId <Leave> $xth(me,lptfd,bleave)
  xth_me_cmds_update {}
}


proc xth_me_cmds_set_colors {} {
  global xth
  # najde id zaciatku a konca sucasneho scrapu
  set xid [lsearch $xth(me,cmds,xlist) $xth(me,cmds,selid)]
  set llen [llength $xth(me,cmds,xlist)]
  set cid $xid
  
  set dcol #fff222
  set scol $xth(gui,me,pasivefill)
  if {$xth(me,cmds,$xth(me,cmds,selid),ct) == 4} {
    set col $dcol
    set ocol $scol
  } elseif {$xth(me,cmds,$xth(me,cmds,selid),ct) == 5} {
    set col $scol
    set ocol $dcol
  } else {
    set col $scol
    set ocol $scol
  }
  
  set xth(me,curscrap) {}
  set godown 1
  if {$cid < 0} {
    set cid [expr $xid + 1]
    set godown 0
  }
  while {(($cid >= 0) && ($cid < $llen)) || ($godown)} {
    set id [lindex $xth(me,cmds,xlist) $cid]
    switch $xth(me,cmds,$id,ct) {
      2 {
        $xth(me,can) itemconfigure pt$id -outline $col -fill $col
      }
      3 {
        $xth(me,can) itemconfigure lnpt$id -outline $col -fill $col
        $xth(me,can) itemconfigure lnln$id -fill $col
      }
      4 - 5 {
        if {(![string equal $col $dcol]) && ($xth(me,cmds,$id,ct) == 4)} {
          set xth(me,curscrap) $xth(me,cmds,$id,name)
	  if {[string equal $xth(me,cmds,$id,projection) extended]} {
	    set xth(me,snai) -1
	  } else {
	    set xth(me,snai) 1
          }
        }
        if {$cid != $xid} {
          set col $dcol
        }
      }
    }
    
    if {$godown} {
      incr cid -1      
      if {$cid < 0} {
        set cid [expr $xid + 1]
        set godown 0
        set col $ocol
      }
    } else {
      incr cid 1
    }
  }
  xth_app_title me
}


proc xth_me_cmds_show_current_area {} {

  global xth

  # najde id zaciatku a konca sucasneho scrapu
  set id $xth(me,cmds,selid)
  if {$xth(me,cmds,$id,ct) != 6} {
    return
  }

  set xid [expr [lsearch $xth(me,cmds,xlist) $id] + 1]
  set llen [llength $xth(me,cmds,xlist)]
  set cid $xid

  
  set godown 1
  if {$cid < 0} {
    set cid [expr $xid - 1]
    set godown 0
  }
  
  while {(($cid >= 0) && ($cid < $llen)) || ($godown)} {
    set oid [lindex $xth(me,cmds,xlist) $cid]
    switch $xth(me,cmds,$oid,ct) {
      3 {
        foreach lnid $xth(me,cmds,$id,llist) {
          if {[string equal $xth(me,cmds,$oid,name) $lnid]} {
            $xth(me,can) itemconfigure lnpt$oid -fill red
            $xth(me,can) itemconfigure lnln$oid -fill red
          }
        }
      }
      4 {
        return
      }
      5 {
        if {$cid != $xid} {
          set cid [expr $xid - 1]
          set godown 0
        }
      }
    }
    
    if {$godown} {
      incr cid -1      
      if {$cid < 0} {
        set cid [expr $xid - 1]
        set godown 0
      }
    } else {
      incr cid 1
    }
    
  }
}




proc xth_me_cmds_line_split {} {

  global xth
  
  xth_me_cmds_update {}
  
  set id $xth(me,cmds,selid)
  set pid $xth(me,cmds,selpid)  

  # najprv zisti ci mooze, ak nie tak exit
  if {$xth(me,cmds,$id,ct) != 3} {
    return
  }
  
  set px [lsearch -exact $xth(me,cmds,$id,xplist) $pid]
  set lpx [llength $xth(me,cmds,$id,xplist)]
  if {($px <= 0) || ($px >= ($lpx - 2))} {
    return
  }
  
  # vytvori dve nove ciary, close nastavene na false
  set xth(me,unredook) 0
  set ix [lsearch $xth(me,cmds,xlist) $id]
  
  set id1 [xth_me_cmds_create 3 {} {}]
  set xth(me,cmds,$id1,lpid) 0
  set xth(me,cmds,$id1,plist) {"end of line"}
  set xth(me,cmds,$id1,xplist) {0}
  set id2 [xth_me_cmds_create 3 {} {}]
  set xth(me,cmds,$id2,lpid) 0
  set xth(me,cmds,$id2,plist) {"end of line"}
  set xth(me,cmds,$id2,xplist) {0}
  
  set xth(me,cmds,$id1,type) $xth(me,cmds,$id,type)
  set xth(me,cmds,$id2,type) $xth(me,cmds,$id,type)
  set xth(me,cmds,$id1,name) {}
  set xth(me,cmds,$id2,name) {}
  set xth(me,cmds,$id1,reverse) $xth(me,cmds,$id,reverse)
  set xth(me,cmds,$id2,reverse) $xth(me,cmds,$id,reverse)
  set xth(me,cmds,$id1,close) 0
  set xth(me,cmds,$id2,close) 0
  set xth(me,cmds,$id1,options) $xth(me,cmds,$id,options)
  set xth(me,cmds,$id2,options) $xth(me,cmds,$id,options)

  xth_me_cmds_update_list $id1
  xth_me_cmds_update_list $id2
  
  # povklada body
  set ix1 0
  set ix2 0
  for {set cx 0} {$cx < ($lpx - 1)} {incr cx} {
    set opid [lindex $xth(me,cmds,$id,xplist) $cx]
    if {$cx <= $px} {
      #vlozi ho do prvej      
      xth_me_cmds_create_line_point $id1 $ix1 0 \
      $xth(me,cmds,$id,$opid,x) $xth(me,cmds,$id,$opid,y) \
      $xth(me,cmds,$id,$opid,xp) $xth(me,cmds,$id,$opid,yp) \
      $xth(me,cmds,$id,$opid,xn) $xth(me,cmds,$id,$opid,yn) \
      $xth(me,cmds,$id,$opid,smooth) $xth(me,cmds,$id,$opid,rotation) \
      $xth(me,cmds,$id,$opid,rs) $xth(me,cmds,$id,$opid,ls) \
      $xth(me,cmds,$id,$opid,options) 1.0
      incr ix1
    }
    if {$cx >= $px} {
      #vlozi ho do druhej
      xth_me_cmds_create_line_point $id2 $ix2 0 \
      $xth(me,cmds,$id,$opid,x) $xth(me,cmds,$id,$opid,y) \
      $xth(me,cmds,$id,$opid,xp) $xth(me,cmds,$id,$opid,yp) \
      $xth(me,cmds,$id,$opid,xn) $xth(me,cmds,$id,$opid,yn) \
      $xth(me,cmds,$id,$opid,smooth) $xth(me,cmds,$id,$opid,rotation) \
      $xth(me,cmds,$id,$opid,rs) $xth(me,cmds,$id,$opid,ls) \
      $xth(me,cmds,$id,$opid,options) 1.0
      incr ix2
    }
  }
  
  xth_me_cmds_update_line_data $id1
  xth_me_cmds_update_line_data $id2
  
  # zmaze originalnu
  set pid1 0
  set pid2 [lindex $xth(me,cmds,$id2,xplist) 0]
  xth_me_cmds_delete $id
  xth_me_cmds_select [list $id2 $pid2]

  set xth(me,unredook) 1
  
  # nastavi undo na zmazanie novych a undelete originalnej
  # a redo na undelete novych a zmazanie originalnej
  xth_me_unredo_action "split line" \
    "xth_me_cmds_delete $id1; xth_me_cmds_delete $id2; xth_me_cmds_undelete $id $pid $ix" \
    "xth_me_cmds_undelete $id1 $pid1 $ix; xth_me_cmds_undelete $id2 $pid2 $ix; xth_me_cmds_delete $id; xth_me_cmds_select {$id2 $pid2}"

}










proc xth_me_ss_next {} {
  global xth
  xth_me_cmds_update {}
  set cselid $xth(me,cmds,selid)
  set cselpid $xth(me,cmds,selpid)
  set eofvalid [expr $cselid == 0]
  xth_status_bar_push me
  xth_status_bar_status me "Searching ..."
  if {$cselid == 0} {
    set totalcnt [llength $xth(me,cmds,xlist)]
  } else {
    set totalcnt [expr [llength $xth(me,cmds,xlist)] - [lsearch -exact -integer $xth(me,cmds,xlist) $cselid] - 1]
  }
  set cnt 0
  xth_me_progbar_show $totalcnt
  while {($cselid != 0) || $eofvalid} {
    set eofvalid 0    
    # prejde na dalsi objekt
    if {$cselid == 0} {
      set cselid [lindex $xth(me,cmds,xlist) 0]
      if {$xth(me,cmds,$cselid,ct) == 3} {
        set cselpid [lindex $xth(me,cmds,$cselid,xplist) 0]
      } else {
        set cselpid 0
      }
      incr cnt
    } elseif {($xth(me,cmds,$cselid,ct) != 3) || ($cselpid == 0)} {
      set cselid [lindex $xth(me,cmds,xlist) \
          [expr [lsearch -exact -integer $xth(me,cmds,xlist) $cselid] + 1]]
      if {$xth(me,cmds,$cselid,ct) == 3} {
        set cselpid [lindex $xth(me,cmds,$cselid,xplist) 0]
      } else {
        set cselpid 0
      }
      incr cnt
    } else {
      set cselpid [lindex $xth(me,cmds,$cselid,xplist) \
          [expr [lsearch -exact -integer $xth(me,cmds,$cselid,xplist) $cselpid] + 1]]
    }
    xth_me_progbar_prog $cnt
    switch $xth(me,cmds,$cselid,ct) {
      0 {
        xth_me_cmds_select 0
        xth_me_progbar_hide
        xth_status_bar_pop me
        return
      }
      3 {
        if {$cselpid == 0} {
          if {[xth_me_ss_match $xth(me,cmds,$cselid,data_ln)]} {
            xth_me_cmds_select "$cselid 0"
            xth_me_progbar_hide
            xth_status_bar_pop me
            return
          }
        } else {
          if {[xth_me_ss_match [lindex $xth(me,cmds,$cselid,data_pt) \
              [lsearch -exact -integer $xth(me,cmds,$cselid,xplist) $cselpid]]]} {
            xth_me_cmds_select "$cselid $cselpid"
            xth_me_progbar_hide
            xth_status_bar_pop me
            return
          }
        }
      }
      default {
        if {[xth_me_ss_match $xth(me,cmds,$cselid,data)]} {
          xth_me_cmds_select $cselid
          xth_me_progbar_hide
          xth_status_bar_pop me
          return
        }
      }
    }
  }
  xth_me_progbar_hide
  xth_status_bar_pop me
}

proc xth_me_ss_first {} {
  global xth
  xth_me_cmds_update {}
  xth_me_cmds_select 0
  xth_me_ss_next
}


proc xth_me_ss_match {s} {
  global xth
  if $xth(ctrl,me,ss,regexp) {
    if $xth(ctrl,me,ss,cases) {
      return [regexp $xth(ctrl,me,ss,expr) $s]
    } else {
      return [regexp -nocase $xth(ctrl,me,ss,expr) $s]
    }
  } else {
    if $xth(ctrl,me,ss,cases) {
      if {[string first $xth(ctrl,me,ss,expr) $s] >= 0} {
        return 1
      } else {
        return 0
      }
    } else {
      if {[string first [string tolower $xth(ctrl,me,ss,expr)] [string tolower $s]] >= 0} {
        return 1
      } else {
        return 0
      }
    }
  }
}


proc xth_me_ss_show {} {
  global xth
  xth_me_cmds_update {}
  xth_me_cmds_set_colors
  set selcol red
  xth_status_bar_push me
  xth_status_bar_status me "Searching ..."
  xth_me_progbar_show [llength $xth(me,cmds,xlist)]
  set objcnt 0
  foreach id $xth(me,cmds,xlist) {
    incr objcnt
    xth_me_progbar_prog $objcnt
    switch $xth(me,cmds,$id,ct) {
      2 {
        if {[xth_me_ss_match $xth(me,cmds,$id,data)]} {
          # oznaci bod
          $xth(me,can) itemconfigure pt$id -fill $selcol
        }
      }
      3 {
        set pnm 0
        set trywhole 1
        foreach tx $xth(me,cmds,$id,data_pt) {
          if {[xth_me_ss_match $tx]} {
            set pid [lindex $xth(me,cmds,$id,xplist) $pnm]
            # oznaci bod na ciare
            set trywhole 0
            $xth(me,can) itemconfigure pt$id.$pid -fill $selcol
            set ppid [lindex $xth(me,cmds,$id,xplist) [expr $pnm + 1]]
            if {[string length $ppid] > 0} {
              $xth(me,can) itemconfigure ln$id.$ppid -fill $selcol
            }
          }
          incr pnm 1
        }
        if {$trywhole && [xth_me_ss_match $xth(me,cmds,$id,data_ln)]} {
          # oznaci ciaru
          $xth(me,can) itemconfigure lnln$id -fill $selcol
        }
      }
    }
  }
  xth_status_bar_pop me
  xth_me_progbar_hide
}


proc xth_me_goto_line {ln} {

  global xth
  if {!$xth(me,fopen)} {
    return
  }
  
  # najprv preskoci zaciatocne prikazy
  set cln [expr [llength $xth(me,imgs,xlist)] + 4]
  
  # potom poojde prikaz za prikazom az najde taky,
  # ktory lezi na danej, alebo je mensi ako dana
  # pozicia a nasledujuci prikaz je uz zase vacsi
  set previd [lindex $xth(me,cmds,xlist) 0]
  set prevln $cln
  foreach cid $xth(me,cmds,xlist) {
    if {$xth(me,cmds,$cid,ct) == 4} {
      incr cln 2
    }
    incr cln 1
    
    # skontrolujeme ci to nebol predchadzajuci
    if {$cln > $ln} {
      xth_me_cmds_select $previd
      return
    }    
    # resp. ci to nie je tento
    set prevln $cln
    incr cln [expr 1 + [regexp -all {\n} $xth(me,cmds,$cid,data)]]
    #puts "$prevln - $cln:\n$xth(me,cmds,$cid,data)"

    if {($ln >= $prevln) && ($ln < $cln)} {
      set posttry 0
      switch $xth(me,cmds,$cid,ct) {
        1 {
          xth_ctrl_scroll_to me text
          set posttry 1
        }
        2 {xth_ctrl_scroll_to me point}
        3 {xth_ctrl_scroll_to me line}
        4 {xth_ctrl_scroll_to me scrap}
        6 {xth_ctrl_scroll_to me area}
      }
      xth_me_cmds_select $cid
      if {($ln > $prevln) || $posttry} {
        # skusime sa trafit presnejsie
        switch $xth(me,cmds,$cid,ct) {
          1 {
            set txln [expr $ln - $prevln + 1]
            focus $xth(ctrl,me,text).txt
            $xth(ctrl,me,text).txt mark set insert $txln.0
            $xth(ctrl,me,text).txt tag remove sel 1.0 end
            $xth(ctrl,me,text).txt tag add sel $txln.0 "$txln.0 lineend"
          }
          3 {
            # skusime najst bod na ciare
            set txln [expr $ln - $prevln + 1]
            if {$txln > 1} {
              set tmpxpl $xth(me,cmds,$cid,xplist)
              #puts $tmpxpl
              set cxpl {}
              set cpix [lindex $tmpxpl]
              foreach pix [lrange $tmpxpl 0 [expr [llength $tmpxpl] - 2]] {
                lappend cxpl $pix
                catch {
                  set xth(me,cmds,$cid,xplist) "$cxpl 0"
                  xth_me_cmds_update_line_data $cid
                }
                set clnln [regexp -all {\n} $xth(me,cmds,$cid,data)]
                set xth(me,cmds,$cid,xplist) $tmpxpl
                #puts "$clnln -> $txln:\n$xth(me,cmds,$cid,data)"
                if {$clnln >= $txln} {
                  set cpix $pix
                  #puts $pix
                  break
                }
              }
              set xth(me,cmds,$cid,xplist) $tmpxpl
              xth_me_cmds_update_line_data $cid
              xth_me_cmds_select "$cid $pix"
              xth_ctrl_scroll_to me linept
            }
          }
        }
      }
      return
    }
    
    set previd $cid
    
  }
  
  xth_me_cmds_select [lindex $xth(me,cmds,xlist) 0]
  
}










xth_about_status "loading map editor ..."

set xth(me,dflt,scrap,scale) {}

proc xth_me_reset_defaults {} {
  global xth

  set xth(me,dflt,scrap,projection) {}
  set xth(me,dflt,scrap,options) {}

  set xth(me,dflt,point,type) {station}
  set xth(me,dflt,point,options) {}
  set xth(me,dflt,point,rotation) {}
  set xth(me,dflt,point,xsize) {}
  set xth(me,dflt,point,ysize) {}

  set xth(me,dflt,line,type) {wall}
  set xth(me,dflt,line,options) {}

  set xth(me,dflt,area,type) {water}
  set xth(me,dflt,area,options) {}
    
}

xth_me_reset_defaults

proc xth_me_bind_entry_focusin {wlist} {
  foreach w $wlist {
    bind $w <FocusIn> "$w selection range 0 end"
  }
}

proc xth_me_bind_entry_return {wlist retcmd} {
  foreach w $wlist {
    bind $w <Return> $retcmd
  }
}

proc xth_me_bind_entry_focus_return {wlist retcmd} {
  set llen [expr [llength $wlist] - 1]
  for {set i 0} {$i < $llen} {incr i} {
    bind [lindex $wlist $i] <Return> "focus [lindex $wlist [expr $i + 1]]"
  }
  bind [lindex $wlist end] <Return> "$retcmd\nfocus [lindex $wlist 0]"
}


proc xth_me_unredo_reset {} {
  global xth
  set xth(me,undolist) {}
  set xth(me,redolist) {}
  set xth(me,unredook) 1
  xth_me_unredo_update
}


proc xth_me_real2canx {x} {
  global xth
  return [expr 0.01 * $xth(me,zoom) * $x]
}

proc xth_me_real2cany {y} {
  global xth
  return [expr -0.01 * $xth(me,zoom) * $y]
}

proc xth_me_can2realx {x} {
  global xth
  return [expr 100.0 / $xth(me,zoom) * $x]
}

proc xth_me_can2realy {y} {
  global xth
  return [expr -100.0 / $xth(me,zoom) * $y]
}

proc xth_me_unredo_update {} {
  
  global xth
  
  if {[llength $xth(me,undolist)] > 0} {
    $xth(me,menu,edit) entryconfigure $xth(me,menu,edit,undo) \
      -label [format "Undo %s" [lindex [lindex $xth(me,undolist) 0] 0]] -state normal
  } else {
    $xth(me,menu,edit) entryconfigure $xth(me,menu,edit,undo) \
      -label "Undo" -state disabled
  }

  if {[llength $xth(me,redolist)] > 0} {
    $xth(me,menu,edit) entryconfigure $xth(me,menu,edit,redo) \
      -label [format "Redo %s" [lindex [lindex $xth(me,redolist) 0] 0]] -state normal
  } else {
    $xth(me,menu,edit) entryconfigure $xth(me,menu,edit,redo) \
      -label "Redo" -state disabled
  }

}


proc xth_me_unredo_undo {} {

  global xth
  xth_me_cmds_update {}
  if {[llength $xth(me,undolist)] > 0} {
    set acmd [lindex $xth(me,undolist) 0]
    set xth(me,undolist) [lreplace $xth(me,undolist) 0 0]
    set xth(me,redolist) [linsert $xth(me,redolist) 0 $acmd]
    set xth(me,unredook) 0
    set xth(me,unredoshift) 1
    eval [lindex $acmd 3]
    set xth(me,unredook) 1
    if {$xth(me,unredoshift)} {
      $xth(me,can) xview moveto [lindex $acmd 1]
      $xth(me,can) yview moveto [lindex $acmd 2]
      xth_me_images_rescandraw
    }
    set xth(me,fsave) 1
    xth_me_unredo_update
  }  
}


proc xth_me_get_center {} {
  global xth
  set x [winfo x $xth(me,can)]
  set y [winfo y $xth(me,can)]
  set w [winfo width $xth(me,can)]
  set h [winfo height $xth(me,can)]
  return [list [xth_me_can2realx [$xth(me,can) canvasx [expr $x + $w / 2]]] \
    [xth_me_can2realy [$xth(me,can) canvasy [expr $y + $h / 2]]]]
}


proc xth_me_center_to {crds} {
  global xth
  set x [xth_me_real2canx [lindex $crds 0]]
  set y [xth_me_real2cany [lindex $crds 1]]
  set sr [$xth(me,can) cget -scrollregion]
  set xw [$xth(me,can) xview]
  set yw [$xth(me,can) yview]
  # adjust x
  set wf [expr [lindex $xw 1] - [lindex $xw 0]]
  set hf [expr [lindex $yw 1] - [lindex $yw 0]]
  set tw [expr [lindex $sr 2] - [lindex $sr 0]]
  set th [expr [lindex $sr 3] - [lindex $sr 1]]
  if {double($wf) < 1.0} {
    set pp [expr double($x) - [lindex $sr 0] - \
      0.5 * $wf * $tw]
    if {$pp < 0} {
      set pf 0.0
    } else {
      set pf [expr double($pp) / $tw]
    }
    $xth(me,can) xview moveto $pf
  }
  # adjust y
  if {double($hf) < 1.0} {
    set pp [expr double($y) - [lindex $sr 1] - \
      0.5 * $hf * $th]
    if {$pp < 0} {
      set pf 0.0
    } else {
      set pf [expr double($pp) / $th]
    }
    $xth(me,can) yview moveto $pf
  }
  xth_me_images_rescandraw
}



proc xth_me_unredo_redo {} {

  global xth

  if {[llength $xth(me,redolist)] > 0} {
    set acmd [lindex $xth(me,redolist) 0]
    set xth(me,redolist) [lreplace $xth(me,redolist) 0 0]
    set xth(me,undolist) [linsert $xth(me,undolist) 0 $acmd]
    $xth(me,can) xview moveto [lindex $acmd 1]
    $xth(me,can) yview moveto [lindex $acmd 2]
    xth_me_images_rescandraw
    set xth(me,unredook) 0
    eval [lindex $acmd 4]
    set xth(me,unredook) 1
    set xth(me,fsave) 1
    xth_me_unredo_update
  }  
  
}


proc xth_me_unredo_action {txt undocmd redocmd} {
  
  global xth
  if {$xth(me,unredook)} {
    set xth(me,redolist) {}
    if {[string length $xth(me,unredola)] > 0} {
      set txt $xth(me,unredola)
      set xth(me,unredola) {}
    }
    set xth(me,undolist) [linsert $xth(me,undolist) 0 [list \
      $txt [lindex [$xth(me,can) xview] 0] [lindex [$xth(me,can) yview] 0] $undocmd $redocmd]]
    set xth(me,fsave) 1
    xth_me_unredo_update
  }
  
}


# create new file
proc xth_me_create_file {} {

  global xth
  
  # create file variables
  set xth(me,unredook) 0
  incr xth(me,fltid)
  set cfid $xth(me,fltid)
  #set xth(me,fname) [format "noname%02d.th2" $cfid]
  set xth(me,fname) [format "(new file)" $cfid]
  set xth(me,open_file) $xth(me,fname)
  set xth(me,fpath) $xth(gui,initdir)
  set xth(me,ffull) [file join $xth(gui,initdir) $xth(me,fname)]

  set xth(me,fnewf) 1
  set xth(me,fopen) 1
  set xth(me,fsave) 0
  set xth(me,mtime) 0

  set xth(me,nimgs) 0
  set xth(me,imgln) 0
  set xth(me,imgs,list) {}
  set xth(me,imgs,xlist) {}

  set xth(me,cmds,cmdln) 1
  set xth(me,cmds,list) {}
  set xth(me,cmds,xlist) {}
  set xth(me,cmds,action) {}
  set xth(me,cmds,selid) 0
  set xth(me,cmds,selpid) 0
  set xth(me,cmds,selx) 0
  set xth(me,cmds,mode) 0
  xth_me_cmds_create 0 0 0
  xth_me_cmds_update_buttons
  xth_me_cmds_set_mode 0
  xth_me_prev_cmd {}
  $xth(ctrl,me,cmds).cl.l selection set 0 0

  # enable all controls
  $xth(me,pbar) configure -state normal -text "0.0 : 0.0"
  
  $xth(ctrl,me,images).ic.insp configure -state normal
  $xth(ctrl,me,area).l configure -state normal
  $xth(ctrl,me,area).zl configure -state normal
  $xth(ctrl,me,area).zb configure -state normal
    
  $xth(me,menu,file) entryconfigure "New" -state disabled
  $xth(me,menu,file) entryconfigure "Open" -state disabled
  $xth(me,menu,file) entryconfigure "Open (no pics)" -state disabled
  $xth(me,menu,file) entryconfigure "Save" -state normal
  $xth(me,menu,file) entryconfigure "Save as" -state normal
  $xth(me,menu,file) entryconfigure "Auto save" -state normal
  $xth(me,menu,file) entryconfigure "Close" -state normal
  
  $xth(me,menu) entryconfigure "Edit" -state normal

  $xth(ctrl,me,area).xmin configure -state normal
  $xth(ctrl,me,area).ymin configure -state normal
  $xth(ctrl,me,area).xmax configure -state normal
  $xth(ctrl,me,area).ymax configure -state normal
  $xth(ctrl,me,area).mab configure -state normal
  $xth(ctrl,me,area).aab configure -state normal

  xth_me_image_select 0
  xth_me_cmds_set_action 2

  # create working area
  grid $xth(me,canf) -column 0 -row 0 -sticky news
  xth_me_area_adjust 0 0 1600 1200

  xth_app_title me  

  xth_ctrl_maximize me area
  xth_ctrl_maximize me images
  set xth(me,fsave) 0
  xth_me_unredo_reset
  xth_me_reset_defaults  

}


proc xth_me_prev_cmd {cmd} {
  global xth
  $xth(ctrl,me,prev).txt configure -state normal
  $xth(ctrl,me,prev).txt delete 1.0 end
  $xth(ctrl,me,prev).txt insert 1.0 $cmd
  $xth(ctrl,me,prev).txt configure -state disabled
  $xth(ctrl,me,prev).txt see 1.0
  update idletasks
}


proc xth_me_destroy_file {} {

  global xth
  if {$xth(me,fopen)} {
  
    xth_me_cmds_unselect {}

    set xth(me,unredook) 0
    set xth(me,open_file) ""
    set xth(me,curscrap) {}
    set xth(me,fnewf) 0
    set xth(me,fopen) 0
    xth_me_image_destroy_all
    set xth(me,fsave) 0

    set xth(me,zoom) 100
    set xth(me,zoomv) 100
    $xth(ctrl,me,area).zb configure -text [format "%d %%" 100]
    $xth(me,menu,edit) entryconfigure $xth(me,menu,edit,zoom) -label [format "Zoom %d %%" 100]
  
    # disable all controls
    $xth(me,pbar) configure -text "" -state disabled

    set xth(ctrl,me,images,posx) ""
    set xth(ctrl,me,images,posy) ""
    set xth(ctrl,me,images,vis) 0
    $xth(ctrl,me,images).ic.insp configure -state disabled
    $xth(ctrl,me,area).l configure -state disabled -text ""
    set xth(ctrl,me,area,xmin) ""
    set xth(ctrl,me,area,ymin) ""
    set xth(ctrl,me,area,xmax) ""
    set xth(ctrl,me,area,ymax) ""
    $xth(ctrl,me,area).zl configure -state disabled
    $xth(ctrl,me,area).zb configure -state disabled
    $xth(me,menu,file) entryconfigure "New" -state normal
    $xth(me,menu,file) entryconfigure "Open" -state normal
    $xth(me,menu,file) entryconfigure "Open (no pics)" -state normal
    $xth(me,menu,file) entryconfigure "Save" -state disabled
    $xth(me,menu,file) entryconfigure "Save as" -state disabled
    $xth(me,menu,file) entryconfigure "Auto save" -state disabled
    $xth(me,menu,file) entryconfigure "Close" -state disabled

    $xth(me,menu) entryconfigure "Edit" -state disabled

    $xth(ctrl,me,area).xmin configure -state disabled
    $xth(ctrl,me,area).ymin configure -state disabled
    $xth(ctrl,me,area).xmax configure -state disabled
    $xth(ctrl,me,area).ymax configure -state disabled
    $xth(ctrl,me,area).mab configure -state disabled
    $xth(ctrl,me,area).aab configure -state disabled
    xth_me_image_select 0
    focus $xth(gui,main)

    $xth(me,can) delete command
    xth_me_cmds_update_buttons
    xth_me_prev_cmd {}
    
    set xth(me,cmds,list) {}
    set xth(me,cmds,xlist) {}
    grid forget $xth(me,canf) 
    
    xth_ctrl_minimize me cmds
    xth_ctrl_minimize me prev
    xth_ctrl_minimize me ss
    xth_ctrl_minimize me point
    xth_ctrl_minimize me line
    xth_ctrl_minimize me linept
    xth_ctrl_minimize me ac
    xth_ctrl_minimize me scrap
    xth_ctrl_minimize me text
    xth_ctrl_minimize me area
    xth_ctrl_minimize me images
    
    xth_me_unredo_reset
    xth_app_title me
    
  }
}



proc xth_me_before_close_file {btns} {

  global xth
  xth_me_cmds_update {}
  if {$xth(me,fsave)} {    
    set wtd [MessageDlg $xth(gui,message) -parent $xth(gui,main) \
      -icon question -type $btns\
      -message "File $xth(me,ffull) is not saved. Save it now?" \
      -font $xth(gui,lfont)]
    switch $wtd {
      0 {
        if {[xth_me_save_file 0] == 0} {
          return 0
        }
      }
      1 {}
      default {return 0}
    }
  }
  return 1
}



# xth_me_read_file --
#
# return success
# {success name cmds lns}

proc xth_me_read_file {pth changebs} {

  global errorInfo xth
  
  set curenc utf-8
  set nm [file tail $pth]
  set encspc 0
  set flnn 0
  set success 1
  set lastln ""
  set lns {}
  set cmds {}
  if {[catch {set fid [open $pth r]}]} {
    set success 0
    set nm $errorInfo
    return [list $success $nm {} {}]
  }
  fconfigure $fid -encoding $curenc
  while {![eof $fid]} {
    gets $fid fln
    incr flnn
    if {[regexp {^\s*encoding\s+(\S+)\s*$} $fln encln enc]} {
      if {$encspc} {
        set success 0
        set nm "$pth \[$flnn\] -- multiple encoding commands in file"
        break
      }
      set encspc 1
      set rxp "\\s+($enc)\\s+"
      set validenc [regexp -nocase $rxp $xth(encodings) dum curenc]
      if {$validenc == 0} {
        set success 0
        set nm "$pth \[$flnn\] -- unknown encoding -- $enc"
        break
      }
      fconfigure $fid -encoding $curenc
      set lastln ""
    } elseif {[regexp {^\s*\#\#XTHERION\#\#\s+(\S.*)\s*$} $fln cmmdln cmmd]} {
      lappend cmds $cmmd
      set lastln ""
      if {[regexp {^\s*\#\#BEGIN\#\#\s*$} $cmmd]} {
        fconfigure $fid -encoding utf-8
      }
      if {[regexp {^\s*\#\#END\#\#\s*$} $cmmd]} {
        fconfigure $fid -encoding $curenc
      }
    } else {
      if {$changebs && [regexp {(.*)\\\s*$} $lastln dumln prevln]} {
        set fln "$prevln$fln"
        if {[llength $lns] > 1} {
          set lns [lrange $lns 0 [expr [llength $lns] - 2]]
        } else {
          set lns {}
        }
      }
      lappend lns $fln
      set lastln $fln
    }
  }
  close $fid
  return [list $success $nm $cmds $lns]
  
}  


# xth_me_write_file --
#
# return list containing
# {success name}

proc xth_me_write_file {pth} {

  global errorInfo xth

  set curenc utf-8
  set nm [file tail $pth]
  set success 1
  if {[catch {set fid [open $pth w]}]} {
    set success 0
    set nm $errorInfo
    return [list $success $nm]
  }
  fconfigure $fid -encoding utf-8 -translation {auto lf}
  puts $fid "encoding  utf-8"
  # now let's put special commands
  puts $fid "##XTHERION## xth_me_area_adjust $xth(me,area,xmin) $xth(me,area,ymin) $xth(me,area,xmax) $xth(me,area,ymax)"
  puts $fid "##XTHERION## xth_me_area_zoom_to $xth(me,zoom)"
  # images
  set xxlist {}
  foreach imgx $xth(me,imgs,xlist) {
    set xxlist [linsert $xxlist 0 $imgx]
  }
  foreach imgx $xxlist {
    set vsb $xth(me,imgs,$imgx,vsb)
    set gamma $xth(me,imgs,$imgx,gamma)
    if {$vsb < 0} {
      set vsb [expr $xth(me,imgs,$imgx,vsb) + 2]
    }
    puts $fid [format "##XTHERION## xth_me_image_insert %s %s %s 0 {}" \
      "{[expr [lindex $xth(me,imgs,$imgx,position) 0]] $vsb $gamma}" \
      [expr [lindex $xth(me,imgs,$imgx,position) 1]] \
      [list $xth(me,imgs,$imgx,name)]]
  }
  foreach id $xth(me,cmds,xlist) {
    if {$xth(me,cmds,$id,ct) == 4} {
      puts $fid "\n"
    }
    puts $fid "\n$xth(me,cmds,$id,data)"
  }
  close $fid
  return [list $success $nm]
}


proc xth_me_open_file {dialogid fname fline} {

  global xth

  if {$xth(me,fopen) != 0} {
    return 0
  }
  
  if {$dialogid} {
    set fname [tk_getOpenFile -filetypes $xth(app,me,filetypes) \
      -parent $xth(gui,main) \
      -initialdir $xth(gui,initdir) -defaultextension {.th2}]
  }
  
  if {[string length $fname] == 0} {
    return 0
  } else {
    set xth(gui,initdir) [file dirname $fname]
  }
  
  # now let's open file fname
  
  # read the file
  xth_status_bar_push me
  xth_status_bar_status me "Opening $fname ..."
  
  set fdata [xth_me_read_file $fname 1]
  if {[lindex $fdata 0] == 0} {
      MessageDlg $xth(gui,message) -parent $xth(gui,main) \
        -icon error -type ok \
        -message [lindex $fdata 1] \
        -font $xth(gui,lfont)
      xth_status_bar_pop me
      return 0
  }
  
  # show the file
  xth_me_create_file
  set xth(me,unredook) 0

  set xth(me,fname) [file tail $fname]
  set xth(me,open_file) [lindex $fdata 1]
  set xth(me,fpath) [file dirname $fname]
  set xth(me,ffull) $fname
  set xth(me,mtime) [file mtime $fname]
  
  foreach cmd [lindex $fdata 2] {
    catch {eval $cmd}
  }
  xth_me_cmds_create_all [lindex $fdata 3]
  
  xth_ctrl_maximize me cmds
  xth_ctrl_maximize me point
  xth_ctrl_maximize me line
  xth_ctrl_maximize me linept
  xth_ctrl_maximize me ac
  xth_ctrl_maximize me scrap
  xth_ctrl_maximize me text
  xth_ctrl_maximize me area
  xth_ctrl_maximize me images
  
  set xth(me,fnewf) 0
  set xth(me,fopen) 1
  set xth(me,fsave) 0
  xth_app_title me
  xth_status_bar_pop me
  xth_me_cmds_select 0
  xth_me_unredo_reset
  xth_me_reset_defaults
  return 1
}


proc xth_me_save_file {dialogid} {

  global xth
  if {$xth(me,fopen) == 0} {
    return 0
  }

  xth_me_cmds_update {}
  
  # let's check if we need to save
  if {!($xth(me,fnewf) || $xth(me,fsave) || $dialogid)} {
    return 1
  }
  
  xth_status_bar_push me
  
  if {$xth(me,fnewf)} {
    set dialogid 1
  }

  set fname $xth(me,ffull)
  set ofname $fname
  if {$dialogid} {
    set fname [tk_getSaveFile -filetypes $xth(app,me,filetypes) \
      -parent $xth(gui,main) \
      -initialfile [file tail $fname] -defaultextension {.th2} \
      -initialdir [file dirname $fname]]
  }
  
  if {[string length $fname] == 0} {
    return 0
  } else {
    set xth(gui,initdir) [file dirname $fname]
  }

  if {($xth(me,mtime) > 0) && [file exists $fname] && \
    ([file mtime $fname] > $xth(me,mtime))} {
    set forcesave [MessageDlg $xth(gui,message) -parent $xth(gui,main) \
      -icon warning -type yesno -default 1 \
      -message "File $fname was modified outside xtherion. Save it anyway?" \
      -font $xth(gui,lfont)]
    if {$forcesave != 0} {
      return 0
    }
  }
 
  # save the file
  xth_status_bar_status me "Saving $fname ..."
  set fdata [xth_me_write_file $fname]
  if {[lindex $fdata 0] == 0} {
      MessageDlg $xth(gui,message) -parent $xth(gui,main) \
        -icon error -type ok \
        -message [lindex $fdata 1] \
        -font $xth(gui,lfont)
      xth_status_bar_pop me
      return 0
  }
  
  set xth(me,mtime) [file mtime $fname]
  set xth(me,fnewf) 0
  set xth(me,fsave) 0
  
  # if SaveAs, then redisplay the file
  if {$dialogid} {
    if {[string compare $ofname $fname] != 0} {
      set xth(me,fname) [file tail $fname]
      set xth(me,ffull) $fname
      set xth(me,fpath) [file dirname $fname]
      set xth(me,open_file) $xth(me,fname)
      xth_app_title me
    }
  }  

  after 250 {xth_status_bar_pop me}
  return 1
    
}



proc xth_me_close_file {} {

  global xth

  if {$xth(me,fopen) == 0} {
    return
  }

  xth_me_cmds_update {}
  
  if {[xth_me_before_close_file yesnocancel]} {
    xth_me_destroy_file
    return 1
  } else {
    return 0
  }
  
}


proc xth_me_area_redraw {} {
  global xth
  set x1 [xth_me_real2canx $xth(me,area,xmin)]
  set x2 [xth_me_real2canx $xth(me,area,xmax)]
  set y1 [xth_me_real2cany $xth(me,area,ymin)]
  set y2 [xth_me_real2cany $xth(me,area,ymax)]
  $xth(me,can) coords $xth(me,canid,area) $x1 $y1 $x1 $y2 $x2 $y2 $x2 $y1  
}


proc xth_me_limitize {limits x y} {
  set xmin $x
  set xmax $x
  set ymin $y
  set ymax $y
  if {[llength $limits] == 4} {
    if {[lindex $limits 0] < $x} {
      set xmin [lindex $limits 0]
    }
    if {[lindex $limits 1] < $y} {
      set ymin [lindex $limits 1]
    }
    if {[lindex $limits 2] > $x} {
      set xmax [lindex $limits 2]
    }
    if {[lindex $limits 3] > $y} {
      set ymax [lindex $limits 3]
    }
  }
  return [list $xmin $ymin $xmax $ymax]
}


proc xth_me_area_auto_adjust {} {
  
  global xth 
  set limits {}
  
  # scan limits of pictures
  foreach imgx $xth(me,imgs,xlist) {
    set px [lindex $xth(me,imgs,$imgx,position) 0]
    set py [lindex $xth(me,imgs,$imgx,position) 1]
    set sx [image width $xth(me,imgs,$imgx,image)]
    set sy [image height $xth(me,imgs,$imgx,image)]
    set limits [xth_me_limitize $limits $px $py]
    set limits [xth_me_limitize $limits [expr $px + $sx] [expr $py - $sy]]
  }
  
  # scan limits of commands
  set cmdlim [$xth(me,can) bbox command]
  if {[llength $cmdlim] == 4} {
    set limits [xth_me_limitize $limits [xth_me_can2realx [lindex $cmdlim 0]] [xth_me_can2realy [lindex $cmdlim 1]]]
    set limits [xth_me_limitize $limits [xth_me_can2realx [lindex $cmdlim 2]] [xth_me_can2realy [lindex $cmdlim 3]]]
  }
  
  # adjust area limits
  if {[llength $limits] < 4} {
    set limits {128 128 128 128}
  }  
  xth_me_area_adjust [expr [lindex $limits 0] - 128] [expr [lindex $limits 1] - 128] \
    [expr [lindex $limits 2] + 128] [expr [lindex $limits 3] + 128]

}

proc xth_me_area_adjust {x1 y1 x2 y2} {
  
  global xth
  
  xth_me_unredo_action "adjusting area" \
    "xth_me_area_adjust $xth(me,area,xmin) $xth(me,area,ymin) $xth(me,area,xmax) $xth(me,area,ymax)" \
    "xth_me_area_adjust $x1 $y1 $x2 $y2"

  # let's assign zeros to non numbers
  if {[catch {expr $x1}]} {
    set x1 0.0
  }
  if {[catch {expr $x2}]} {
    set x2 0.0
  }
  if {[catch {expr $y1}]} {
    set y1 0.0
  }
  if {[catch {expr $y2}]} {
    set y2 0.0
  }
  if {($x2 - $x1) < 256} {
    set x2 [expr $x1 + 256]
  }
  if {($y2 - $y1) < 256} {
    set y2 [expr $y1 + 256]
  }
  
  set xth(me,area,xmin) $x1
  set xth(me,area,xmax) $x2
  set xth(me,area,ymin) $y1
  set xth(me,area,ymax) $y2

  set xth(ctrl,me,area,xmin) $x1
  set xth(ctrl,me,area,xmax) $x2
  set xth(ctrl,me,area,ymin) $y1
  set xth(ctrl,me,area,ymax) $y2

  xth_me_area_redraw
  xth_me_area_scroll_adjust
  
  catch {$xth(ctrl,me,area).l configure -text [format "%.0f:%.0f - %.0f:%.0f" $x1 $y1 $x2 $y2]}
  
}


proc xth_me_area_scroll {wdg fir las} {
  xth_scroll $wdg $fir $las
  xth_me_area_scroll_adjust
}


proc xth_me_area_scroll_adjust {} {
  
  global xth
  set scw [winfo width $xth(me,canf)]
  set sch [winfo height $xth(me,canf)]
  set axmax [xth_me_real2canx $xth(me,area,xmax)]
  set axmin [xth_me_real2canx $xth(me,area,xmin)]
  set aymax [xth_me_real2cany $xth(me,area,ymin)]
  set aymin [xth_me_real2cany $xth(me,area,ymax)]
  set aw [expr $axmax - $axmin]
  set ah [expr $aymax - $aymin]
  if {$aw < ($scw - 3 * $xth(gui,sbwidth))} {
    set sx1 [expr $axmin - ($scw - $aw)/2.0 + $xth(gui,sbwidth)]
    set sx2 [expr $axmax + ($scw - $aw)/2.0 - $xth(gui,sbwidth)]
    # eval $xth(scroll,$xth(me,canf).sh,hide)
  } else {
    set sx1 [expr $axmin - $xth(gui,sbwidth)/2.0]
    set sx2 [expr $axmax + $xth(gui,sbwidth)/2.0]
  }
  if {$ah < ($sch - 3 * $xth(gui,sbwidth))} {
    set sy1 [expr $aymin - ($sch - $ah)/2.0 + $xth(gui,sbwidth)]
    set sy2 [expr $aymax + ($sch - $ah)/2.0 - $xth(gui,sbwidth)]
    # eval $xth(scroll,$xth(me,canf).sv,hide)
  } else {
    set sy1 [expr $aymin - $xth(gui,sbwidth)/2.0]
    set sy2 [expr $aymax + $xth(gui,sbwidth)/2.0]
  }
  
  set csr [$xth(me,can) cget -scrollregion]
  set nsr "$sx1 $sy1 $sx2 $sy2"
  if {[string compare $csr $nsr] != 0} {
    $xth(me,can) configure -scrollregion $nsr
  }
}


proc xth_me_area_zoom_to {zv} {
  global xth
  
  xth_me_cmds_update {}
  
  if {($xth(me,cmds,$xth(me,cmds,selid),ct) == 3) && 
      ($xth(me,cmds,selpid) > 0)} {
    set ccrds [list $xth(me,cmds,$xth(me,cmds,selid),$xth(me,cmds,selpid),x) \
      $xth(me,cmds,$xth(me,cmds,selid),$xth(me,cmds,selpid),y)]
  } elseif {$xth(me,cmds,$xth(me,cmds,selid),ct) == 2} {
    set ccrds [list $xth(me,cmds,$xth(me,cmds,selid),x) \
      $xth(me,cmds,$xth(me,cmds,selid),y)]
  } else {
    set ccrds [xth_me_get_center]
  }
  
  xth_me_unredo_action zooming "xth_me_area_zoom_to $xth(me,zoom)" \
    "xth_me_area_zoom_to $zv"
    
  set xth(me,zoom) $zv
  set xth(me,zoomv) $zv
  $xth(ctrl,me,area).zb configure -text [format "%d %%" $zv]
  $xth(me,menu,edit) entryconfigure $xth(me,menu,edit,zoom) -label [format "Zoom %d %%" $zv]
  
  xth_me_area_redraw   
  xth_me_area_scroll_adjust
  
  foreach imgx $xth(me,imgs,xlist) {
    xth_me_image_rescan $imgx
    xth_me_image_redraw $imgx
  }
  
  xth_status_bar_push me
  xth_status_bar_status me "Zooming objects ..."
  set ncmds [llength $xth(me,cmds,xlist)]
  xth_me_progbar_show $ncmds
  set ccmd 0
  foreach id $xth(me,cmds,xlist) {
    incr ccmd
    xth_me_progbar_prog $ccmd
    switch $xth(me,cmds,$id,ct) {
      4 {
        if {$id == $xth(me,cmds,selid)} {
          xth_me_cmds_move_scrap_xctrl 1 [lindex $xth(me,cmds,$id,scale) 0] \
            [lindex $xth(me,cmds,$id,scale) 1] 
          xth_me_cmds_move_scrap_xctrl 2 [lindex $xth(me,cmds,$id,scale) 2] \
            [lindex $xth(me,cmds,$id,scale) 3]
        }
      }
      3 {
        xth_me_cmds_move_line $id
        if {$id == $xth(me,cmds,selid)} {
          xth_me_cmds_show_line_xctrl $id
          set pid $xth(me,cmds,selpid)
          if {$pid != 0} {
            xth_me_cmds_show_linept_xctrl $id $pid
          }
        }
      }
      2 {
        $xth(me,can) coords pt$id [xth_me_cmds_calc_point_coords $id]
        if {$id == $xth(me,cmds,selid)} {
          xth_me_cmds_move_point_xctrl $id
          xth_me_cmds_move_point_fill_xctrl $id $xth(me,cmds,$id,rotation) $xth(me,cmds,$id,xsize) $xth(me,cmds,$id,ysize)
        }
      }
    }
  }
  
  xth_me_center_to $ccrds
  set xth(me,unredoshift) 0
  xth_me_progbar_hide
  xth_status_bar_pop me
  update idletasks
  
}

proc xth_me_image_choose {imgx} {
  global xth
  xth_me_image_select [lsearch $xth(me,imgs,xlist) $imgx]
}

proc xth_me_area_start_drag {tagOrId imgx x y} {
  global xth
  set hss [$xth(me,canf).sh get]
  set vss [$xth(me,canf).sv get]
  set srg [$xth(me,can) cget -scrollregion]
  set w [expr [lindex $srg 2] - [lindex $srg 0]]
  set h [expr [lindex $srg 3] - [lindex $srg 1]]
  set fx [expr (1 - [lindex $hss 1] + [lindex $hss 0]) * $w]
  set fy [expr (1 - [lindex $vss 1] + [lindex $vss 0]) * $h]     
  if {$fx > 0} {set fx [expr (1 - [lindex $hss 1] + [lindex $hss 0]) / $fx]}
  if {$fy > 0} {set fy [expr (1 - [lindex $vss 1] + [lindex $vss 0]) / $fy]}
  set xth(me,area,drag_fx) $fx
  set xth(me,area,drag_fy) $fy
  set xth(me,area,drag_ox) [lindex $hss 0]
  set xth(me,area,drag_oy) [lindex $vss 0]
  set xth(me,area,drag_mx) $x
  set xth(me,area,drag_my) $y
  $xth(me,can) configure -cursor plus
  $xth(me,can) bind $tagOrId <Shift-B1-Motion> "xth_me_area_drag %x %y"
  $xth(me,can) bind $tagOrId <Shift-B1-ButtonRelease> "xth_me_area_end_drag $tagOrId \"$imgx\" %x %y"
  $xth(me,can) bind $tagOrId <B3-Motion> "xth_me_area_drag %x %y"
  $xth(me,can) bind $tagOrId <B3-ButtonRelease> "xth_me_area_end_drag $tagOrId \"$imgx\" %x %y"
  update idletasks
}

proc xth_me_area_drag {x y} {
  global xth
  set xdelta [expr ($xth(me,area,drag_mx) - $x) * $xth(me,area,drag_fx)]
  set ydelta [expr ($xth(me,area,drag_my) - $y) * $xth(me,area,drag_fy)]
  $xth(me,can) xview moveto [expr $xth(me,area,drag_ox) + $xdelta]
  $xth(me,can) yview moveto [expr $xth(me,area,drag_oy) + $ydelta]
  update idletasks     
}


proc xth_me_area_end_drag {tagOrId imgx x y} {
  global xth
  xth_me_area_drag $x $y
  $xth(me,can) configure -cursor crosshair
  $xth(me,can) bind $tagOrId <Shift-B1-Motion> ""
  $xth(me,can) bind $tagOrId <Shift-B1-ButtonRelease> ""
  $xth(me,can) bind $tagOrId <B3-Motion> ""
  $xth(me,can) bind $tagOrId <B3-ButtonRelease> ""
  if {[string length $imgx] > 0} {
    xth_me_image_choose $imgx
  }
  xth_me_images_rescandraw
  update idletasks 
}


proc xth_me_area_motion {x y} {
  global xth
  $xth(me,pbar) configure -text [format "%.1f : %.1f" [xth_me_can2realx [$xth(me,can) canvasx $x]] [xth_me_can2realy [$xth(me,can) canvasy $y]]]
}


proc xth_me_bind_area_drag {tagOrId imgx} {
  global xth
  $xth(me,can) bind $tagOrId <1> "xth_me_cmds_click_area $tagOrId %x %y"
  $xth(me,can) bind $tagOrId <Motion> "xth_me_area_motion %x %y"
  $xth(me,can) bind $tagOrId <Shift-1> "xth_me_area_start_drag $tagOrId \"$imgx\" %x %y"
  $xth(me,can) bind $tagOrId <3> "xth_me_area_start_drag $tagOrId \"$imgx\" %x %y"
}

proc xth_me_bind_area_only_drag {tagOrId} {
  global xth
  $xth(me,can) bind $tagOrId <Shift-1> "xth_me_area_start_drag $tagOrId {} %x %y"
  $xth(me,can) bind $tagOrId <3> "xth_me_area_start_drag $tagOrId {} %x %y"
}




proc xth_me_image_start_drag {tagOrId imgx x y} {
  global xth
  set xth(me,imgs,drag_mx) $x
  set xth(me,imgs,drag_my) $y
  set xth(me,imgs,drag_px) [lindex $xth(me,imgs,$imgx,position) 0]
  set xth(me,imgs,drag_py) [lindex $xth(me,imgs,$imgx,position) 1]
  $xth(me,can) configure -cursor fleur
  $xth(me,can) bind $tagOrId <Shift-B1-Motion> "xth_me_image_drag $imgx %x %y"
  $xth(me,can) bind $tagOrId <Shift-B1-ButtonRelease> "xth_me_image_end_drag $tagOrId $imgx %x %y"
  $xth(me,can) bind $tagOrId <B3-Motion> "xth_me_image_drag $imgx %x %y"
  $xth(me,can) bind $tagOrId <B3-ButtonRelease> "xth_me_image_end_drag $tagOrId $imgx %x %y"
  update idletasks
}

proc xth_me_image_drag {imgx x y} {
  global xth
  set xth(me,imgs,$imgx,position) [list \
    [expr $xth(me,imgs,drag_px) - [expr double($xth(me,imgs,drag_mx) - $x) * 100.0 / $xth(me,zoom)]] \
    [expr $xth(me,imgs,drag_py) + [expr double($xth(me,imgs,drag_my) - $y) * 100.0 / $xth(me,zoom)]] \
  ]
  xth_me_image_redraw $imgx
}

proc xth_me_image_end_drag {tagOrId imgx x y} {
  global xth
  xth_me_image_drag $imgx $x $y
  $xth(me,can) configure -cursor crosshair
  $xth(me,can) bind $tagOrId <Shift-B1-Motion> ""
  $xth(me,can) bind $tagOrId <Shift-B1-ButtonRelease> ""
  $xth(me,can) bind $tagOrId <B3-Motion> ""
  $xth(me,can) bind $tagOrId <B3-ButtonRelease> ""
  xth_me_image_choose $imgx
  xth_me_unredo_action "dragging image" \
    "xth_me_image_move $imgx $xth(me,imgs,drag_px) $xth(me,imgs,drag_py)" \
    "xth_me_image_move $imgx $xth(me,imgs,$imgx,position)"
  update idletasks 
}


proc xth_me_bind_image_drag {tagOrId imgx} {
  global xth
  $xth(me,can) bind $tagOrId <Double-Shift-1> "xth_me_image_start_drag $tagOrId $imgx %x %y"
  $xth(me,can) bind $tagOrId <Double-3> "xth_me_image_start_drag $tagOrId $imgx %x %y"
}


xth_app_create me "Map Editor" 

xth_ctrl_add me cmds "File commands"
xth_ctrl_add me ss "Search & Select"
xth_ctrl_add me prev "Command preview"
xth_ctrl_add me point "Point control"
xth_ctrl_add me line "Line control"
xth_ctrl_add me linept "Line point control"
xth_ctrl_add me ac "Area control"
xth_ctrl_add me scrap "Scrap control"
xth_ctrl_add me text "Text editor"
xth_ctrl_add me area "Drawing area"
xth_ctrl_add me images "Background images"
xth_ctrl_finish me

# global variables initialization
set xth(me,ffull) {}
set xth(me,fltid) 0
set xth(me,fnewf) 0
set xth(me,fopen) 0
set xth(me,fsave) 0
set xth(me,zoom) 100
set xth(me,zoomv) 100
set xth(me,area,xmin) 0
set xth(me,area,xmax) 1600
set xth(me,area,ymin) 0
set xth(me,area,ymax) 1200
set xth(me,undolist) {}
set xth(me,redolist) {}
set xth(me,unredook) 0
set xth(me,unredola) {}
set xth(me,curscrap) {}
set xth(me,snai) 1

set xth(ctrl,me,images,posx) ""
set xth(ctrl,me,images,posy) ""
set xth(ctrl,me,images,vis) 0
set xth(ctrl,me,images,gamma) 0.0
set xth(ctrl,me,area,xmin) ""
set xth(ctrl,me,area,xmax) ""
set xth(ctrl,me,area,ymin) ""
set xth(ctrl,me,area,ymax) ""

set xth(ctrl,me,cmds,moveto) ""

set xth(ctrl,me,scrap,name) ""
set xth(ctrl,me,scrap,projection) ""
set xth(ctrl,me,scrap,options) ""
set xth(ctrl,me,scrap,px1) ""
set xth(ctrl,me,scrap,py1) ""
set xth(ctrl,me,scrap,px2) ""
set xth(ctrl,me,scrap,py2) ""
set xth(ctrl,me,scrap,rx1) ""
set xth(ctrl,me,scrap,ry1) ""
set xth(ctrl,me,scrap,rx2) ""
set xth(ctrl,me,scrap,ry2) ""
set xth(ctrl,me,scrap,units) ""
set xth(ctrl,me,scrap,pp1) {}
set xth(ctrl,me,scrap,pp2) {}

set xth(ctrl,me,point,x) {}
set xth(ctrl,me,point,y) {}
set xth(ctrl,me,point,type) {}
set xth(ctrl,me,point,name) {}
set xth(ctrl,me,point,opts) {}
set xth(ctrl,me,point,rot) {}
set xth(ctrl,me,point,xs) {}
set xth(ctrl,me,point,ys) {}
set xth(ctrl,me,point,rotid) 0
set xth(ctrl,me,point,xsid) 0
set xth(ctrl,me,point,ysid) 0

set xth(ctrl,me,line,type) {}
set xth(ctrl,me,line,name) {}
set xth(ctrl,me,line,opts) {}
set xth(ctrl,me,line,reverse) 0
set xth(ctrl,me,line,close) 0
set xth(ctrl,me,line,empty) {}
set xth(ctrl,me,linept,x) {}
set xth(ctrl,me,linept,y) {}
set xth(ctrl,me,linept,xp) {}
set xth(ctrl,me,linept,yp) {}
set xth(ctrl,me,linept,xn) {}
set xth(ctrl,me,linept,yn) {}
set xth(ctrl,me,linept,idp) 0
set xth(ctrl,me,linept,idn) 0
set xth(ctrl,me,linept,smooth) 0
set xth(ctrl,me,linept,rot) {}
set xth(ctrl,me,linept,rs) {}
set xth(ctrl,me,linept,ls) {}
set xth(ctrl,me,linept,rotid) 0
set xth(ctrl,me,linept,rsid) 0
set xth(ctrl,me,linept,lsid) 0

set xth(ctrl,me,ac,type) {}
set xth(ctrl,me,ac,opts) {}
set xth(ctrl,me,ac,empty) {}


set xth(ctrl,me,ss,expr) "station"
set xth(ctrl,me,ss,regexp) 0
set xth(ctrl,me,ss,cases) 0

# initialize drawing area

xth_about_status "loading area module ..."

$xth(gui,me).af.apps configure -bg black
set canfm $xth(gui,me).af.apps.cf 
set xth(me,canf) $canfm
grid columnconf $xth(gui,me).af.apps 0 -weight 1
grid rowconf $xth(gui,me).af.apps 0 -weight 1
frame $canfm
set xth(me,can) $canfm.c
scrollbar $canfm.sv -orient vertical -command "$xth(me,can) yview" \
  -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)  
bind $canfm.sv <ButtonRelease> xth_me_images_rescandraw
scrollbar $canfm.sh -orient horizontal -command "$xth(me,can) xview" \
  -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
bind $canfm.sh <ButtonRelease> xth_me_images_rescandraw
canvas $xth(me,can) -relief flat -borderwidth 0 -bg black \
	-xscrollcommand "xth_me_area_scroll $canfm.sh" \
	-yscrollcommand "xth_me_area_scroll $canfm.sv" \
	-cursor crosshair
bind $xth(me,can) <Configure> xth_me_images_rescandraw
  
set xth(me,canid,area) [$xth(me,can) create polygon 0 0 0 256 256 256 256 0 -fill LightYellow]
set xth(me,canid,scrap,scp1) [$xth(me,can) create rectangle 0 0 3 3 \
  -fill red -outline red -width 1 -state hidden -tags {cmd_ctrl}]
set xth(me,canid,scrap,scp2) [$xth(me,can) create rectangle 0 0 3 3 \
  -fill red -outline red -width 1 -state hidden -tags {cmd_ctrl}]

xth_me_bind_area_drag $xth(me,canid,area) {}
xth_me_area_adjust 0 0 1600 1200

set xth(me,canid,point,selector) [$xth(me,can) create oval 0 0 10 10 \
  -fill {} -outline red -width 1 -state hidden -tags {cmd_ctrl}]
set xth(me,canid,point,fill) [$xth(me,can) create polygon 0 0 10 0 10 10 0 10 \
  -fill red -stipple gray12 -state hidden -smooth on -tags {ptfill cmd_ctrl} -width 1]
set xth(me,canid,point,fx) [$xth(me,can) create line 0 0 10 10 \
  -width 5 -fill red -arrow last -arrowshape {9 12 4} \
  -state hidden -tags {ptfill cmd_ctrl}]
set xth(me,canid,point,fy) [$xth(me,can) create line 0 0 10 10 \
  -width 5 -fill red -arrow last -arrowshape {9 12 4} \
  -state hidden -tags {ptfill cmd_ctrl}]
#set xth(me,canid,point,fxc) [$xth(me,can) create oval 0 0 10 10 \
#  -outline red -fill red  -width 1 -state hidden -tags {ptfill cmd_ctrl}]
#set xth(me,canid,point,fyc) [$xth(me,can) create oval 0 0 10 10 \
#  -outline red -fill red  -width 1 -state hidden -tags {ptfill cmd_ctrl}]

xth_me_bind_area_drag $xth(me,canid,point,fill) {}
xth_me_bind_area_drag $xth(me,canid,point,selector) {}
xth_me_bind_area_only_drag $xth(me,canid,point,fx)
xth_me_bind_area_only_drag $xth(me,canid,point,fy)

set xth(me,canid,linept,selector) [$xth(me,can) create oval 0 0 10 10 \
  -fill {} -outline red -width 1 -state hidden -tags {linectrl cmd_ctrl}]
set xth(me,canid,linept,fr) [$xth(me,can) create line 0 0 10 10 \
  -width 5 -fill red -arrow last -arrowshape {9 12 4} \
  -state hidden -tags {linectrl cmd_ctrl}]
set xth(me,canid,linept,fl) [$xth(me,can) create line 0 0 10 10 \
  -width 5 -fill red -arrow last -arrowshape {9 12 4} \
  -state hidden -tags {linectrl cmd_ctrl}]

set xth(me,canid,linept,ppcpl) [$xth(me,can) create line 0 0 10 10 \
  -width $xth(gui,me,line,clwidth) -fill magenta -state hidden -tags "linectrl lineptppcp cmd_ctrl"]
set xth(me,canid,linept,nncpl) [$xth(me,can) create line 0 0 10 10 \
  -width $xth(gui,me,line,clwidth) -fill magenta -state hidden -tags "linectrl lineptnncp cmd_ctrl"]
set xth(me,canid,linept,ppcp) [$xth(me,can) create rectangle 0 0 10 10 \
  -width 1 -fill magenta -outline magenta -state hidden -tags "linectrl lineptppcp cmd_ctrl"]
set xth(me,canid,linept,nncp) [$xth(me,can) create rectangle 0 0 10 10 \
  -width 1 -fill magenta -outline magenta -state hidden -tags "linectrl lineptnncp cmd_ctrl"]

set xth(me,canid,linept,pcpl) [$xth(me,can) create line 0 0 10 10 \
  -width $xth(gui,me,line,clwidth) -fill $xth(gui,me,controlfill) -state hidden -tags "linectrl lineptpcp cmd_ctrl"]
set xth(me,canid,linept,ncpl) [$xth(me,can) create line 0 0 10 10 \
  -width $xth(gui,me,line,clwidth) -fill $xth(gui,me,controlfill) -state hidden -tags "linectrl lineptncp cmd_ctrl"]
set xth(me,canid,linept,pcp) [$xth(me,can) create rectangle 0 0 10 10 \
  -width 1 -fill red -outline $xth(gui,me,controlfill) -state hidden -tags "linectrl lineptpcp cmd_ctrl"]
set xth(me,canid,linept,ncp) [$xth(me,can) create rectangle 0 0 10 10 \
  -width 1 -fill red -outline $xth(gui,me,controlfill) -state hidden -tags "linectrl lineptncp cmd_ctrl"]

set xth(me,canid,line,tick) [$xth(me,can) create line 0 0 10 10 \
  -width $xth(gui,me,line,tickwidth) -fill #ffda00 -state hidden -tags "entirelinectrl cmd_ctrl"]

  
xth_me_bind_area_only_drag $xth(me,canid,linept,fr)
xth_me_bind_area_only_drag $xth(me,canid,linept,fl)
xth_me_bind_area_drag $xth(me,canid,linept,pcpl) {}
xth_me_bind_area_drag $xth(me,canid,linept,ncpl) {}
xth_me_bind_area_drag $xth(me,canid,linept,ppcpl) {}
xth_me_bind_area_drag $xth(me,canid,linept,nncpl) {}
xth_me_bind_area_drag $xth(me,canid,linept,selector) {}
xth_me_bind_area_drag $xth(me,canid,line,tick) {}

grid columnconf $canfm 0 -weight 1
grid rowconf $canfm 0 -weight 1
grid $xth(me,can) -column 0 -row 0 -sticky news
xth_scroll_showcmd $canfm.sv "grid $canfm.sv -column 1 -row 0 -sticky news"
xth_scroll_hidecmd $canfm.sv "grid forget $canfm.sv"
xth_scroll_showcmd $canfm.sh "grid $canfm.sh -column 0 -row 1 -sticky news"
xth_scroll_hidecmd $canfm.sh "grid forget $canfm.sh"


Label $xth(ctrl,me,area).l -text "" -anchor center -font $xth(gui,lfont) -state disabled
xth_status_bar me $xth(ctrl,me,area).l "Current drawing area."
Entry $xth(ctrl,me,area).xmin -font $xth(gui,lfont) -state disabled -width 4 -textvariable xth(ctrl,me,area,xmin)
xth_status_bar me $xth(ctrl,me,area).xmin "X min."
Entry $xth(ctrl,me,area).ymin -font $xth(gui,lfont) -state disabled -width 4 -textvariable xth(ctrl,me,area,ymin)
xth_status_bar me $xth(ctrl,me,area).ymin "Y min."
Entry $xth(ctrl,me,area).xmax -font $xth(gui,lfont) -state disabled -width 4 -textvariable xth(ctrl,me,area,xmax)
xth_status_bar me $xth(ctrl,me,area).xmax "X max."
Entry $xth(ctrl,me,area).ymax -font $xth(gui,lfont) -state disabled -width 4 -textvariable xth(ctrl,me,area,ymax)
xth_status_bar me $xth(ctrl,me,area).ymax "Y max."
Button $xth(ctrl,me,area).mab -text "Adjust" -anchor center -font $xth(gui,lfont) -state disabled -width 12 \
  -command {
    xth_me_area_adjust $xth(ctrl,me,area,xmin) $xth(ctrl,me,area,ymin) \
      $xth(ctrl,me,area,xmax) $xth(ctrl,me,area,ymax) 
  }
xth_status_bar me $xth(ctrl,me,area).mab "Adjust drawing area to given limits."
Button $xth(ctrl,me,area).aab -text "Auto adjust" -anchor center -font $xth(gui,lfont) -state disabled -width 12 \
  -command xth_me_area_auto_adjust
xth_status_bar me $xth(ctrl,me,area).aab "Adjust drawing area to automatically calculated limits."
Label $xth(ctrl,me,area).zl -text "zoom" -anchor e -font $xth(gui,lfont) -state disabled
menubutton $xth(ctrl,me,area).zb -text "100 %" -anchor center -font $xth(gui,lfont) \
  -indicatoron true -menu $xth(ctrl,me,area).zb.m -state disabled
menu $xth(ctrl,me,area).zb.m -tearoff 0 -font $xth(gui,lfont)
$xth(ctrl,me,area).zb.m add radiobutton -label "25 %" -variable xth(me,zoomv) -value 25 -command "xth_me_area_zoom_to 25"
$xth(ctrl,me,area).zb.m add radiobutton -label "50 %" -variable xth(me,zoomv) -value 50 -command "xth_me_area_zoom_to 50"
$xth(ctrl,me,area).zb.m add radiobutton -label "100 %" -variable xth(me,zoomv) -value 100 -command "xth_me_area_zoom_to 100"
$xth(ctrl,me,area).zb.m add radiobutton -label "200 %" -variable xth(me,zoomv) -value 200 -command "xth_me_area_zoom_to 200"
$xth(ctrl,me,area).zb.m add radiobutton -label "400 %" -variable xth(me,zoomv) -value 400 -command "xth_me_area_zoom_to 400"
xth_status_bar me $xth(ctrl,me,area).zb "Zoom drawing area."
xth_status_bar me $xth(ctrl,me,area).zl "Zoom drawing area."

xth_me_bind_entry_focus_return "$xth(ctrl,me,area).xmin $xth(ctrl,me,area).ymin $xth(ctrl,me,area).xmax $xth(ctrl,me,area).ymax" {
    xth_me_area_adjust $xth(ctrl,me,area,xmin) $xth(ctrl,me,area,ymin) \
      $xth(ctrl,me,area,xmax) $xth(ctrl,me,area,ymax) 
}
xth_me_bind_entry_focusin "$xth(ctrl,me,area).xmin $xth(ctrl,me,area).ymin $xth(ctrl,me,area).xmax $xth(ctrl,me,area).ymax"


grid columnconf $xth(ctrl,me,area) 0 -weight 1
grid columnconf $xth(ctrl,me,area) 1 -weight 1
grid columnconf $xth(ctrl,me,area) 2 -weight 1
grid columnconf $xth(ctrl,me,area) 3 -weight 1
grid $xth(ctrl,me,area).l -column 0 -row 0 -columnspan 4 -sticky news
grid $xth(ctrl,me,area).xmin -column 0 -row 1 -sticky news -padx 1
grid $xth(ctrl,me,area).ymin -column 1 -row 1 -sticky news -padx 1
grid $xth(ctrl,me,area).xmax -column 2 -row 1 -sticky news -padx 1
grid $xth(ctrl,me,area).ymax -column 3 -row 1 -sticky news -padx 1
grid $xth(ctrl,me,area).mab -column 0 -row 2 -columnspan 2 -sticky news
grid $xth(ctrl,me,area).aab -column 2 -row 2 -columnspan 2 -sticky news
grid $xth(ctrl,me,area).zl -column 0 -row 3 -columnspan 2 -sticky news
grid $xth(ctrl,me,area).zb -column 2 -row 3 -columnspan 2 -sticky news


xth_about_status "loading commands module ..."

# initialize file commands
set clbox $xth(ctrl,me,cmds).cl
set ccbox $xth(ctrl,me,cmds).cc
frame $clbox
frame $ccbox
listbox $clbox.l -height 8 -selectmode single -takefocus 0 \
  -yscrollcommand "xth_scroll $clbox.sv" \
  -xscrollcommand "xth_scroll $clbox.sh" \
  -font $xth(gui,lfont) -exportselection no \
  -listvariable xth(me,cmds,list) -selectborderwidth 0
scrollbar $clbox.sv -orient vert  -command "$clbox.l yview" \
  -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
scrollbar $clbox.sh -orient horiz  -command "$clbox.l xview" \
  -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
bind $clbox.l <<ListboxSelect>> {xth_me_cmds_select {}}
bind $clbox.l <B1-ButtonRelease> "focus $clbox.l"

grid columnconf $clbox 0 -weight 1
grid rowconf $clbox 0 -weight 1
grid $clbox.l -column 0 -row 0 -sticky news
xth_scroll_showcmd $clbox.sv "grid $clbox.sv -column 1 -row 0 -sticky news"
xth_scroll_hidecmd $clbox.sv "grid forget $clbox.sv"
xth_scroll_showcmd $clbox.sh "grid $clbox.sh -column 0 -row 1 -sticky news"
xth_scroll_hidecmd $clbox.sh "grid forget $clbox.sh"
xth_status_bar me $clbox "Select command."

grid columnconf $xth(ctrl,me,cmds) 0 -weight 1
grid $clbox -column 0 -row 0 -sticky news
grid $ccbox -column 0 -row 1 -sticky news

Button $ccbox.go -text "Insert scrap" -anchor center -font $xth(gui,lfont) \
  -state disabled -command xth_me_cmds_action
xth_status_bar me $ccbox.go "Action button."
Button $ccbox.sel -text "Select" -anchor center -font $xth(gui,lfont) \
  -state disabled -command {xth_me_cmds_set_mode 0}
xth_status_bar me $ccbox.sel "Switch mouse mode to select objects."
menubutton $ccbox.cfg -text "Action" -anchor center -font $xth(gui,lfont) \
  -indicatoron true -menu $ccbox.cfg.m -state disabled
xth_status_bar me $ccbox.cfg "Configure action assigned to action button."
menu $ccbox.cfg.m -tearoff 0 -font $xth(gui,lfont)
$ccbox.cfg.m add command -label "Insert point" -command {xth_me_cmds_set_action 1}
$ccbox.cfg.m add command -label "Insert line" -command {xth_me_cmds_set_action 0}
$ccbox.cfg.m add command -label "Insert area" -command {xth_me_cmds_set_action 5}
$ccbox.cfg.m add command -label "Insert scrap" -command {xth_me_cmds_set_action 2}
$ccbox.cfg.m add command -label "Insert text" -command {xth_me_cmds_set_action 3}
$ccbox.cfg.m add separator
$ccbox.cfg.m add command -label "Delete" -command {xth_me_cmds_set_action 4}
Button $ccbox.mu -text "Move up" -anchor center -font $xth(gui,lfont) \
  -state disabled -width 8 -command "xth_me_cmds_move_up {}"
xth_status_bar me $ccbox.mu "Move file command up in the list."
Button $ccbox.md -text "Move down" -anchor center -font $xth(gui,lfont) \
  -state disabled -width 8 -command "xth_me_cmds_move_down {}"
xth_status_bar me $ccbox.md "Move file command down in the list."
Button $ccbox.mt -text "Move to" -anchor center -font $xth(gui,lfont) \
  -state disabled -width 8 -command "xth_me_cmds_move_to {} {}"
xth_status_bar me $ccbox.mt "Move file command to given position."
ComboBox $ccbox.tt -postcommand xth_me_cmds_set_move_to_list \
  -modifycmd xth_me_cmds_set_move_to \
  -font $xth(gui,lfont) -height 4 -state disabled -width 8 \
  -textvariable xth(ctrl,me,cmds,moveto)
xth_status_bar me $ccbox.tt "Select destination scrap and position in it."
grid columnconf $ccbox 0 -weight 1
grid columnconf $ccbox 1 -weight 1
grid $ccbox.go -column 0 -row 0 -columnspan 2 -sticky news
grid $ccbox.cfg $ccbox.sel -row 1 -sticky news
grid $ccbox.mu $ccbox.md -row 2 -sticky news
grid $ccbox.mt $ccbox.tt -row 3 -sticky news

# initialize text editor
set txb $xth(ctrl,me,text)
text $txb.txt -height 6 -wrap none -font $xth(gui,efont) \
  -bg $xth(gui,ecolorbg) \
  -fg $xth(gui,ecolorfg) -insertbackground $xth(gui,ecolorfg) \
  -relief sunken -state disabled \
  -selectbackground $xth(gui,ecolorselbg) \
  -selectforeground $xth(gui,ecolorselfg) \
  -selectborderwidth 0 \
  -yscrollcommand "$txb.sv set" \
  -xscrollcommand "$txb.sh set" 
scrollbar $txb.sv -orient vert  -command "$txb.txt yview" \
  -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
scrollbar $txb.sh -orient horiz  -command "$txb.txt xview" \
  -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
Button $txb.upd -text "Update text" -anchor center -font $xth(gui,lfont) \
  -state disabled \
  -command {xth_me_cmds_update {}}
grid columnconf $txb 0 -weight 1
grid rowconf $txb 0 -weight 1
grid $txb.txt -column 0 -row 0 -sticky news
grid $txb.sv -column 1 -row 0 -sticky news
grid $txb.sh -column 0 -row 1 -sticky news
grid $txb.upd -column 0 -row 2 -columnspan 2 -sticky news
xth_status_bar me $txb.txt "Editor for free text in therion 2D file."
bind $txb.txt <$xth(kb_control)-Key-x> "tk_textCut $txb.txt"
bind $txb.txt <$xth(kb_control)-Key-c> "tk_textCopy $txb.txt"
bind $txb.txt <$xth(kb_control)-Key-v> "tk_textPaste $txb.txt"

if {$xth(gui,bindinsdel)} {
  bind $txb.txt <Shift-Key-Delete> "tk_textCut $txb.txt"
  bind $txb.txt <$xth(kb_control)-Key-Insert> "tk_textCopy $txb.txt"
  bind $txb.txt <Shift-Key-Insert> "tk_textPaste $txb.txt"
#  catch {
#    bind $txb.txt <Shift-Key-KP_Decimal> "tk_textCut $txb.txt"
#    bind $txb.txt <$xth(kb_control)-Key-KP_Insert> "tk_textCopy $txb.txt"
#    bind $txb.txt <Shift-Key-KP_0> "tk_textPaste $txb.txt"
#  }
}

if {[info exists xth(gui,te)]} {
  bind $txb.txt <$xth(kb_control)-Key-a> "xth_te_text_select_all %W"
  bind $txb.txt <$xth(kb_control)-Key-i> "xth_te_text_auto_indent %W"
  bind $txb.txt <Tab> $xth(te,bind,text_tab)
  bind $txb.txt <Return> $xth(te,bind,text_return)
} else {
  bind $txb.txt <Tab> $xth(gui,bind,text_tab)
  bind $txb.txt <Return> $xth(gui,bind,text_return)
}



# initialize search & select tool
set ssbx $xth(ctrl,me,ss)

Label $ssbx.xl -text expression -anchor e -font $xth(gui,lfont) -state disabled
xth_status_bar me $ssbx.xl "Enter search expression."
Entry $ssbx.xe -font $xth(gui,lfont) -state disabled \
  -textvariable xth(ctrl,me,ss,expr) -width 3
bind $ssbx.xe <Return> xth_me_ss_show
xth_status_bar me $ssbx.xe "Enter search expression."
checkbutton $ssbx.rx -text "regular expression" -anchor w -font $xth(gui,lfont) -state disabled \
  -variable xth(ctrl,me,ss,regexp) -command {}
xth_status_bar me $ssbx.rx "Search for regular expression."
checkbutton $ssbx.cs -text "case sensitive" -anchor w -font $xth(gui,lfont) -state disabled \
  -variable xth(ctrl,me,ss,cases) -command {}
xth_status_bar me $ssbx.cs "Case sensitive search."
Button $ssbx.sn -text "Find next" -anchor center -font $xth(gui,lfont) \
  -state disabled -command xth_me_ss_next -width 10
xth_status_bar me $ssbx.sn "Select next object matching expression."
Button $ssbx.sf -text "Find first" -anchor center -font $xth(gui,lfont) \
  -state disabled -command xth_me_ss_first -width 10
xth_status_bar me $ssbx.sf "Select first object matching expression."
Button $ssbx.sa -text "Show all" -anchor center -font $xth(gui,lfont) \
  -state disabled -command xth_me_ss_show -width 9
xth_status_bar me $ssbx.sa "Highlight all objects matching expression."
Button $ssbx.ca -text "Clear all" -anchor center -font $xth(gui,lfont) \
  -state disabled -command xth_me_cmds_set_colors -width 9
xth_status_bar me $ssbx.ca "Clear highlighted objects."

grid columnconf $ssbx 0 -weight 1
grid columnconf $ssbx 1 -weight 1
grid $ssbx.xl -column 0 -row 0 -sticky news
grid $ssbx.xe -column 1 -row 0 -sticky news
grid $ssbx.cs -column 0 -row 1 -sticky news -columnspan 2
grid $ssbx.rx -column 0 -row 2 -sticky news -columnspan 2
grid $ssbx.sf -column 0 -row 3 -sticky news
grid $ssbx.sn -column 1 -row 3 -sticky news
grid $ssbx.sa -column 0 -row 4 -sticky news
grid $ssbx.ca -column 1 -row 4 -sticky news


xth_about_status "loading images module ..."

# initialize images
frame $xth(ctrl,me,images).il
set ilbox $xth(ctrl,me,images).il.ilbox 
set xth(me,imgs,list) {}
listbox $ilbox -height 4 -selectmode single -takefocus 0 \
  -yscrollcommand "xth_scroll $xth(ctrl,me,images).il.sv" \
  -xscrollcommand "xth_scroll $xth(ctrl,me,images).il.sh" \
  -font $xth(gui,lfont) -exportselection no \
  -listvariable xth(me,imgs,list) -selectborderwidth 0
scrollbar $xth(ctrl,me,images).il.sv -orient vert  -command "$ilbox yview" \
  -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
scrollbar $xth(ctrl,me,images).il.sh -orient horiz  -command "$ilbox xview" \
  -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
frame $xth(ctrl,me,images).ic
bind $ilbox <<ListboxSelect>> "xth_me_image_select \[lindex \[%W curselection\] 0\]"

grid columnconf $xth(ctrl,me,images).il 0 -weight 1
grid rowconf $xth(ctrl,me,images).il 0 -weight 1
grid $ilbox -column 0 -row 0 -sticky news
xth_scroll_showcmd $xth(ctrl,me,images).il.sv "grid $xth(ctrl,me,images).il.sv -column 1 -row 0 -sticky news"
xth_scroll_hidecmd $xth(ctrl,me,images).il.sv "grid forget $xth(ctrl,me,images).il.sv"
xth_scroll_showcmd $xth(ctrl,me,images).il.sh "grid $xth(ctrl,me,images).il.sh -column 0 -row 1 -sticky news"
xth_scroll_hidecmd $xth(ctrl,me,images).il.sh "grid forget $xth(ctrl,me,images).il.sh"
xth_status_bar me $ilbox "Select background image."
grid columnconf $xth(ctrl,me,images) 0 -weight 1
grid $xth(ctrl,me,images).il -column 0 -row 0 -sticky news
grid $xth(ctrl,me,images).ic -column 0 -row 1 -sticky news

Button $xth(ctrl,me,images).ic.insp -text "Insert" -anchor center -font $xth(gui,lfont) \
  -state disabled -command {xth_me_image_insert $xth(ctrl,me,images,posx) $xth(ctrl,me,images,posy) {} 0 {}}
xth_status_bar me $xth(ctrl,me,images).ic.insp "Insert new background image."
Button $xth(ctrl,me,images).ic.remp -text "Remove" -anchor center -font $xth(gui,lfont) -state disabled \
  -command {xth_me_image_remove ""}
xth_status_bar me $xth(ctrl,me,images).ic.remp "Remove selected image."
Separator $xth(ctrl,me,images).ic.s1 -orient horizontal
checkbutton $xth(ctrl,me,images).ic.viscb -text "visibility" -anchor w -font $xth(gui,lfont) -state disabled \
  -variable xth(ctrl,me,images,vis) -command {xth_me_image_toggle_vsb ""}
xth_status_bar me $xth(ctrl,me,images).ic.viscb "Switch image visibility."

Label $xth(ctrl,me,images).ic.gl -text "gamma 1.00" -anchor w -font $xth(gui,lfont) -state disabled
xth_status_bar me $xth(ctrl,me,images).ic.gl "Control gamma value."
Button $xth(ctrl,me,images).ic.gr -text "Reset" -anchor center -font $xth(gui,lfont) \
  -state disabled -width 8 -command "set xth(ctrl,me,images,gamma) 0.0; xth_me_image_update_gamma"
xth_status_bar me $xth(ctrl,me,images).ic.gr "Reset image gamma value."
scale $xth(ctrl,me,images).ic.gs -from -1.0 -to 1.0 \
  -font $xth(gui,lfont) -state disabled -showvalue 0 -resolution 0.01 \
  -variable xth(ctrl,me,images,gamma) -orient horiz
bind $xth(ctrl,me,images).ic.gs <B1-ButtonRelease> xth_me_image_update_gamma
xth_status_bar me $xth(ctrl,me,images).ic.gs "Set image gamma value."


Label $xth(ctrl,me,images).ic.posl -text position -anchor e -font $xth(gui,lfont) -state disabled
xth_status_bar me $xth(ctrl,me,images).ic.posl "Current position of selected image."
Label $xth(ctrl,me,images).ic.posln -text "" -anchor center -font $xth(gui,lfont) -state disabled
xth_status_bar me $xth(ctrl,me,images).ic.posln "Current position of selected image."
Button $xth(ctrl,me,images).ic.posch -text "Move to" -anchor center -font $xth(gui,lfont) \
  -state disabled -width 8 -command "xth_me_image_move_to"
xth_status_bar me $xth(ctrl,me,images).ic.posch "Move image to given position."
Entry $xth(ctrl,me,images).ic.posx -font $xth(gui,lfont) -state disabled -width 4 \
  -textvariable xth(ctrl,me,images,posx)
xth_status_bar me $xth(ctrl,me,images).ic.posx "New X coordinate of image."
Entry $xth(ctrl,me,images).ic.posy -font $xth(gui,lfont) -state disabled -width 4 \
  -textvariable xth(ctrl,me,images,posy)
xth_status_bar me $xth(ctrl,me,images).ic.posy "New Y coordinate of image."
Button $xth(ctrl,me,images).ic.mvf -text "Move front" -anchor center -font $xth(gui,lfont) -state disabled -width 10 \
  -command xth_me_image_move_front
xth_status_bar me $xth(ctrl,me,images).ic.mvf "Move image in front of all images."
Button $xth(ctrl,me,images).ic.mvb -text "Move back" -anchor center -font $xth(gui,lfont) -state disabled -width 10 \
  -command xth_me_image_move_back
xth_status_bar me $xth(ctrl,me,images).ic.mvb "Move image behind all images."

xth_me_bind_entry_focus_return "$xth(ctrl,me,images).ic.posx $xth(ctrl,me,images).ic.posy" "xth_me_image_move_to"
xth_me_bind_entry_focusin "$xth(ctrl,me,images).ic.posx $xth(ctrl,me,images).ic.posy"

grid columnconf $xth(ctrl,me,images).ic 0 -weight 1
grid columnconf $xth(ctrl,me,images).ic 1 -weight 1
grid columnconf $xth(ctrl,me,images).ic 2 -weight 1
grid columnconf $xth(ctrl,me,images).ic 3 -weight 1
grid $xth(ctrl,me,images).ic.insp -column 0 -row 0 -sticky news -columnspan 2
grid $xth(ctrl,me,images).ic.remp -column 2 -row 0 -sticky news -columnspan 2
grid $xth(ctrl,me,images).ic.s1 -column 0 -row 1 -sticky news -columnspan 4 -pady 3
grid $xth(ctrl,me,images).ic.posl -column 0 -row 2 -sticky news -columnspan 2
grid $xth(ctrl,me,images).ic.posln -column 2 -row 2 -sticky news -columnspan 2 -padx 1
grid $xth(ctrl,me,images).ic.posch -column 0 -row 3 -sticky news -columnspan 2
grid $xth(ctrl,me,images).ic.posx -column 2 -row 3 -sticky ew -padx 1
grid $xth(ctrl,me,images).ic.posy -column 3 -row 3 -sticky ew -padx 1
grid $xth(ctrl,me,images).ic.mvf -column 0 -row 4 -sticky news -columnspan 2
grid $xth(ctrl,me,images).ic.mvb -column 2 -row 4 -sticky news -columnspan 2
grid $xth(ctrl,me,images).ic.gl -column 0 -row 5 -sticky news -columnspan 2
grid $xth(ctrl,me,images).ic.gr -column 2 -row 5 -sticky news -columnspan 2
grid $xth(ctrl,me,images).ic.gs -column 0 -row 6 -sticky news -columnspan 4
grid $xth(ctrl,me,images).ic.viscb -column 0 -row 7 -sticky news -columnspan 4
# xth_status_bar me $xth(ctrl,me,images). "To set file encoding, type encoding name and press <Change> button."


xth_about_status "loading preview module ..."

# init command preview
set txb $xth(ctrl,me,prev)
text $txb.txt -height 4 -wrap none -font $xth(gui,efont) \
  -bg $xth(gui,ecolorbg) \
  -fg $xth(gui,ecolorfg) -insertbackground $xth(gui,ecolorfg) \
  -relief sunken -state disabled \
  -selectbackground $xth(gui,ecolorselbg) \
  -selectforeground $xth(gui,ecolorselfg) \
  -selectborderwidth 0 \
  -yscrollcommand "$txb.sv set" \
  -xscrollcommand "$txb.sh set" 
scrollbar $txb.sv -orient vert  -command "$txb.txt yview" \
  -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
scrollbar $txb.sh -orient horiz  -command "$txb.txt xview" \
  -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
Button $txb.upd -text "Update command" -anchor center -font $xth(gui,lfont) \
  -state disabled -command {xth_me_cmds_update {}}
grid columnconf $txb 0 -weight 1
grid rowconf $txb 0 -weight 1
grid $txb.txt -column 0 -row 0 -sticky news
grid $txb.sv -column 1 -row 0 -sticky news
grid $txb.sh -column 0 -row 1 -sticky news
grid $txb.upd -column 0 -row 2 -columnspan 2 -sticky news
xth_status_bar me $txb.txt "Command preview."

# init scrap control

xth_about_status "loading scrap module ..."

set sfm $xth(ctrl,me,scrap)

Label $sfm.namel -text id -anchor e -font $xth(gui,lfont) -state disabled
xth_status_bar me $sfm.namel "Scrap name."
Entry $sfm.name -font $xth(gui,lfont) -state disabled -width 4 \
  -textvariable xth(ctrl,me,scrap,name)
xth_status_bar me $sfm.name "Scrap name."

Label $sfm.projl -text projection -anchor e -font $xth(gui,lfont) -state disabled
xth_status_bar me $sfm.projl "Scrap projection."
ComboBox $sfm.proj -values $xth(scrap_projections) \
  -font $xth(gui,lfont) -height 4 -state disabled -width 4 \
  -textvariable xth(ctrl,me,scrap,projection) -command {xth_me_cmds_update {}}

xth_status_bar me $sfm.proj "Scrap projection."

Label $sfm.optl -text options -anchor e -font $xth(gui,lfont) -state disabled -width 8
xth_status_bar me $sfm.optl "Other scrap options."
Entry $sfm.opt -font $xth(gui,lfont) -state disabled -width 4 \
  -textvariable xth(ctrl,me,scrap,options)

xth_status_bar me $sfm.opt "Other scrap options." 

#Separator $sfm.s1 -orient horizontal
Label $sfm.scl -text scale -anchor sw -font $xth(gui,lfont) -state disabled
xth_status_bar me $sfm.scl "Scrap scale definition."
Button $sfm.scpb -text "Update scrap" -anchor center -font $xth(gui,lfont) \
  -state disabled -width 4 -command {xth_me_cmds_update {}}
xth_status_bar me $sfm.scpb "."
Label $sfm.scpp -text "picture scale points" -anchor w -font $xth(gui,lfont) -state disabled
xth_status_bar me $sfm.scpp "Calibration points on the picture (X1:Y1 - X2:Y2)."
Entry $sfm.scx1p -font $xth(gui,lfont) -state disabled -width 4 \
  -textvariable xth(ctrl,me,scrap,px1)
xth_status_bar me $sfm.scx1p "X1 picture." 
Entry $sfm.scy1p -font $xth(gui,lfont) -state disabled -width 4 \
  -textvariable xth(ctrl,me,scrap,py1)
xth_status_bar me $sfm.scy1p "Y1 picture." 
Entry $sfm.scx2p -font $xth(gui,lfont) -state disabled -width 4 \
  -textvariable xth(ctrl,me,scrap,px2)
xth_status_bar me $sfm.scx2p "X2 picture." 
Entry $sfm.scy2p -font $xth(gui,lfont) -state disabled -width 4 \
  -textvariable xth(ctrl,me,scrap,py2)
xth_status_bar me $sfm.scy2p "Y2 picture." 
Label $sfm.scrp -text "real scale points" -anchor w -font $xth(gui,lfont) -state disabled
xth_status_bar me $sfm.scrp "Real coordinates of calibration points (X1:Y1 - X2:Y2)."
Entry $sfm.scx1r -font $xth(gui,lfont) -state disabled -width 4 \
  -textvariable xth(ctrl,me,scrap,rx1)
xth_status_bar me $sfm.scx1r "X1 real." 
Entry $sfm.scy1r -font $xth(gui,lfont) -state disabled -width 4 \
  -textvariable xth(ctrl,me,scrap,ry1)
xth_status_bar me $sfm.scy1r "Y1 real." 
Entry $sfm.scx2r -font $xth(gui,lfont) -state disabled -width 4 \
  -textvariable xth(ctrl,me,scrap,rx2)
xth_status_bar me $sfm.scx2r "X2 real." 
Entry $sfm.scy2r -font $xth(gui,lfont) -state disabled -width 4 \
  -textvariable xth(ctrl,me,scrap,ry2)
xth_status_bar me $sfm.scy2r "Y2 real." 
Label $sfm.scul -text "units" -anchor e -font $xth(gui,lfont) -state disabled
xth_status_bar me $sfm.scul "Units of real coordinates."
ComboBox $sfm.scu -values $xth(length_units) \
  -font $xth(gui,lfont) -height 5 -state disabled -width 4 \
  -textvariable xth(ctrl,me,scrap,units) -command {xth_me_cmds_update {}}
xth_status_bar me $sfm.scu "Units of real coordinates."

xth_me_bind_entry_focus_return "$sfm.scx1p $sfm.scy1p $sfm.scx2p $sfm.scy2p" {xth_me_cmds_update {}}
xth_me_bind_entry_focus_return "$sfm.scx1r $sfm.scy1r $sfm.scx2r $sfm.scy2r" {xth_me_cmds_update {}}
xth_me_bind_entry_return "$sfm.name $sfm.opt" {xth_me_cmds_update {}}
xth_me_bind_entry_focusin "$sfm.name $sfm.opt $sfm.scx1p $sfm.scy1p $sfm.scx2p $sfm.scy2p $sfm.scx1r $sfm.scy1r $sfm.scx2r $sfm.scy2r"

grid columnconf $sfm 0 -weight 1
grid columnconf $sfm 1 -weight 1
grid columnconf $sfm 2 -weight 1
grid columnconf $sfm 3 -weight 1
grid $sfm.namel -row 0 -column 0 -columnspan 2 -sticky news
grid $sfm.name  -row 0 -column 2 -columnspan 2 -sticky news -padx 1
grid $sfm.projl -row 1 -column 0 -columnspan 2 -sticky news
grid $sfm.proj  -row 1 -column 2 -columnspan 2 -sticky news -padx 2
grid $sfm.optl -row 2 -column 0 -columnspan 2 -sticky news
grid $sfm.opt  -row 2 -column 2 -columnspan 2 -sticky news -padx 1
#grid $sfm.s1 -column 0 -row 3 -sticky news -columnspan 4 -pady 3
grid $sfm.scl -row 3 -column 0 -columnspan 2 -sticky news
grid $sfm.scpb -row 3 -column 2 -columnspan 2 -sticky news
grid $sfm.scpp -column 0 -row 4 -sticky news -columnspan 4
grid $sfm.scx1p $sfm.scy1p $sfm.scx2p $sfm.scy2p -row 5 -sticky news -padx 1
grid $sfm.scrp -column 0 -row 6 -sticky news -columnspan 4
grid $sfm.scx1r $sfm.scy1r $sfm.scx2r $sfm.scy2r -row 7 -sticky news -padx 1
grid $sfm.scul -row 8 -column 0 -columnspan 2 -sticky news
grid $sfm.scu  -row 8 -column 2 -columnspan 2 -sticky news -padx 2


# point control
xth_about_status "loading point module ..."

set ptc $xth(ctrl,me,point)
Label $ptc.posl -text "position" -anchor e -font $xth(gui,lfont) -state disabled -width 8
xth_status_bar me $ptc.posl "Point position."
Entry $ptc.posx -font $xth(gui,lfont) -state disabled -width 4 -textvariable xth(ctrl,me,point,x)
xth_status_bar me $ptc.posx "Point X coordinate." 
Entry $ptc.posy -font $xth(gui,lfont) -state disabled -width 4 -textvariable xth(ctrl,me,point,y)
xth_status_bar me $ptc.posy "Point Y coordinate." 

Button $ptc.upd -text "Update point" -anchor center -font $xth(gui,lfont) \
  -state disabled -command {xth_me_cmds_update {}}
xth_status_bar me $ptc.upd "Update point data." 

Label $ptc.typl -text "type" -anchor e -font $xth(gui,lfont) -state disabled -width 8
xth_status_bar me $ptc.typl "Point type."
ComboBox $ptc.typ -values $xth(point_types) \
  -font $xth(gui,lfont) -height $xth(gui,me,typelistwidth) -state disabled -width 4 \
  -textvariable xth(ctrl,me,point,type) -command {xth_me_cmds_update {}}
xth_status_bar me $ptc.typ "Point type." 

Label $ptc.namel -text "id" -anchor e -font $xth(gui,lfont) -state disabled
xth_status_bar me $ptc.namel "Point name."
Entry $ptc.name -font $xth(gui,lfont) -state disabled -width 4 \
  -textvariable xth(ctrl,me,point,name)
xth_status_bar me $ptc.name "Point name." 

Label $ptc.optl -text "options" -anchor e -font $xth(gui,lfont) -state disabled
xth_status_bar me $ptc.optl "Other point options."
Entry $ptc.opt -font $xth(gui,lfont) -state disabled -width 4 \
  -textvariable xth(ctrl,me,point,opts)
xth_status_bar me $ptc.opt "Other point options." 
Separator $ptc.s1 -orient horizontal

checkbutton $ptc.rotc -text "orientation" -anchor w -font $xth(gui,lfont) -state disabled \
  -variable xth(ctrl,me,point,rotid) -command xth_me_cmds_point_change_state
xth_status_bar me $ptc.rotc "Set point rotation."
Entry $ptc.rot -font $xth(gui,lfont) -state disabled -width 4 \
  -textvariable xth(ctrl,me,point,rot)
xth_status_bar me $ptc.rot "Enter point rotation."

checkbutton $ptc.xszc -text "x-size" -anchor w -font $xth(gui,lfont) -state disabled \
  -variable xth(ctrl,me,point,xsid) -command xth_me_cmds_point_change_state
xth_status_bar me $ptc.xszc "Set point size in main direction."
Entry $ptc.xsz -font $xth(gui,lfont) -state disabled -width 4 \
  -textvariable xth(ctrl,me,point,xs)
xth_status_bar me $ptc.xsz "Enter point size in main direction."

checkbutton $ptc.yszc -text "y-size" -anchor w -font $xth(gui,lfont) -state disabled \
  -variable xth(ctrl,me,point,ysid) -command xth_me_cmds_point_change_state
xth_status_bar me $ptc.yszc "Set point size in side direction."
Entry $ptc.ysz -font $xth(gui,lfont) -state disabled -width 4 \
  -textvariable xth(ctrl,me,point,ys)
xth_status_bar me $ptc.ysz "Enter point size in side direction."

xth_me_bind_entry_focus_return "$ptc.posx $ptc.posy" {xth_me_cmds_update {}}
xth_me_bind_entry_return "$ptc.name $ptc.opt $ptc.rot $ptc.xsz $ptc.ysz" {xth_me_cmds_update {}}
xth_me_bind_entry_focusin "$ptc.posx $ptc.posy $ptc.name $ptc.opt $ptc.rot $ptc.xsz $ptc.ysz"


grid columnconf $ptc 0 -weight 1
grid columnconf $ptc 1 -weight 1
grid columnconf $ptc 2 -weight 1
grid columnconf $ptc 3 -weight 1
grid $ptc.posl -row 0 -column 0 -columnspan 2 -sticky news
grid $ptc.posx -row 0 -column 2 -sticky news -padx 1
grid $ptc.posy -row 0 -column 3 -sticky news -padx 1
grid $ptc.typl -row 1 -column 0 -columnspan 2 -sticky news
grid $ptc.typ -row 1 -column 2 -columnspan 2 -sticky news -padx 2
grid $ptc.namel -row 2 -column 0 -columnspan 2 -sticky news
grid $ptc.name -row 2 -column 2 -columnspan 2 -sticky news -padx 1
grid $ptc.optl -row 3 -column 0 -columnspan 2 -sticky news
grid $ptc.opt -row 3 -column 2 -columnspan 2 -sticky news -padx 1
grid $ptc.s1 -row 4 -column 0 -columnspan 4 -sticky news -pady 3
grid $ptc.rotc -row 5 -column 0 -columnspan 2 -sticky news
grid $ptc.rot -row 5 -column 2 -columnspan 2 -sticky news -padx 1
#grid $ptc.xszc -row 6 -column 0 -columnspan 2 -sticky news
#grid $ptc.xsz -row 6 -column 2 -columnspan 2 -sticky news -padx 1
#grid $ptc.yszc -row 7 -column 0 -columnspan 2 -sticky news
#grid $ptc.ysz -row 7 -column 2 -columnspan 2 -sticky news -padx 1
grid $ptc.upd -row 8 -column 0 -columnspan 4 -sticky news


# line control
xth_about_status "loading line module ..."

set lnc $xth(ctrl,me,line)

Label $lnc.typl -text "type" -anchor e -font $xth(gui,lfont) -state disabled
xth_status_bar me $lnc.typl "Line type."
ComboBox $lnc.typ -values $xth(line_types) \
  -font $xth(gui,lfont) -height $xth(gui,me,typelistwidth) -state disabled -width 4 \
  -textvariable xth(ctrl,me,line,type) \
  -command {xth_me_cmds_update {}}
xth_status_bar me $lnc.typ "Line type." 

Label $lnc.namel -text "id" -anchor e -font $xth(gui,lfont) -state disabled
xth_status_bar me $lnc.namel "Line name."
Entry $lnc.name -font $xth(gui,lfont) -state disabled -width 4 \
  -textvariable xth(ctrl,me,line,name)
xth_status_bar me $lnc.name "Line name." 

Label $lnc.optl -text "options" -anchor e -font $xth(gui,lfont) -state disabled
xth_status_bar me $lnc.optl "Other line options."
Entry $lnc.opt -font $xth(gui,lfont) -state disabled -width 4 \
  -textvariable xth(ctrl,me,line,opts)
xth_status_bar me $lnc.opt "Other line options." 

checkbutton $lnc.rev -text "reverse" -anchor w -font $xth(gui,lfont) \
  -state disabled \
  -variable xth(ctrl,me,line,reverse) \
  -command xth_me_cmds_toggle_line_reverse
xth_status_bar me $lnc.rev "Reverse line."
checkbutton $lnc.cls -text "close" -anchor w -font $xth(gui,lfont) \
  -state disabled \
  -variable xth(ctrl,me,line,close) \
  -command xth_me_cmds_toggle_line_close
xth_status_bar me $lnc.cls "Close line."

set plf $lnc.pl
frame $plf
listbox $plf.l -height 4 -selectmode single -takefocus 0 \
  -yscrollcommand "xth_scroll $plf.sv" \
  -xscrollcommand "xth_scroll $plf.sh" \
  -font $xth(gui,lfont) -exportselection no \
  -selectborderwidth 0
scrollbar $plf.sv -orient vert  -command "$plf.l yview" \
  -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
scrollbar $plf.sh -orient horiz  -command "$plf.l xview" \
  -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
bind $plf.l <<ListboxSelect>> {
  if {$xth(me,fopen)} {
    xth_me_cmds_select_linept $xth(me,cmds,selid) \
    [lindex $xth(me,cmds,$xth(me,cmds,selid),xplist) \
    [lindex [%W curselection] 0]]
    if {$xth(me,cmds,selpid) > 0} {
      xth_me_center_to [list \
        $xth(me,cmds,$xth(me,cmds,selid),$xth(me,cmds,selpid),x) \
        $xth(me,cmds,$xth(me,cmds,selid),$xth(me,cmds,selpid),y)]
    }
  }
}
bind $plf.l <B1-ButtonRelease> "focus $plf.l"

menubutton $lnc.lpa -text "Edit line" -anchor w -font $xth(gui,lfont) \
  -indicatoron true -menu $lnc.lpa.m -state disabled -width 10
xth_status_bar me $lnc.lpa "Insert/delete line point. Split line."
Button $lnc.upd -text "Update" -anchor center -font $xth(gui,lfont) \
  -state disabled -command {xth_me_cmds_update {}} -width 10
xth_status_bar me $lnc.upd "Update line."

menu $lnc.lpa.m -tearoff 0 -font $xth(gui,lfont)
$lnc.lpa.m add command -label "Insert point" -command {xth_me_cmds_start_linept_insert} -state disabled
$lnc.lpa.m add command -label "Delete point" -command {xth_me_cmds_delete_linept {} {}} -state disabled
$lnc.lpa.m add command -label "Split line" -command {xth_me_cmds_line_split} -state disabled

#Button $lnc.insp -text "Insert" -anchor center -font $xth(gui,lfont) \
#  -state disabled -width 10 -command {xth_me_cmds_start_linept_insert}
#Button $lnc.delp -text "Delete" -anchor center -font $xth(gui,lfont) \
#  -state disabled -width 10 -command {xth_me_cmds_delete_linept {} {}}

grid columnconf $plf 0 -weight 1
grid rowconf $plf 0 -weight 1
grid $plf.l -column 0 -row 0 -sticky news
xth_scroll_showcmd $plf.sv "grid $plf.sv -column 1 -row 0 -sticky news"
xth_scroll_hidecmd $plf.sv "grid forget $plf.sv"
xth_scroll_showcmd $plf.sh "grid $plf.sh -column 0 -row 1 -sticky news"
xth_scroll_hidecmd $plf.sh "grid forget $plf.sh"
xth_status_bar me $plf "Select line point."


grid columnconf $lnc 0 -weight 1
grid columnconf $lnc 1 -weight 1
grid $lnc.typl -row 0 -column 0 -sticky news
grid $lnc.typ -row 0 -column 1 -sticky news -padx 2
grid $lnc.namel -row 1 -column 0 -sticky news
grid $lnc.name -row 1 -column 1 -sticky news -padx 1
grid $lnc.optl -row 2 -column 0 -sticky news
grid $lnc.opt -row 2 -column 1 -sticky news -padx 1
grid $lnc.rev -row 3 -column 0 -sticky news
grid $lnc.cls -row 3 -column 1 -sticky news
grid $plf -row 4 -column 0 -columnspan 2 -sticky news
grid $lnc.lpa -row 5 -column 0 -sticky news
grid $lnc.upd -row 5 -column 1 -sticky news
#grid $lnc.insp -row 5 -column 0 -sticky news
#grid $lnc.delp -row 5 -column 1 -sticky news

xth_me_bind_entry_return "$lnc.name $lnc.opt" {xth_me_cmds_update {}}
xth_me_bind_entry_focusin "$lnc.name $lnc.opt"

# line point control
xth_about_status "loading line point module ..."

set lpc $xth(ctrl,me,linept)

Label $lpc.posl -text "position" -anchor e -font $xth(gui,lfont) -state disabled -width 0
xth_status_bar me $lpc.posl "Point position."
Entry $lpc.posx -font $xth(gui,lfont) -state disabled \
  -textvariable xth(ctrl,me,linept,x) -width 0
xth_status_bar me $lpc.posx "Point X coordinate."
Entry $lpc.posy -font $xth(gui,lfont) -state disabled \
  -textvariable xth(ctrl,me,linept,y) -width 0
xth_status_bar me $lpc.posy "Point Y coordinate." 

Entry $lpc.xp -font $xth(gui,lfont) -state disabled -width 4 \
  -textvariable xth(ctrl,me,linept,xp)
xth_status_bar me $lpc.xp "Previous control point X coordinate." 
Entry $lpc.yp -font $xth(gui,lfont) -state disabled -width 4 \
  -textvariable xth(ctrl,me,linept,yp)
xth_status_bar me $lpc.yp "Previous control point Y coordinate." 
Entry $lpc.xn -font $xth(gui,lfont) -state disabled -width 4 \
  -textvariable xth(ctrl,me,linept,xn)
xth_status_bar me $lpc.xn "Next control point X coordinate." 
Entry $lpc.yn -font $xth(gui,lfont) -state disabled -width 4 \
  -textvariable xth(ctrl,me,linept,yn)
xth_status_bar me $lpc.yn "Next control point Y coordinate." 

checkbutton $lpc.cbp -text "<<" -anchor w -font $xth(gui,lfont) \
  -state disabled -width 0 \
  -variable xth(ctrl,me,linept,idp) \
  -command xth_me_cmds_toggle_linept
xth_status_bar me $lpc.cbp "Checkbox whether to use previous control point."
checkbutton $lpc.cbs -text "smooth" -anchor w -font $xth(gui,lfont) -state disabled \
  -variable xth(ctrl,me,linept,smooth) -width 0\
  -command xth_me_cmds_toggle_linept
xth_status_bar me $lpc.cbs "Set line to be smooth in given point."
checkbutton $lpc.cbn -text ">>" -anchor w -font $xth(gui,lfont) \
  -state disabled -width 0 \
  -variable xth(ctrl,me,linept,idn) \
  -command xth_me_cmds_toggle_linept
xth_status_bar me $lpc.cbn "Checkbox whether to use next control point."

checkbutton $lpc.rotc -text "orientation" -anchor w -font $xth(gui,lfont) -state disabled \
  -variable xth(ctrl,me,linept,rotid) -width 0 \
  -command xth_me_cmds_toggle_linept
xth_status_bar me $lpc.rotc "Set point rotation."
Entry $lpc.rot -font $xth(gui,lfont) -state disabled -width 0 \
  -textvariable xth(ctrl,me,linept,rot)
xth_status_bar me $lpc.rot "Enter point rotation."

checkbutton $lpc.rszc -text "r-size" -anchor w -font $xth(gui,lfont) -state disabled \
  -variable xth(ctrl,me,linept,rsid) -width 0 \
  -command xth_me_cmds_toggle_linept
xth_status_bar me $lpc.rszc "Set line size in right direction."
Entry $lpc.rsz -font $xth(gui,lfont) -state disabled -width 0 \
  -textvariable xth(ctrl,me,linept,rs)
xth_status_bar me $lpc.rsz "Enter line size in right direction."

checkbutton $lpc.lszc -text "l-size" -anchor w -font $xth(gui,lfont) -state disabled \
  -variable xth(ctrl,me,linept,lsid) -width 0  \
  -command xth_me_cmds_toggle_linept
xth_status_bar me $lpc.lszc "Set line size in left direction."
Entry $lpc.lsz -font $xth(gui,lfont) -state disabled -width 0 \
  -textvariable xth(ctrl,me,linept,ls)
xth_status_bar me $lpc.lsz "Enter line size in left direction."

Label $lpc.optl -text "options" -anchor sw -font $xth(gui,lfont) -state disabled \
 -width 0
xth_status_bar me $lpc.optl "Line point options editor."
Button $lpc.upd -text "Update" -anchor center -font $xth(gui,lfont) \
  -state disabled -command {xth_me_cmds_update {}} -width 0
xth_status_bar me $lpc.upd "Update line point."

set txb $lpc.oe
frame $txb
text $txb.txt -height 2 -wrap none -font $xth(gui,efont) \
  -bg $xth(gui,ecolorbg) \
  -fg $xth(gui,ecolorfg) -insertbackground $xth(gui,ecolorfg) \
  -relief sunken -state disabled \
  -selectbackground $xth(gui,ecolorselbg) \
  -selectforeground $xth(gui,ecolorselfg) \
  -yscrollcommand "$txb.sv set" \
  -selectborderwidth 0 \
  -xscrollcommand "$txb.sh set" 
scrollbar $txb.sv -orient vert  -command "$txb.txt yview" \
  -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
scrollbar $txb.sh -orient horiz  -command "$txb.txt xview" \
  -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
grid columnconf $txb 0 -weight 1
grid rowconf $txb 0 -weight 1
grid $txb.txt -column 0 -row 0 -sticky news
grid $txb.sv -column 1 -row 0 -sticky news
grid $txb.sh -column 0 -row 1 -sticky news
xth_status_bar me $txb "Editor for line point options."
bind $txb.txt <$xth(kb_control)-Key-x> "tk_textCut $txb.txt"
bind $txb.txt <$xth(kb_control)-Key-c> "tk_textCopy $txb.txt"
bind $txb.txt <$xth(kb_control)-Key-v> "tk_textPaste $txb.txt"

if {$xth(gui,bindinsdel)} {
  bind $txb.txt <Shift-Key-Delete> "tk_textCut $txb.txt"
  bind $txb.txt <$xth(kb_control)-Key-Insert> "tk_textCopy $txb.txt"
  bind $txb.txt <Shift-Key-Insert> "tk_textPaste $txb.txt"
#  catch {
#    bind $txb.txt <Shift-Key-KP_Decimal> "tk_textCut $txb.txt"
#    bind $txb.txt <$xth(kb_control)-Key-KP_Insert> "tk_textCopy $txb.txt"
#    bind $txb.txt <Shift-Key-KP_0> "tk_textPaste $txb.txt"
#  }
}

bind $txb.txt <Tab> $xth(gui,bind,text_tab)
bind $txb.txt <Return> $xth(gui,bind,text_return)

grid columnconf $lpc 0 -weight 1
grid columnconf $lpc 1 -weight 1
grid columnconf $lpc 2 -weight 1
grid columnconf $lpc 3 -weight 1

grid $lpc.posl -row 0 -column 0 -columnspan 2 -sticky news
grid $lpc.posx -row 0 -column 2 -sticky news
grid $lpc.posy -row 0 -column 3 -sticky news

xth_me_bind_entry_focus_return "$lpc.posx $lpc.posy" {xth_me_cmds_update {}}

grid $lpc.xp -row 1 -column 0 -sticky news
grid $lpc.yp -row 1 -column 1 -sticky news
grid $lpc.xn -row 1 -column 2 -sticky news
grid $lpc.yn -row 1 -column 3 -sticky news

xth_me_bind_entry_focus_return "$lpc.xp $lpc.yp" {xth_me_cmds_update {}}
xth_me_bind_entry_focus_return "$lpc.xn $lpc.yn" {xth_me_cmds_update {}}
xth_me_bind_entry_focusin "$lpc.posx $lpc.posy $lpc.xp $lpc.yp $lpc.xn $lpc.yn"

grid $lpc.cbp -row 2 -column 0 -sticky news
grid $lpc.cbs -row 2 -column 1 -columnspan 2 -sticky news
grid $lpc.cbn -row 2 -column 3 -sticky news

grid $lpc.rotc -row 3 -column 0 -columnspan 2 -sticky news
grid $lpc.rot -row 3 -column 2 -columnspan 2 -sticky news

grid $lpc.lszc -row 4 -column 0 -columnspan 2 -sticky news
grid $lpc.lsz -row 4 -column 2 -columnspan 2 -sticky news

#grid $lpc.rszc -row 5 -column 0 -columnspan 2 -sticky news
#grid $lpc.rsz -row 5 -column 2 -columnspan 2 -sticky news

grid $lpc.optl -row 6 -column 0 -columnspan 2 -sticky news
grid $lpc.upd -row 6 -column 2 -columnspan 2 -sticky news

grid $txb -row 7 -column 0 -columnspan 4 -sticky news

xth_me_bind_entry_focusin "$lpc.rot $lpc.lsz $lpc.rsz"
xth_me_bind_entry_return "$lpc.rot $lpc.lsz $lpc.rsz" {xth_me_cmds_update {}}





# area control
xth_about_status "loading area module ..."

set lnc $xth(ctrl,me,ac)

Label $lnc.typl -text "type" -anchor e -font $xth(gui,lfont) -state disabled
xth_status_bar me $lnc.typl "Area type."
ComboBox $lnc.typ -values $xth(area_types) \
  -font $xth(gui,lfont) -height $xth(gui,me,typelistwidth) -state disabled -width 4 \
  -textvariable xth(ctrl,me,ac,type) \
  -command {xth_me_cmds_update {}}
xth_status_bar me $lnc.typ "Area type." 

Label $lnc.optl -text "options" -anchor e -font $xth(gui,lfont) -state disabled
xth_status_bar me $lnc.optl "Other area options."
Entry $lnc.opt -font $xth(gui,lfont) -state disabled -width 4 \
  -textvariable xth(ctrl,me,ac,opts)
xth_status_bar me $lnc.opt "Other area options." 

set plf $lnc.ll
frame $plf
listbox $plf.l -height 4 -selectmode single -takefocus 0 \
  -yscrollcommand "xth_scroll $plf.sv" \
  -xscrollcommand "xth_scroll $plf.sh" \
  -font $xth(gui,lfont) -exportselection no \
  -selectborderwidth 0
scrollbar $plf.sv -orient vert  -command "$plf.l yview" \
  -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
scrollbar $plf.sh -orient horiz  -command "$plf.l xview" \
  -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
bind $plf.l <<ListboxSelect>> {}
bind $plf.l <B1-ButtonRelease> "focus $plf.l"

Button $lnc.ins -text "Insert" -anchor center -font $xth(gui,lfont) \
  -state disabled -width 10 -command {xth_me_cmds_start_area_insert 1}
xth_status_bar me $lnc.ins "Switch to insert line into area mode."
Button $lnc.del -text "Delete" -anchor center -font $xth(gui,lfont) \
  -state disabled -width 10 -command {xth_me_cmds_delete_area_line {} {}}
xth_status_bar me $lnc.del "Delete ID from area."

Button $lnc.insid -text "Insert ID" -anchor center -font $xth(gui,lfont) \
  -state disabled -command {xth_me_cmds_insert_area_line $xth(ctrl,me,ac,insid) {} {}} -width 10
xth_status_bar me $lnc.insid "Insert given id."
Entry $lnc.inside -font $xth(gui,lfont) -state disabled -width 4 \
  -textvariable xth(ctrl,me,ac,insid)
xth_status_bar me $lnc.inside "ID to insert." 

Button $lnc.upd -text "Update" -anchor center -font $xth(gui,lfont) \
  -state disabled -command {xth_me_cmds_update {}} -width 10
xth_status_bar me $lnc.upd "Update area."
Button $lnc.shw -text "Show" -anchor center -font $xth(gui,lfont) \
  -state disabled -command {xth_me_cmds_show_current_area} -width 10
xth_status_bar me $lnc.shw "Show area border lines."

grid columnconf $plf 0 -weight 1
grid rowconf $plf 0 -weight 1
grid $plf.l -column 0 -row 0 -sticky news
xth_scroll_showcmd $plf.sv "grid $plf.sv -column 1 -row 0 -sticky news"
xth_scroll_hidecmd $plf.sv "grid forget $plf.sv"
xth_scroll_showcmd $plf.sh "grid $plf.sh -column 0 -row 1 -sticky news"
xth_scroll_hidecmd $plf.sh "grid forget $plf.sh"
xth_status_bar me $plf "Select line in area."

grid columnconf $lnc 0 -weight 1
grid columnconf $lnc 1 -weight 1
grid $lnc.typl -row 0 -column 0 -sticky news
grid $lnc.typ -row 0 -column 1 -sticky news -padx 2
grid $lnc.optl -row 1 -column 0 -sticky news
grid $lnc.opt -row 1 -column 1 -sticky news -padx 1
grid $lnc.shw -row 2 -column 0 -sticky news
grid $lnc.upd -row 2 -column 1 -sticky news
grid $plf -row 3 -column 0 -columnspan 2 -sticky news
grid $lnc.ins -row 4 -column 0 -sticky news
grid $lnc.del -row 4 -column 1 -sticky news
grid $lnc.insid -row 5 -column 0 -sticky news
grid $lnc.inside -row 5 -column 1 -sticky news

xth_me_bind_entry_return "$lnc.opt" {xth_me_cmds_update {}}
xth_me_bind_entry_focusin "$lnc.opt"


# main menu
xth_about_status "loading main menu ..."


$xth(me,menu,file) add command -label "New" -command xth_me_create_file \
  -font $xth(gui,lfont) -underline 0 -state normal
$xth(me,menu,file) add command -label "Open" -underline 0 \
  -accelerator "$xth(gui,controlk)-o" -state normal \
  -font $xth(gui,lfont) -command {
			set xth(gui,openxp) 0
			xth_me_open_file 1 {} 1
	}
$xth(me,menu,file) add command -label "Open (no pics)" -underline 10 \
  -state normal -font $xth(gui,lfont) -command {
	    set xth(gui,openxp) 1
			xth_me_open_file 1 {} 1
			set xth(gui,openxp) 0
	}
$xth(me,menu,file) add command -label "Save" -underline 0 \
  -accelerator "$xth(gui,controlk)-s" -state disabled \
  -font $xth(gui,lfont) -command {xth_me_save_file 0}
$xth(me,menu,file) add command -label "Save as" -underline 5 \
  -font $xth(gui,lfont) -command {xth_me_save_file 1} -state disabled 
$xth(me,menu,file) add checkbutton -label "Auto save" -underline 1 \
  -variable xth(gui,auto_save) -font $xth(gui,lfont) \
  -state disabled -command xth_app_autosave_schedule
$xth(me,menu,file) add command -label "Close" -underline 0 \
  -accelerator "$xth(gui,controlk)-w"  -state disabled \
  -font $xth(gui,lfont) \
  -command xth_me_close_file

set xth(me,menu,edit) $xth(me,menu).edit
menu $xth(me,menu,edit) -tearoff 0
menu $xth(me,menu,edit).ins -tearoff 0
bind $xth(me,menu,edit) <FocusIn> {xth_me_cmds_update {}}
$xth(me,menu) add cascade -label "Edit" -state disabled \
  -font $xth(gui,lfont) -menu $xth(me,menu,edit) -underline 0
$xth(me,menu,edit) add command -label "Undo" -font $xth(gui,lfont) \
  -underline 0 -accelerator "$xth(gui,controlk)-z" -state disabled \
  -command xth_me_unredo_undo
$xth(me,menu,edit) add command -label "Redo" -font $xth(gui,lfont) \
  -underline 0 -accelerator "$xth(gui,controlk)-y" -state disabled \
  -command xth_me_unredo_redo
$xth(me,menu,edit) add separator
$xth(me,menu,edit) add command -label "Cut" -font $xth(gui,lfont) \
  -accelerator "$xth(gui,controlk)-x" -command "xth_app_clipboard cut"
$xth(me,menu,edit) add command -label "Copy" -font $xth(gui,lfont) \
  -accelerator "$xth(gui,controlk)-c" -command "xth_app_clipboard copy"
$xth(me,menu,edit) add command -label "Paste" -font $xth(gui,lfont) \
  -accelerator "$xth(gui,controlk)-v" -command "xth_app_clipboard paste"
$xth(me,menu,edit) add separator
$xth(me,menu,edit) add command -label "Select" -accelerator "Esc" -underline 0 -font $xth(gui,lfont) -command {xth_me_cmds_set_mode 0}
$xth(me,menu,edit) add cascade -label "Insert ..." -accelerator "$xth(gui,controlk)-i" -menu $xth(me,menu,edit).ins -underline 0 -font $xth(gui,lfont)
$xth(me,menu,edit).ins add command -label "point" -accelerator "$xth(gui,controlk)-p" -underline 0 -font $xth(gui,lfont) -command {xth_me_cmds_set_mode 1}
$xth(me,menu,edit).ins add command -label "line" -accelerator "$xth(gui,controlk)-l" -underline 0 -font $xth(gui,lfont) -command {
  xth_me_cmds_create_line {} 1 "" "" ""
  xth_ctrl_scroll_to me line
  xth_ctrl_maximize me line
  xth_ctrl_maximize me linept
}

$xth(me,menu,edit).ins add command -label "area" -accelerator "$xth(gui,controlk)-a" -font $xth(gui,lfont) -underline 0 -command {
  xth_me_cmds_create_area {} 1 "" "" ""
  xth_ctrl_scroll_to me ac
  xth_ctrl_maximize me ac
}

$xth(me,menu,edit).ins add command -label "scrap" -accelerator "$xth(gui,controlk)-r" -font $xth(gui,lfont) -underline 0 -command {
  xth_me_cmds_create_scrap {} 1 "" ""
  xth_ctrl_scroll_to me scrap
  xth_ctrl_maximize me scrap
}

$xth(me,menu,edit).ins add command -label "text" -font $xth(gui,lfont) -underline 0 -command {
  xth_me_cmds_create_text {} 1 "\n" "1.0"
  xth_ctrl_scroll_to me text
  xth_ctrl_maximize me text
  focus $xth(ctrl,me,text).txt
}

$xth(me,menu,edit) add command -label "Delete" -accelerator "$xth(gui,controlk)-d" -underline 0 -font $xth(gui,lfont) -command {xth_me_cmds_delete {}}
$xth(me,menu,edit) add separator
$xth(me,menu,edit) add cascade -label "Zoom 100 %" -font $xth(gui,lfont) \
  -underline 0 -menu $xth(ctrl,me,area).zb.m
$xth(me,menu,edit) add command -label "Auto adjust area" \
  -font $xth(gui,lfont) -command xth_me_area_auto_adjust
$xth(me,menu,edit) add command -label "Insert image" \
  -font $xth(gui,lfont) \
  -command {xth_me_image_insert $xth(ctrl,me,images,posx) $xth(ctrl,me,images,posy) {} 0 {}}
set xth(me,menu,edit,undo) [$xth(me,menu,edit) index "Undo"]
set xth(me,menu,edit,redo) [$xth(me,menu,edit) index "Redo"]
set xth(me,menu,edit,zoom) [$xth(me,menu,edit) index "Zoom 100 %"]


# create mouse mode bar and progess bar
set barfm $xth(gui,me).sf.barfm
frame $barfm
pack $barfm -side left
grid columnconf $barfm 0 -weight 1
grid rowconf $barfm 0 -weight 1

set xth(me,mbar) $barfm.mbar
Label $xth(me,mbar) -text "" -width 17 -relief sunken -font $xth(gui,lfont) \
  -anchor center -state disabled
grid $xth(me,mbar) -column 0 -row 0 -sticky news
set xth(me,mbar,bg) [$xth(me,mbar) cget -bg]
set xth(me,mbar,fg) [$xth(me,mbar) cget -fg]
xth_status_bar me $xth(me,mbar) "Mouse mode."

set xth(me,progbar) $barfm.pbar
set xth(me,progbar,value) 0
ProgressBar $xth(me,progbar) -type normal -width 100 -variable xth(me,progbar,value) -fg darkBlue

proc xth_me_progbar_show {max} {
  global xth
  set pbw [winfo width $xth(me,mbar)]
  set pbh [winfo height $xth(me,mbar)]
  grid forget $xth(me,mbar)
  grid $xth(me,progbar) -column 0 -row 0 -sticky news
  $xth(me,progbar) configure -maximum $max -width $pbw -height $pbh
  update idletasks
}

proc xth_me_progbar_hide {} {
  global xth
  grid forget $xth(me,progbar)
  grid $xth(me,mbar) -column 0 -row 0 -sticky news
  update idletasks
}

proc xth_me_progbar_prog {val} {
  global xth
  set xth(me,progbar,value) $val
  update idletasks
}

# create position bar
set xth(me,pbar) $xth(gui,me).sf.pbar
Label $xth(me,pbar) -text "" -width 15 -relief sunken -font $xth(gui,lfont) \
  -anchor center -state disabled
pack $xth(me,pbar) -side left
xth_status_bar me $xth(me,pbar) "Current mouse position."

xth_ctrl_minimize me cmds
xth_ctrl_minimize me prev
xth_ctrl_minimize me ss
xth_ctrl_minimize me point
xth_ctrl_minimize me line
xth_ctrl_minimize me linept
xth_ctrl_minimize me ac
xth_ctrl_minimize me scrap
xth_ctrl_minimize me text
xth_ctrl_minimize me area
xth_ctrl_minimize me images
    
set xth(ctrl,me,area,xmin) ""
set xth(ctrl,me,area,ymin) ""
set xth(ctrl,me,area,xmax) ""
set xth(ctrl,me,area,ymax) ""

xth_about_status "loading line procs ..."









xth_about_status "loading compiler..."


proc xth_cp_new_file {} {
  global xth
  if {$xth(cp,fopen)} {
    return
  }
  set xth(cp,fopen) 1
  set xth(cp,special) {}
  set xth(cp,ffull) [file join $xth(gui,initdir) "thconfig"]
  if {[xth_cp_save_as]} {
    set ff $xth(cp,ffull)
    set xth(cp,fopen) 0
    set xth(cp,fname) ""
    set xth(cp,open_file) ""
    set xth(cp,fpath) ""
    set xth(cp,ffull) ""
    xth_cp_open_file $ff
  } else {
    set xth(cp,fopen) 0
    set xth(cp,fname) ""
    set xth(cp,open_file) ""
    set xth(cp,fpath) ""
    set xth(cp,ffull) ""
  }
}

proc xth_cp_open_file {fpath} {
  global xth
  
  if {$xth(cp,fopen)} {
    return
  }

  if {[string length $fpath] == 0} {
    set fpath [tk_getOpenFile -filetypes $xth(app,cp,filetypes) \
      -parent $xth(gui,main) -initialdir $xth(gui,initdir)]
  }
  
  if {[string length $fpath] == 0} {
    return 0
  } else {
    set xth(gui,initdir) [file dirname $fpath]
  }

  set is_config_file [xth_cp_is_config_file $fpath];
  if {[string length $is_config_file] > 0} {
    MessageDlg $xth(gui,message) -parent $xth(gui,main) \
      -icon info -type ok \
      -message  "$fpath\n-----\n$is_config_file" \
      -font $xth(gui,lfont)
    return 0;
  }
  

  # read the file
  xth_status_bar_push cp
  xth_status_bar_status cp "Opening $fpath ..."

  set fdata [xth_me_read_file $fpath 0]
  if {[lindex $fdata 0] == 0} {
      MessageDlg $xth(gui,message) -parent $xth(gui,main) \
        -icon error -type ok \
        -message [lindex $fdata 1] \
        -font $xth(gui,lfont)
      xth_status_bar_pop cp
      return 0
  }
  
  # now let's show the file
  catch {
    set fid [open [file join [file dirname $fpath] ".xth-[file tail $fpath]"] r]
    fconfigure $fid -encoding utf-8
    while {![eof $fid]} {
      catch {
        eval [gets $fid]
      }
    }
    close $fid
  }
  
  set xth(cp,fopen) 1
  set xth(cp,special) [lindex $fdata 2]
  set xth(cp,fname) [file tail $fpath]
  set xth(cp,open_file) [file tail $fpath]
  set xth(cp,fpath) [file dirname $fpath]
  set xth(cp,ffull) $fpath
  
  # enable controls
  $xth(cp,editor).txt configure -state normal
#  $xth(cp,editor).txt delete 1.0 end
  foreach ln [lindex $fdata 3] {
    $xth(cp,editor).txt insert end "$ln\n"
  }
  catch {
    $xth(cp,editor).txt edit reset
  }
  $xth(cp,editor).txt mark set insert $xth(cp,cursor)
  $xth(cp,editor).txt see $xth(cp,cursor)
  
  $xth(ctrl,cp,stp).wl configure -state normal
  $xth(ctrl,cp,stp).we configure -state normal
  $xth(ctrl,cp,stp).fl configure -state normal
  $xth(ctrl,cp,stp).fe configure -state normal
  $xth(ctrl,cp,stp).optl configure -state normal
  $xth(ctrl,cp,stp).opte configure -state normal
  $xth(ctrl,cp,stp).go configure -state normal
  $xth(ctrl,cp,stp).gores configure -state normal

  $xth(ctrl,cp,info).txt configure -state normal
  
  $xth(cp,menu,file) entryconfigure "New" -state disabled
  $xth(cp,menu,file) entryconfigure "Open" -state disabled
  $xth(cp,menu,file) entryconfigure "Save as" -state normal
  $xth(cp,menu,file) entryconfigure "Close" -state normal
  $xth(cp,menu) entryconfigure "Edit" -state normal
  
  xth_app_title cp
  xth_status_bar_pop cp
  update idletasks
  return 1
}


set xth(cps,n) 0
set xth(cps,mxs) 0
set xth(cps,mxl) 0
set xth(cps,ts) 0
set xth(cps,tl) 0

proc xth_cp_comp_stat {tlen tscrap} {
  global xth
  incr xth(cps,n)
  if {$tscrap > $xth(cps,mxs)} {
    set xth(cps,mxs) $tscrap
  }
  if {$tlen > $xth(cps,mxl)} {
    set xth(cps,mxl) $tlen
  }
  set xth(cps,ts) [expr $xth(cps,ts) + $tscrap]
  set xth(cps,tl) [expr $xth(cps,tl) + $tscrap]
  set xth(cps,as) [expr double($xth(cps,ts)) / double($xth(cps,n))]
  set xth(cps,al) [expr double($xth(cps,tl)) / double($xth(cps,n))]  
}



proc xth_cp_close_file {} {
  
  global xth

  xth_cp_data_tree_clear      

  if {!$xth(cp,fopen)} {
    return
  }
  
  xth_cp_write_file $xth(cp,ffull)

  # disable controls
  $xth(cp,editor).txt delete 1.0 end
  $xth(cp,editor).txt see 1.0
  $xth(cp,editor).txt configure -state disabled

  $xth(cp,log).txt configure -state normal
  $xth(cp,log).txt delete 1.0 end
  $xth(cp,log).txt see 1.0
  $xth(cp,log).txt configure -state disabled

  $xth(cp,menu,file) entryconfigure "New" -state normal
  $xth(cp,menu,file) entryconfigure "Open" -state normal
  $xth(cp,menu,file) entryconfigure "Save as" -state disabled
  $xth(cp,menu,file) entryconfigure "Close" -state disabled
  $xth(cp,menu) entryconfigure "Edit" -state disabled
  
  $xth(ctrl,cp,stp).wl configure -state disabled
  $xth(ctrl,cp,stp).we configure -state disabled
  $xth(ctrl,cp,stp).fl configure -state disabled
  $xth(ctrl,cp,stp).fe configure -state disabled
  $xth(ctrl,cp,stp).optl configure -state disabled
  $xth(ctrl,cp,stp).opte configure -state disabled
  $xth(ctrl,cp,stp).go configure -state disabled
  $xth(ctrl,cp,stp).gores configure -text "" -fg $xth(cp,resfg) -bg $xth(cp,resbg) \
    -state disabled

  $xth(ctrl,cp,info).txt configure -state disabled
  
  # set variables
  set xth(cp,fopen) 0
  set xth(cp,cursor) 1.0
  set xth(cp,fname) ""
  set xth(cp,open_file) ""
  set xth(cp,fpath) ""
  set xth(cp,opts) ""
  xth_app_title cp
  focus $xth(ctrl,cp,dat).t 
  
  set xth(ctrl,cp,datrestore) {}
  set xth(ctrl,cp,msrestore) {}

}


# xth_cp_write_file --
#
# return list containing
# {success name}

proc xth_cp_write_file {pth} {

  global errorInfo xth

  xth_status_bar_push cp
  xth_status_bar_status cp "Saving $pth ..."

  if {[catch {set fid [open $pth w]}]} {
    MessageDlg $xth(gui,message) -parent $xth(gui,main) \
        -icon error -type ok \
        -message $errorInfo \
        -font $xth(gui,lfont)    
    xth_status_bar_pop cp
    return 0
  }

  fconfigure $fid -encoding utf-8 -translation {auto lf}
  puts $fid "encoding  utf-8"

  # let's put data
  set data [$xth(cp,editor).txt get 1.0 end]
  regsub {\s*$} $data {} data
  puts $fid $data
    
  # now let's put special commands
  foreach cmd $xth(cp,special) {
    puts $fid "##XTHERION## $cmd"
  }
  close $fid
  
  xth_status_bar_pop cp
  return 1
}

proc xth_cp_save_as {} {

  global xth

  if {!$xth(cp,fopen)} {
    return 0
  }

  set fname $xth(cp,ffull)
  set idir [file dirname $fname]
  if {[string length $idir] == 0} {
    set idir $xth(gui,initdir)
  }
  set fname [tk_getSaveFile -filetypes $xth(app,cp,filetypes) \
    -parent $xth(gui,main) \
    -initialfile [file tail $fname] \
    -initialdir [file dirname $fname]]

  if {[string length $fname] == 0} {
    return 0
  } else {
    set xth(gui,initdir) [file dirname $fname]
  }

  if {![xth_cp_write_file $fname]} {
    return 0
  }

  set xth(cp,fname) [file tail $fname]
  set xth(cp,open_file) [file tail $fname]
  set xth(cp,fpath) [file dirname $fname]
  set xth(cp,ffull) $fname
  xth_app_title cp
  update idletasks  
  return 1
}


# xth_cp_read_file --
#
# return success
# {success name cmds lns}

proc xth_cp_read_file {pth} {

  global errorInfo xth

  set curenc utf-8
  set nm [file tail $pth]
  set encspc 0
  set flnn 0
  set success 1
  set lastln ""
  set lns {}
  set cmds {}
  if {[catch {set fid [open $pth r]}]} {
    set success 0
    set nm $errorInfo
    return [list $success $nm {} {}]
  }
  fconfigure $fid -encoding $curenc
  while {![eof $fid]} {
    gets $fid fln
    incr flnn
    if {[regexp {^\s*encoding\s+(\S+)\s*$} $fln encln enc]} {
      set encspc 1
      set rxp "\\s+($enc)\\s+"
      set validenc [regexp -nocase $rxp $xth(encodings) dum curenc]
      if {$validenc == 0} {
        set success 0
        set nm "$pth \[$flnn\] -- unknown encoding -- $enc"
        break
      }
      fconfigure $fid -encoding $curenc
      set lastln ""
    } elseif {[regexp {^\s*\#\#XTHERION\#\#\s+(\S.*)\s*$} $fln cmmdln cmmd]} {
      lappend cmds $cmmd
      set lastln ""
    } else {
      if {[regexp {(.*)\\\s*$} $lastln dumln prevln]} {
        set fln "$prevln$fln"
        if {[llength $lns] > 1} {
          set lns [lrange $lns 0 [expr [llength $lns] - 2]]
        } else {
          set lns {}
        }
      }
      lappend lns $fln
      set lastln $fln
    }
  }
  close $fid
  return [list $success $nm $cmds $lns]
  
}  


proc xth_cp_is_config_file {fname} {
  set str {}
  if {[regexp {\.pdf$} $fname]} {
    catch {
      set str {not a config file}
      set fid [open $fname r]
      fconfigure $fid -eofchar {}
      set allstr [read $fid]
      close $fid
      if {[regexp {\s+\/TeXsetup\s+\/([0-9a-fA-F]+)\s+} $allstr dum wstr]} {
        set str {}
        set i 0
        while {[string length $wstr] > 0} {
          set n "0x[string range $wstr 0 1]"
          append str [format "%c" [expr (255 - $n + $i) % 256]]
          set wstr [string range $wstr 2 end]
          incr i
        }
      }
    }
  }
  return $str
}


proc xth_cp_compile {} {
  global xth errorInfo
  set xth(cp,compres) 0
  if {!$xth(cp,fopen)} {
    return 0;
  }
  set ret 1
  xth_cp_write_file $xth(cp,ffull)
  set cdir [pwd]
  cd $xth(cp,fpath)
  $xth(cp,log).txt configure -state normal
  $xth(cp,log).txt delete 1.0 end
  $xth(cp,log).txt configure -wrap word
  $xth(cp,editor).txt configure -state disabled
  xth_status_bar_push cp
  xth_status_bar_status cp "Running therion ..."
  $xth(ctrl,cp,stp).gores configure -text "RUNNING" -fg black -bg yellow
  update idletasks
  set err [catch {
    set thid [open "|$xth(gui,compcmd) -x $xth(cp,opts) $xth(cp,fname)" r]
    if $xth(gui,compshow) {
      while {![eof $thid]} {
        $xth(cp,log).txt insert end [read $thid 8]
        $xth(cp,log).txt see end
        update idletasks
      }
    } else {
      read $thid;
    }
    close $thid
  }]
  
  set see_end 0
  if {$err} {
    bell
    $xth(ctrl,cp,stp).gores configure -text "ERROR" -fg white -bg red
    set ret 0
    set see_end 1
  } else {
    set xth(cp,compres) 1
    $xth(ctrl,cp,stp).gores configure -text "OK" -fg black -bg green
  }
  
  xth_status_bar_status cp "Reading therion log file ..."
  if {[catch {
    set lid [open "therion.log" r]
    $xth(cp,log).txt delete 1.0 end
    $xth(cp,log).txt configure -wrap none
    $xth(cp,log).txt insert end "[read $lid]\n"
    close $lid
    }]} {
      $xth(cp,log).txt insert end "\nerror opening therion.log file\n"
  }
  if ($see_end) {
    $xth(cp,log).txt see end
  } else {
    $xth(cp,log).txt see 1.0
  }
  xth_status_bar_pop cp
  update idletasks

  $xth(cp,log).txt configure -state normal
  $xth(cp,editor).txt configure -state normal
  xth_cp_show_errors

  # update configuration file if required
  set xth(cp,cursor) [$xth(cp,editor).txt index insert]
  if {1} {
    set fdata [xth_me_read_file $xth(cp,ffull) 0]
    if {[lindex $fdata 0] == 0} {
        MessageDlg $xth(gui,message) -parent $xth(gui,main) \
          -icon error -type ok \
          -message [lindex $fdata 1] \
          -font $xth(gui,lfont)
    } else {
      xth_cp_data_tree_clear      

      catch {
        set fid [open [file join [file dirname $xth(cp,ffull)] ".xth-[file tail $xth(cp,ffull)]"] r]
        fconfigure $fid -encoding utf-8
        while {![eof $fid]} {
          catch {eval [gets $fid]}
        }
        close $fid
      }

      set xth(cp,special) [lindex $fdata 2]
      
      $xth(cp,editor).txt delete 1.0 end
      foreach ln [lindex $fdata 3] {
        $xth(cp,editor).txt insert end "$ln\n"
      }
      
      $xth(cp,editor).txt mark set insert $xth(cp,cursor)
      $xth(cp,editor).txt see $xth(cp,cursor)
      
    }
  }
  cd $cdir
  return $ret
}


proc xth_cp_data_tree_clear {} {
  global xth
  set tp $xth(ctrl,cp,dat).t 
  set xth(ctrl,cp,datrestore) {}
  foreach di $xth(ctrl,cp,datlist) {
    catch {
      append xth(ctrl,cp,datrestore) "catch \{$tp itemconfigure [lindex $di 1] -open [$tp itemcget [lindex $di 1] -open]\}\n";
    }
  }
  append xth(ctrl,cp,datrestore) "update idletasks\n"
  append xth(ctrl,cp,datrestore) "catch \{$tp xview moveto [lindex [$tp xview] 0]\}\n";
  append xth(ctrl,cp,datrestore) "catch \{$tp yview moveto [lindex [$tp yview] 0]\}\n";
  append xth(ctrl,cp,datrestore) "catch \{$tp selection set [$tp selection get]\}\n";
  append xth(ctrl,cp,datrestore) "update idletasks\n"
  catch {
    $tp delete [$tp nodes root]
  }
  set tp $xth(ctrl,cp,ms).t 
  set xth(ctrl,cp,msrestore) {}
  foreach di $xth(ctrl,cp,maplist) {
    catch {
      append xth(ctrl,cp,msrestore) "catch \{$tp itemconfigure [lindex $di 1] -open [$tp itemcget [lindex $di 1] -open]\}\n";
    }
  }
  append xth(ctrl,cp,msrestore) "update idletasks\n"
  append xth(ctrl,cp,msrestore) "catch \{$tp xview moveto [lindex [$tp xview] 0]\}\n";
  append xth(ctrl,cp,msrestore) "catch \{$tp yview moveto [lindex [$tp yview] 0]\}\n";
  append xth(ctrl,cp,msrestore) "catch \{$tp selection set [$tp selection get]\}\n";
  append xth(ctrl,cp,msrestore) "update idletasks\n"
  catch {
    $tp delete [$tp nodes root]
  }
  $xth(ctrl,cp,info).txt delete 1.0 end
  # prejde oba stromy a priradi rozvinutie/zvinutie do prikazov
  # plus ulozi poziciu
}

proc xth_cp_data_tree_insert {id parent level name fullname title stitle stat} {
  global xth
  if {[string length $title] < 1} {
    set title $name
    set stitle $name
  }
  lappend xth(ctrl,cp,datlist) [list $stitle $id $parent $level $name $fullname $title $stat]
}

proc xth_cp_data_tree_create {} {
  global xth
  if {[llength $xth(ctrl,cp,datlist)] == 0} {
    return
  }
  set nlist [lsort -dictionary -index 0 $xth(ctrl,cp,datlist)]
  set level 0
  set tocnt 1
  set copen 1
  set tp $xth(ctrl,cp,dat).t 
  while {$tocnt} {
    set tocnt 0
    foreach di $nlist {
      if {[lindex $di 3] == $level} {
        if {$level == 0} {
          set parent root
        } else {
          set parent [lindex $di 2]
        }
        catch {
          $tp insert end $parent [lindex $di 1] -data [list survey [lindex $di 5] [lindex $di 6] [lindex $di 7]] \
            -text [lindex $di 6] -image [Bitmap::get folder] -open $copen -font $xth(gui,lfont)
        }
      }
      if {[lindex $di 3] > $level} {
        set tocnt 1
      }
    }
    set copen 0
    incr level
  }
  catch {
    eval $xth(ctrl,cp,datrestore)
  }
}

proc xth_cp_map_tree_insert {type subtype id parent level name fullname title stitle} {
  global xth
  if {[string length $title] < 1} {
    set title $name
    set stitle $name
  }
  lappend xth(ctrl,cp,maplist) [list $stitle $id $parent $level $name $fullname $title $type $subtype]
}

proc xth_cp_map_tree_create {} {
  global xth
  if {[llength $xth(ctrl,cp,maplist)] == 0} {
    return
  }
  set nlist [lsort -dictionary -index 0 $xth(ctrl,cp,maplist)]
  set level 0
  set tocnt 1
  set copen 1
  set tp $xth(ctrl,cp,ms).t 
  while {$tocnt} {
    set tocnt 0
    foreach di $nlist {
      if {[lindex $di 3] == $level} {
        if {$level == 0} {
          set parent root
        } else {
          set parent [lindex $di 2]
        }
        set ccopen $copen
        switch [lindex $di 7] {
          map {
            if {[lindex $di 8]} {
              set ii [Bitmap::get file]
              set ccopen 0
            } else {
              set ii [Bitmap::get copy]
            }
          }
          scrap {
            set ii [Bitmap::get new]
          }
          default {
            set ii [Bitmap::get folder]
          } 
        }
        catch {
          $tp insert end $parent [lindex $di 1] -data [list [lindex $di 7] [lindex $di 5] [lindex $di 6]] \
            -text [lindex $di 6] -image $ii -open $ccopen -font $xth(gui,lfont)
        }
      }
      if {[lindex $di 3] > $level} {
        set tocnt 1
      }
    }
    set copen 0
    incr level
  }
  
  # odstrani projekcie bez map
  set prjs [$tp nodes root]
  foreach prj $prjs {
    set nds [$tp nodes $prj]
    switch [llength $nds] {
      0 {
        $tp delete $prj
      }
      1 {
        $tp itemconfigure $nds -open 1
      }
    }
  }

  catch {
    eval $xth(ctrl,cp,msrestore)
  }
}



proc xth_cp_data_tree_enter {node} {
  global xth
  set tp $xth(ctrl,cp,dat).t 
  xth_status_bar_push cp
  set d [$xth(ctrl,cp,dat).t itemcget $node -data]
  xth_status_bar_status cp [format "%s - %s (%s)" [lindex $d 0] [lindex $d 1] [lindex $d 2]]
}


proc xth_cp_data_tree_select {tpath node} {
  global xth
  set tp $tpath
  xth_status_bar_push cp
  set d [$tp itemcget $node -data]
  $xth(ctrl,cp,info).txt delete 1.0 end
  $xth(ctrl,cp,info).txt see 1.0
  $xth(ctrl,cp,info).txt insert 1.0 "name: [lindex $d 1]\ntitle: [lindex $d 2]\n[lindex $d 3]"
}



proc xth_cp_data_tree_leave {node} {
  xth_status_bar_pop cp
}

proc xth_cp_data_tree_double_click {node} {
  global xth
  set tp $xth(ctrl,cp,dat).t 
  set d [$tp itemcget $node -data]
  set i [$xth(cp,editor).txt index insert]  
  regexp {(\d+)\.} $i dum cln
  $xth(cp,editor).txt insert $cln.0 [format "select %s\n" [lindex $d 1]]
}

proc xth_cp_map_tree_enter {node} {
  global xth
  set tp $xth(ctrl,cp,ms).t 
  xth_status_bar_push cp
  set d [$xth(ctrl,cp,ms).t itemcget $node -data]
  xth_status_bar_status cp [format "%s - %s (%s)" [lindex $d 0] [lindex $d 1] [lindex $d 2]]
}

proc xth_cp_map_tree_leave {node} {
  xth_status_bar_pop cp
}

proc xth_cp_map_tree_double_click {node} {
  global xth
  set tp $xth(ctrl,cp,ms).t 
  set d [$tp itemcget $node -data]
  set i [$xth(cp,editor).txt index insert]  
  regexp {(\d+)\.} $i dum cln
  if {[string length [lindex $d 1]] > 0} {
    $xth(cp,editor).txt insert $cln.0 [format "select %s\n" [lindex $d 1]]
  }
}


proc xth_cp_show_errors {} {
  
  global xth
  
  set w $xth(cp,log).txt
  $w tag remove xtherr 1.0 end

  set rx {\S*[^\]\s]\s+\[\d+\]}
  set fnd [$w search -regexp -count cnt $rx 1.0 end]
  
  set i 0
  while {([string length $fnd] > 0) && ($i < 10000)} {
    
    set enx [$w index "$fnd + $cnt chars"]
    set ctext [$w get $fnd "$fnd lineend"]
    set cfnm {}
    regexp {\S+} $ctext cfnm
  
    if {![regexp {(\.mp|\.tex)\)?$} $cfnm]} {
      $w tag add xtherr $fnd $enx
    }

    set fnd [$w search -regexp -count cnt $rx $enx end]
    incr i    
    
  }
  
  $w tag configure xtherr -foreground red
  set prevcur [$xth(cp,log).txt cget -cursor]
  $w tag bind xtherr <Enter> "$w configure -cursor hand2"
  $w tag bind xtherr <Leave> "$w configure -cursor $prevcur"
  $w tag bind xtherr <1> "xth_cp_goto_error %x %y"
 
}



proc xth_cp_goto_error {x y} {
  global xth

  set epos [$xth(cp,log).txt get "@$x,$y wordstart" "@$x,$y lineend"]
  
  # skusime najst source error
  set fnm {}
  set fln {}
  if {(![regexp {\s*(\S+)\s+\[(\d+)\]} $epos dum fnm fln]) || [string equal $fnm "th"] || [string equal $fnm "th2"] || [string equal $fnm ".th"] || [string equal $fnm ".th2"]} {
    set epos [$xth(cp,log).txt get "@$x,$y linestart" "@$x,$y lineend"]
    regexp {\s*(\S+)\s+\[(\d+)\]} $epos dum fnm fln
  }
  
  if {([string length $fnm] == 0) || ([string length $fln] == 0)} {
    return
  }  
  
  if {[catch {set fln [expr $fln - 1]}]} {
    return
  }
  
  # potom sa pozrieme ci subor nemame otvoreny v kompilatore,
  # mapovom alebo textovom editore a skocime tam
  
  if $xth(cp,fopen) {
  
    set fullfnm [file join $xth(cp,fpath) $fnm]

    if {[string equal $fullfnm $xth(cp,ffull)]} {
      after idle "focus $xth(cp,editor).txt; $xth(cp,editor).txt see $fln.0; $xth(cp,editor).txt mark set insert $fln.0; $xth(cp,editor).txt tag remove sel 1.0 end; $xth(cp,editor).txt tag add sel $fln.0 \"$fln.0 lineend\""
      return
    }
    
    if {$xth(me,fopen) && [string equal $fullfnm $xth(me,ffull)]} {
      after idle "xth_app_show me; xth_me_goto_line [expr $fln + 1]"
      return
    }
  
    # skusime textovy editor, ci to mame otvorene
    foreach fx $xth(te,flist) {
      if {[string equal $fullfnm $xth(te,$fx,path)]} {
        after idle "xth_app_show te; xth_te_show_file $fx; $xth(te,$fx,frame).txt see $fln.0; $xth(te,$fx,frame).txt mark set insert $fln.0; $xth(te,$fx,frame).txt tag remove sel 1.0 end; $xth(te,$fx,frame).txt tag add sel $fln.0 \"$fln.0 lineend\""
        return
      }
    }
    
    after idle "xth_app_show te; xth_te_open_file 0 [list $fullfnm] $fln"
  
  }
  
  
}









#! /usr/bin/wish

# TODO:
# vstup hodiny : minuty

proc xth_bac_check {number from to wgt} {

  set rw 0
  if [catch {expr double($number)}] {
    set rw 1
  } else {
    set num [expr double($number)]
    if {($num < $from) || ($num > $to)} {
      set rw 1
    }
  }
  
  if {$rw} {
    $wgt configure -fg red
    return 0
  } else {
    $wgt configure -fg black
    return 1
  }
  
}

proc xth_bac_hm2h {h} {
  if {[regexp {(.+)\:(.+)} $h dum hh mm]} {
    if {[catch {
      set h [expr double($hh) + double($mm) / 60.0]
      return $h
    }]} {
      return $h
    }
  } else {
    return $h
  }
}

proc xth_bac_h2hm {h} {
  catch {
    set hh [expr int(floor($h))]
    set mm [expr int($h*60.0) % 60]
    if {$mm != 0.0} {
      set h [format "%d:%02d" $hh $mm]  
    } else {
      set h $hh
    }
  }
  return $h
}

proc xth_bac_calculate {} {

  global xth

  set xth(bac,BAC) ""
  set xth(bac,ETA) ""
  set xth(bac,MRS) ""
  set f $xth(gui,bacw)
  $f.rdle configure -bg $xth(bac,bg) -fg black

  set gender xth(bac,gender)
  set nok 0
  if [xth_bac_check $xth(bac,age) 0 1e10 $f.bdal] {set age $xth(bac,age)} else {set nok 1}
  if [xth_bac_check $xth(bac,height) 0 1e10 $f.bdhl] {set height $xth(bac,height)} else {set nok 1}
  if [xth_bac_check $xth(bac,weight) 0 1e10 $f.bdwl] {set weight $xth(bac,weight)} else {set nok 1}
  if [xth_bac_check $xth(bac,volume) 0 1e10 $f.cdvl] {set volume $xth(bac,volume)} else {set nok 1}
  if [xth_bac_check $xth(bac,level) 0 100 $f.cdll] {set level $xth(bac,level)} else {set nok 1}
  set xth(bac,time) [xth_bac_hm2h $xth(bac,time)]
  if [xth_bac_check $xth(bac,time) 0 1e10 $f.cdtl] {set elapsedTime [expr double($xth(bac,time))]} else {set nok 1}
  set xth(bac,time) [xth_bac_h2hm $xth(bac,time)]
  if $nok return

  set ALCOHOL_DENSITY 0.79
  set ingested [expr double($volume) * double($level) * 0.01 * $ALCOHOL_DENSITY]

  # in g/hr
	set METABOLIC_REMOVAL_RATE 7.0
	set remaining [expr $ingested - ($METABOLIC_REMOVAL_RATE * $elapsedTime)]
  if {$remaining < 0.0} {set remaining 0}
  
  if $xth(bac,gender) {
	  set HEIGHT_FACTOR 0.1074
    set WEIGHT_FACTOR 0.3362
    set AGE_FACTOR 0.09516
    set BODY_WATER_CONST 2.447
  } else {
    set HEIGHT_FACTOR 0.1069
    set WEIGHT_FACTOR 0.2466
    set AGE_FACTOR 0
    set BODY_WATER_CONST 2.097
  }
	set h [expr $HEIGHT_FACTOR * $height]
	set w [expr $WEIGHT_FACTOR * $weight]
	set a [expr $AGE_FACTOR * $age]
	set bodyWater [expr ($h - $a + $w + $BODY_WATER_CONST) * 1000.0]
  
	set WATER_CONTENT_OF_BLOOD 0.8157
	set BAC [expr 100.0 * ($remaining / ($bodyWater / $WATER_CONTENT_OF_BLOOD))]
	set MRS [expr 100.0 * ($METABOLIC_REMOVAL_RATE / ($bodyWater / $WATER_CONTENT_OF_BLOOD))]
  set maxRemaining [expr ($bodyWater / $WATER_CONTENT_OF_BLOOD) * 0.0002]
  if {$maxRemaining < $remaining} {
    set ETA [expr ($remaining - $maxRemaining) / $METABOLIC_REMOVAL_RATE]
  } else {
    set ETA 0.0
  }
  
  
  set xth(bac,BAC) [format "%.3f" $BAC]
  set xth(bac,ETA) [format "%d:%02d" [expr int(floor($ETA))] [expr int($ETA*60.0) % 60]]
  set xth(bac,MRS) [format "%.3f" $MRS]
  
  if {$BAC < 0.02} {
    $f.rdle configure -bg green -fg black
  } else {
    $f.rdle configure -bg red -fg white
  }

}


proc xth_bac_init {} {

  global xth
  
  set f $xth(gui,bacw)
  toplevel $f
  wm transient $f $xth(gui,main)
  wm title $f "BAC calculator"
  
  Label $f.bdl -text "Biometric data" -anchor center -font $xth(gui,lfont)
  Label $f.bdal -text "age" -anchor e -font $xth(gui,lfont)
  Entry $f.bdae -font $xth(gui,lfont) -width 5 -textvariable xth(bac,age)
  Label $f.bdau -text "years" -anchor w -font $xth(gui,lfont)
  Label $f.bdgl -text "gender" -anchor e -font $xth(gui,lfont)
  radiobutton $f.bdgm -text "male" -anchor w \
  -font $xth(gui,lfont) -variable xth(bac,gender) -value 1
  radiobutton $f.bdgf -text "female" -anchor w \
  -font $xth(gui,lfont) -variable xth(bac,gender) -value 0
  Label $f.bdhl -text "height" -anchor e -font $xth(gui,lfont)
  Entry $f.bdhe -font $xth(gui,lfont) -width 5 -textvariable xth(bac,height)
  Label $f.bdhu -text "cm" -anchor w -font $xth(gui,lfont)
  Label $f.bdwl -text "weight" -anchor e -font $xth(gui,lfont)
  Entry $f.bdwe -font $xth(gui,lfont) -width 5 -textvariable xth(bac,weight)
  Label $f.bdwu -text "kg" -anchor w -font $xth(gui,lfont)
  Separator $f.s1 -orient horizontal

  Label $f.cdl -text "Consumption data" -anchor center -font $xth(gui,lfont)
  Label $f.cdvl -text "volume" -anchor e -font $xth(gui,lfont)
  Entry $f.cdve -font $xth(gui,lfont) -width 5 -textvariable xth(bac,volume)
  Label $f.cdvu -text "ml" -anchor w -font $xth(gui,lfont)

  Label $f.cdll -text "alcohol level" -anchor e -font $xth(gui,lfont)
  Entry $f.cdle -font $xth(gui,lfont) -width 5 -textvariable xth(bac,level)
  Label $f.cdlu -text "%" -anchor w -font $xth(gui,lfont)
  
  Label $f.cdtl -text "time elapsed" -anchor e -font $xth(gui,lfont)
  Entry $f.cdte -font $xth(gui,lfont) -width 5 -textvariable xth(bac,time)
  Label $f.cdtu -text "hours" -anchor w -font $xth(gui,lfont)

  Button $f.calc -text "Calculate" -anchor center -font $xth(gui,lfont) \
  -command xth_bac_calculate

  Label $f.rdll -text "BAC" -anchor e -font $xth(gui,lfont)
  Entry $f.rdle -font $xth(gui,lfont) -width 5 -textvariable xth(bac,BAC) \
    -editable 0
  Label $f.rdlu -text "%" -anchor w -font $xth(gui,lfont)
  
  Label $f.rdtl -text "ETA" -anchor e -font $xth(gui,lfont)
  Entry $f.rdte -font $xth(gui,lfont) -width 5 -textvariable xth(bac,ETA) \
    -editable 0
  Label $f.rdtu -text "hours" -anchor w -font $xth(gui,lfont)

  Label $f.rdml -text "MRR" -anchor e -font $xth(gui,lfont)
  Entry $f.rdme -font $xth(gui,lfont) -width 5 -textvariable xth(bac,MRS) \
    -editable 0
  Label $f.rdmu -text "%/h" -anchor w -font $xth(gui,lfont)

  Button $f.cls -text "Close" -anchor center -font $xth(gui,lfont) \
  -command "destroy $f"

  
  grid columnconf $f 0 -weight 0
  grid columnconf $f 1 -weight 1
  grid columnconf $f 2 -weight 0

  grid $f.bdl -column 0 -row 0 -columnspan 3 -sticky news 
  grid $f.cdl -column 0 -row 7 -columnspan 3 -sticky news 

  grid $f.bdal -column 0 -row 1 -columnspan 1 -sticky news 
  grid $f.bdgl -column 0 -row 2 -rowspan 2 -sticky news 
  grid $f.bdhl -column 0 -row 4 -columnspan 1 -sticky news 
  grid $f.bdwl -column 0 -row 5 -columnspan 1 -sticky news 
  grid $f.cdvl -column 0 -row 8 -columnspan 1 -sticky news 
  grid $f.cdll -column 0 -row 9 -columnspan 1 -sticky news 
  grid $f.cdtl -column 0 -row 10 -columnspan 1 -sticky news 
  grid $f.rdll -column 0 -row 12 -columnspan 1 -sticky news 
  grid $f.rdtl -column 0 -row 13 -columnspan 1 -sticky news 
  grid $f.rdml -column 0 -row 14 -columnspan 1 -sticky news 

  grid $f.bdae -column 1 -row 1 -columnspan 1 -sticky news 
  grid $f.bdgf -column 1 -row 3 -columnspan 2 -sticky news 
  grid $f.bdgm -column 1 -row 2 -columnspan 2 -sticky news 
  grid $f.bdhe -column 1 -row 4 -columnspan 1 -sticky news 
  grid $f.bdwe -column 1 -row 5 -columnspan 1 -sticky news 
  grid $f.cdve -column 1 -row 8 -columnspan 1 -sticky news 
  grid $f.cdle -column 1 -row 9 -columnspan 1 -sticky news 
  grid $f.cdte -column 1 -row 10 -columnspan 1 -sticky news 
  grid $f.rdle -column 1 -row 12 -columnspan 1 -sticky news 
  grid $f.rdte -column 1 -row 13 -columnspan 1 -sticky news 
  grid $f.rdme -column 1 -row 14 -columnspan 1 -sticky news 

  grid $f.bdau -column 2 -row 1 -columnspan 1 -sticky news 
  grid $f.bdhu -column 2 -row 4 -columnspan 1 -sticky news 
  grid $f.bdwu -column 2 -row 5 -columnspan 1 -sticky news 
  grid $f.cdvu -column 2 -row 8 -columnspan 1 -sticky news 
  grid $f.cdlu -column 2 -row 9 -columnspan 1 -sticky news 
  grid $f.cdtu -column 2 -row 10 -columnspan 1 -sticky news 
  grid $f.rdlu -column 2 -row 12 -columnspan 1 -sticky news 
  grid $f.rdtu -column 2 -row 13 -columnspan 1 -sticky news 
  grid $f.rdmu -column 2 -row 14 -columnspan 1 -sticky news 

  grid $f.s1 -row 6 -column 0 -columnspan 3 -sticky news -pady 3 -padx 3
  grid $f.calc -row 11 -column 0 -columnspan 3 -sticky news -pady 3 -padx 3
  grid $f.cls -row 15 -column 0 -columnspan 3 -sticky news -pady 3 -padx 3

  set xth(bac,bg) [$f.rdle cget -bg]

  set sw [winfo screenwidth .]
  set sh [winfo screenheight .]
  update idletasks
  wm geometry $f -$sw-$sh
  set x [expr {($sw - [winfo width $f])/2}]
  set y [expr {($sh - [winfo height $f])/2}]
  wm geometry $f +$x+$y
  update idletasks
  
}


if 0 {
  package require BWidget
  source ver.tcl
  source global.tcl
  wm withdraw .
  set xth(gui,bacw) .f
  xth_bac_init
} else {
  set xth(bac,age) ""
  set xth(bac,height) ""
  set xth(bac,weight) ""
  set xth(bac,volume) ""
  set xth(bac,level) ""
  set xth(bac,time) ""
}

set xth(bac,gender) 1
set xth(bac,BAC) ""
set xth(bac,ETA) ""
set xth(bac,MRS) ""
  
if 0 {
  set xth(bac,age) "25"
  set xth(bac,height) "193"
  set xth(bac,weight) "90"
  set xth(bac,volume) "500"
  set xth(bac,level) "5.5"
  set xth(bac,time) "0"
}









xth_app_create cp "Compiler" 
xth_ctrl_add cp stp "Settings"
xth_ctrl_add cp dat "Survey structure"
xth_ctrl_add cp info "Survey info"
xth_ctrl_add cp ms "Map structure"
xth_ctrl_finish cp



# create config editor
set xth(cp,editor) $xth(gui,cp).af.apps.ed
frame $xth(cp,editor)
set txb $xth(cp,editor)
text $txb.txt -wrap none -font $xth(gui,efont) \
  -bg $xth(gui,ecolorbg) \
  -fg $xth(gui,ecolorfg) -insertbackground $xth(gui,ecolorfg) \
  -relief sunken -state disabled \
  -selectbackground $xth(gui,ecolorselbg) \
  -selectforeground $xth(gui,ecolorselfg) \
  -selectborderwidth 0 \
  -yscrollcommand "$txb.sv set" \
  -xscrollcommand "$txb.sh set" 
if {$xth(gui,text_undo)} {
    $txb.txt configure -undo 1 -maxundo -1
}
scrollbar $txb.sv -orient vert  -command "$txb.txt yview" \
  -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
scrollbar $txb.sh -orient horiz  -command "$txb.txt xview" \
  -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
grid columnconf $txb 0 -weight 1
grid rowconf $txb 0 -weight 1
grid $txb.txt -column 0 -row 0 -sticky news
grid $txb.sv -column 1 -row 0 -sticky news
grid $txb.sh -column 0 -row 1 -sticky news
bind $txb.txt <$xth(kb_control)-Key-x> "tk_textCut $txb.txt"
bind $txb.txt <$xth(kb_control)-Key-c> "tk_textCopy $txb.txt"
bind $txb.txt <$xth(kb_control)-Key-v> "tk_textPaste $txb.txt"
bind $txb.txt <$xth(kb_control)-Key-z> "catch {$txb.txt edit undo}"
bind $txb.txt <$xth(kb_control)-Key-y> "catch {$txb.txt edit redo}"

if {$xth(gui,bindinsdel)} {
  bind $txb.txt <Shift-Key-Delete> "tk_textCut $txb.txt"
  bind $txb.txt <$xth(kb_control)-Key-Insert> "tk_textCopy $txb.txt"
  bind $txb.txt <Shift-Key-Insert> "tk_textPaste $txb.txt"
#  catch {
#    bind $txb.txt <Shift-Key-KP_Decimal> "tk_textCut $txb.txt"
#    bind $txb.txt <$xth(kb_control)-Key-KP_Insert> "tk_textCopy $txb.txt"
#    bind $txb.txt <Shift-Key-KP_0> "tk_textPaste $txb.txt"
#  }
}

# nechame tab, return originalny
#if {[info exists xth(gui,te)]} {
#  bind $txb.txt <$xth(kb_control)-Key-a> "xth_te_text_select_all %W"
#  bind $txb.txt <$xth(kb_control)-Key-i> "xth_te_text_auto_indent %W"
  bind $txb.txt <Tab> $xth(te,bind,text_tab)
#  bind $txb.txt <Return> $xth(te,bind,text_return)
#} else {
#  bind $txb.txt <Tab> $xth(gui,bind,text_tab)
  bind $txb.txt <Return> $xth(gui,bind,text_return)
#}


# create log window
set xth(cp,log) $xth(gui,cp).af.apps.log
frame $xth(cp,log)
set txb $xth(cp,log)
text $txb.txt -wrap none -font $xth(gui,efont) \
  -bg $xth(gui,ecolorbg) \
  -fg $xth(gui,ecolorfg) -insertbackground $xth(gui,ecolorfg) \
  -relief sunken -state disabled \
  -selectbackground $xth(gui,ecolorselbg) \
  -selectforeground $xth(gui,ecolorselfg) \
  -selectborderwidth 0 \
  -yscrollcommand "$txb.sv set" \
  -xscrollcommand "$txb.sh set" 
scrollbar $txb.sv -orient vert  -command "$txb.txt yview" \
  -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
scrollbar $txb.sh -orient horiz  -command "$txb.txt xview" \
  -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
grid columnconf $txb 0 -weight 1
grid rowconf $txb 0 -weight 1
grid $txb.txt -column 0 -row 0 -sticky news
grid $txb.sv -column 1 -row 0 -sticky news
grid $txb.sh -column 0 -row 1 -sticky news
bind $txb.txt <$xth(kb_control)-Key-x> "tk_textCut $txb.txt"
bind $txb.txt <$xth(kb_control)-Key-c> "tk_textCopy $txb.txt"
bind $txb.txt <$xth(kb_control)-Key-v> "tk_textPaste $txb.txt"

if {$xth(gui,bindinsdel)} {
  bind $txb.txt <Shift-Key-Delete> "tk_textCut $txb.txt"
  bind $txb.txt <$xth(kb_control)-Key-Insert> "tk_textCopy $txb.txt"
  bind $txb.txt <Shift-Key-Insert> "tk_textPaste $txb.txt"
#  catch {
#    bind $txb.txt <Shift-Key-KP_Decimal> "tk_textCut $txb.txt"
#    bind $txb.txt <$xth(kb_control)-Key-KP_Insert> "tk_textCopy $txb.txt"
#    bind $txb.txt <Shift-Key-KP_0> "tk_textPaste $txb.txt"
#  }
}

xth_status_bar cp $txb.txt "Therion log file."


# pack editor and log widow
grid columnconf $xth(gui,cp).af.apps 0 -weight 1
grid rowconf $xth(gui,cp).af.apps 0 -weight 1
grid rowconf $xth(gui,cp).af.apps 1 -weight 1
grid $xth(cp,editor) -column 0 -row 0 -sticky news
grid $xth(cp,log) -column 0 -row 1 -sticky news

# create setup control
Label $xth(ctrl,cp,stp).wl -text "Working directory" -anchor w -font $xth(gui,lfont) -state disabled
xth_status_bar cp $xth(ctrl,cp,stp).wl "Working directory path."
Entry $xth(ctrl,cp,stp).we -font $xth(gui,lfont) -state disabled \
  -editable off -textvariable xth(cp,fpath)
xth_status_bar cp $xth(ctrl,cp,stp).we "Working directory path."

Label $xth(ctrl,cp,stp).fl -text "Configuration file" -anchor w -font $xth(gui,lfont) -state disabled
xth_status_bar cp $xth(ctrl,cp,stp).fl "Configuration file name."
Entry $xth(ctrl,cp,stp).fe -font $xth(gui,lfont) -state disabled \
  -editable off -textvariable xth(cp,fname)
xth_status_bar cp $xth(ctrl,cp,stp).fe "Configuration file name."

Label $xth(ctrl,cp,stp).optl -text "Command line options" -anchor w -font $xth(gui,lfont) -state disabled
xth_status_bar cp $xth(ctrl,cp,stp).optl "Therion command line options."
Entry $xth(ctrl,cp,stp).opte -font $xth(gui,lfont) -state disabled \
  -textvariable xth(cp,opts)
xth_status_bar cp $xth(ctrl,cp,stp).opte "Therion command line options."

Button $xth(ctrl,cp,stp).go -text "Compile" -anchor center -font $xth(gui,lfont) \
  -state disabled -command {xth_cp_compile} -width 4
Label $xth(ctrl,cp,stp).gores -text "" -anchor center -font $xth(gui,lfont) \
  -state disabled -width 4 -relief sunken
set xth(cp,resfg) [$xth(ctrl,cp,stp).gores cget -fg]
set xth(cp,resbg) [$xth(ctrl,cp,stp).gores cget -bg]
xth_status_bar cp $xth(ctrl,cp,stp).go "Run therion."

grid columnconf $xth(ctrl,cp,stp) 0 -weight 1
grid columnconf $xth(ctrl,cp,stp) 1 -weight 1
grid $xth(ctrl,cp,stp).wl -row 0 -column 0 -columnspan 2 -sticky news
grid $xth(ctrl,cp,stp).we -row 1 -column 0 -columnspan 2 -sticky news
grid $xth(ctrl,cp,stp).fl -row 2 -column 0 -columnspan 2 -sticky news
grid $xth(ctrl,cp,stp).fe -row 3 -column 0 -columnspan 2 -sticky news
grid $xth(ctrl,cp,stp).optl -row 4 -column 0 -columnspan 2 -sticky news
grid $xth(ctrl,cp,stp).opte -row 5 -column 0 -columnspan 2 -sticky news
grid $xth(ctrl,cp,stp).go -row 6 -column 0 -sticky news
grid $xth(ctrl,cp,stp).gores -row 6 -column 1 -sticky ew

# create objects control
set clbox $xth(ctrl,cp,dat)
scrollbar $clbox.sv -orient vert  -command "$clbox.t yview" \
  -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
scrollbar $clbox.sh -orient horiz  -command "$clbox.t xview" \
  -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
set tr [Tree $clbox.t -relief flat -height 16 -selectcommand xth_cp_data_tree_select \
  -yscrollcommand "$clbox.sv set" \
  -xscrollcommand "$clbox.sh set"]
set xth(ctrl,cp,datrestore) {}
$tr bindText <Enter> xth_cp_data_tree_enter
$tr bindText <Leave> xth_cp_data_tree_leave
$tr bindText <Double-ButtonPress-1> xth_cp_data_tree_double_click
$tr bindImage <Enter> xth_cp_data_tree_enter
$tr bindImage <Leave> xth_cp_data_tree_leave
$tr bindImage <Double-ButtonPress-1> xth_cp_data_tree_double_click

grid columnconf $clbox 0 -weight 1
grid rowconf $clbox 0 -weight 1
grid $tr -column 0 -row 0 -sticky news
grid $clbox.sv -column 1 -row 0 -sticky news
grid $clbox.sh -column 0 -row 1 -sticky news


# init survey info
set txb $xth(ctrl,cp,info)
text $txb.txt -height 4 -wrap none -font $xth(gui,efont) \
  -bg $xth(gui,ecolorbg) \
  -fg $xth(gui,ecolorfg) -insertbackground $xth(gui,ecolorfg) \
  -relief sunken -state disabled \
  -selectbackground $xth(gui,ecolorselbg) \
  -selectforeground $xth(gui,ecolorselfg) \
  -selectborderwidth 0 \
  -yscrollcommand "$txb.sv set" \
  -xscrollcommand "$txb.sh set" 
scrollbar $txb.sv -orient vert  -command "$txb.txt yview" \
  -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
scrollbar $txb.sh -orient horiz  -command "$txb.txt xview" \
  -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
grid columnconf $txb 0 -weight 1
grid rowconf $txb 0 -weight 1
grid $txb.txt -column 0 -row 0 -sticky news
grid $txb.sv -column 1 -row 0 -sticky news
grid $txb.sh -column 0 -row 1 -sticky news
xth_status_bar me $txb.txt "Survey informations."
bind $txb.txt <$xth(kb_control)-Key-x> "tk_textCut $txb.txt"
bind $txb.txt <$xth(kb_control)-Key-c> "tk_textCopy $txb.txt"
bind $txb.txt <$xth(kb_control)-Key-v> "tk_textPaste $txb.txt"

if {$xth(gui,bindinsdel)} {
  bind $txb.txt <Shift-Key-Delete> "tk_textCut $txb.txt"
  bind $txb.txt <$xth(kb_control)-Key-Insert> "tk_textCopy $txb.txt"
  bind $txb.txt <Shift-Key-Insert> "tk_textPaste $txb.txt"
#  catch {
#    bind $txb.txt <Shift-Key-KP_Decimal> "tk_textCut $txb.txt"
#    bind $txb.txt <$xth(kb_control)-Key-KP_Insert> "tk_textCopy $txb.txt"
#    bind $txb.txt <Shift-Key-KP_0> "tk_textPaste $txb.txt"
#  }
}



# create map structure control
set clbox $xth(ctrl,cp,ms)
scrollbar $clbox.sv -orient vert  -command "$clbox.t yview" \
  -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
scrollbar $clbox.sh -orient horiz  -command "$clbox.t xview" \
  -takefocus 0 -width $xth(gui,sbwidth) -borderwidth $xth(gui,sbwidthb)
set tr [Tree $clbox.t -relief flat -height 16 \
  -yscrollcommand "$clbox.sv set" \
  -xscrollcommand "$clbox.sh set"]
set xth(ctrl,cp,msrestore) {}
$tr bindText <Enter> xth_cp_map_tree_enter
$tr bindText <Leave> xth_cp_map_tree_leave
$tr bindText <Double-ButtonPress-1> xth_cp_map_tree_double_click
$tr bindImage <Enter> xth_cp_map_tree_enter
$tr bindImage <Leave> xth_cp_map_tree_leave
$tr bindImage <Double-ButtonPress-1> xth_cp_map_tree_double_click
grid columnconf $clbox 0 -weight 1
grid rowconf $clbox 0 -weight 1
grid $tr -column 0 -row 0 -sticky news
grid $clbox.sv -column 1 -row 0 -sticky news
grid $clbox.sh -column 0 -row 1 -sticky news






# load menu
$xth(cp,menu,file) add command -label "New" -command {} \
  -font $xth(gui,lfont) -underline 0 -state normal -command {xth_cp_new_file}
$xth(cp,menu,file) add command -label "Open" -underline 0 \
  -accelerator "$xth(gui,controlk)-o" -state normal \
  -font $xth(gui,lfont) -command {
    xth_cp_open_file {}
  }
$xth(cp,menu,file) add command -label "Save as" -underline 5 \
  -state disabled -font $xth(gui,lfont) -command xth_cp_save_as
$xth(cp,menu,file) add command -label "Close" -underline 0 \
  -accelerator "$xth(gui,controlk)-w"  -state disabled \
  -font $xth(gui,lfont) \
  -command xth_cp_close_file

set xth(cp,menu,edit) $xth(cp,menu).edit
menu $xth(cp,menu,edit) -tearoff 0
$xth(cp,menu) add cascade -label "Edit" -state disabled \
  -font $xth(gui,lfont) -menu $xth(cp,menu,edit) -underline 0
if {$xth(gui,text_undo)} {
  $xth(cp,menu,edit) add command -label "Undo" -font $xth(gui,lfont) \
    -accelerator "$xth(gui,controlk)-z" -command "xth_app_clipboard undo"
  $xth(cp,menu,edit) add command -label "Redo" -font $xth(gui,lfont) \
    -accelerator "$xth(gui,controlk)-y" -command "xth_app_clipboard redo"
  $xth(cp,menu,edit) add separator
}
$xth(cp,menu,edit) add command -label "Cut" -font $xth(gui,lfont) \
  -accelerator "$xth(gui,controlk)-x" -command "xth_app_clipboard cut"
$xth(cp,menu,edit) add command -label "Copy" -font $xth(gui,lfont) \
  -accelerator "$xth(gui,controlk)-c" -command "xth_app_clipboard copy"
$xth(cp,menu,edit) add command -label "Paste" -font $xth(gui,lfont) \
  -accelerator "$xth(gui,controlk)-v" -command "xth_app_clipboard paste"

set xth(cp,fopen) 0
set xth(cp,cursor) 1.0
set xth(cp,fname) ""
set xth(cp,opts) ""
set xth(cp,fpath) ""

xth_ctrl_minimize cp dat
xth_ctrl_minimize cp info
xth_ctrl_minimize cp ms

set xth(ctrl,cp,datlist) {}
set xth(ctrl,cp,maplist) {}







set xthmvw {}

if {![catch {set tomver [package require Tom]}]} {

xth_about_status "loading model viewer..."

namespace import ::GL::*

xth_app_create mv "Model viewer" 
xth_ctrl_add mv cam "Camera"
xth_ctrl_add mv mod "Model"
xth_ctrl_finish mv

# create config editor
set xthmvw $xth(gui,mv).af.apps.tom
set xthmvv(model,surftrans) 1
set xthmvv(model,headlight) 1
set xthmvv(model,lightinpos) 1

tom $xthmvw -doublebuffer 1 -depth 1

# pack editor and log widow
grid columnconf $xth(gui,mv).af.apps 0 -weight 1
grid rowconf $xth(gui,mv).af.apps 0 -weight 1
grid $xthmvw -column 0 -row 0 -sticky news

$xth(mv,menu,file) add command -label "Open" -underline 0 \
  -accelerator "$xth(gui,controlk)-o" -state normal \
  -font $xth(gui,lfont) -command {
    xth_mv_open_file {}
  }

$xth(mv,menu,file) add command -label "Reload" -underline 0 \
  -accelerator "$xth(gui,controlk)-r" -state normal \
  -font $xth(gui,lfont) -command {
    xth_mv_reload_file
  }

set f $xth(ctrl,mv,cam)
set xthmvv(ctrlframe) $f

menubutton $f.fb -text "facing" -anchor e -font $xth(gui,lfont) \
  -indicatoron true -menu $f.fb.m -width 4
Label $f.fl -textvariable xthmvv(cam,facing) -anchor e -font $xth(gui,lfont) -width 4 -padx 30
menu $f.fb.m -tearoff 0 -font $xth(gui,lfont)
$f.fb.m add command -label "north" -command {set xthmvv(cam,facing) 0.0; xth_mv_update}
$f.fb.m add command -label "east" -command {set xthmvv(cam,facing) 90.0; xth_mv_update}
$f.fb.m add command -label "west" -command {set xthmvv(cam,facing) 180.0; xth_mv_update}
$f.fb.m add command -label "south" -command {set xthmvv(cam,facing) 270.0; xth_mv_update}
$f.fb.m add separator
$f.fb.m add command -label "reset" -command {xth_mv_init_camera; xth_mv_update}
xth_status_bar mv $f.fb "Set facing angle."
xth_status_bar mv $f.fl "Facing angle."

checkbutton $f.fa -text "auto rotate" -anchor w -font $xth(gui,lfont) \
  -variable xthmvv(cam,autorotate) -command {
    if {$xthmvv(cam,autorotate)} {
      set xthmvv(autorotate,dir) [expr -1 * $xthmvv(autorotate,dir)]
    }
    xth_mv_camera_autorotate
  } -width 4
xth_status_bar mv $f.fa "Turn on/off camera auto rotation"

menubutton $f.pb -text "profile" -anchor e -font $xth(gui,lfont) \
  -indicatoron true -menu $f.pb.m -width 4
Label $f.pl -textvariable xthmvv(cam,profile) -anchor e -font $xth(gui,lfont) -width 4 -padx 30
menu $f.pb.m -tearoff 0 -font $xth(gui,lfont)
$f.pb.m add command -label "top" -command {set xthmvv(cam,profile) 90.0; xth_mv_update}
$f.pb.m add command -label "side" -command {set xthmvv(cam,profile) 0.0; xth_mv_update}
$f.pb.m add command -label "bottom" -command {set xthmvv(cam,profile) -90.0; xth_mv_update}
$f.pb.m add separator
$f.pb.m add command -label "reset" -command {xth_mv_init_camera; xth_mv_update}
xth_status_bar mv $f.pb "Set profile angle."
xth_status_bar mv $f.pl "Profile angle."
scale $f.pscale -orient horiz -showvalue 0 -from -90.0 -to 90.0 \
  -resolution 1.0 -variable xthmvv(cam,profile)
  
grid columnconf $f 0 -weight 1
grid columnconf $f 1 -weight 1
grid $f.fb -row 0 -column 0 -sticky news
grid $f.fl -row 0 -column 1 -sticky news
grid $f.fa -row 1 -column 0 -columnspan 2 -sticky news
grid $f.pb -row 2 -column 0 -sticky news
grid $f.pl -row 2 -column 1 -sticky news
grid $f.pscale -row 3 -column 0 -columnspan 2 -sticky news


set f $xth(ctrl,mv,mod)
set xthmvv(modelframe) $f

checkbutton $f.st -text "surface transparency" -anchor w -font $xth(gui,lfont) \
  -variable xthmvv(model,surftrans) -command xth_mv_reload_file -width 4
xth_status_bar mv $f.st "Turn on/off surface transparency."

checkbutton $f.hl -text "light follows camera" -anchor w -font $xth(gui,lfont) \
  -variable xthmvv(model,headlight) -command xth_mv_update -width 4
xth_status_bar mv $f.hl "Fix light source to camera position."

grid columnconf $f 0 -weight 1
grid columnconf $f 1 -weight 1
grid $f.st -row 0 -column 0 -columnspan 2 -sticky news
grid $f.hl -row 1 -column 0 -columnspan 2 -sticky news

xth_ctrl_maximize mv cam
xth_ctrl_maximize mv mod

# IF, CI SA MV NEKONA
} 









if {[string length $xthmvw] > 0} {

proc xth_mv_configure_camera {w h} {
  global xthmvw xthmvv
  if {[string length $w] > 0} {
    glViewport 0 0 $w $h 
  } else {
    set w [winfo width $xthmvw]
    set h [winfo height $xthmvw]
  }

  set diam $xthmvv(model,diam)
  set dist $xthmvv(cam,dist)

  set prof [expr double($xthmvv(cam,profile)) / 180.0 * 3.14159265359]
  set face [expr double($xthmvv(cam,facing)) / 180.0 * 3.14159265359]

  set hdist [expr cos($prof)]
  set fwdx [expr $hdist * sin($face)]
  set fwdy [expr $hdist * cos($face)]
  set fwdz [expr - sin($prof)]
  
  set cx $xthmvv(cam,cx)
  set cy $xthmvv(cam,cy)
  set cz $xthmvv(cam,cz)

  set fromx [expr $cx - $fwdx * $dist]
  set fromy [expr $cy - $fwdy * $dist]
  set fromz [expr $cz - $fwdz * $dist]
  
#  set hdist [expr cos($prof) * $dist]
#  set fromx [expr $cx - $hdist * sin($face)]
#  set fromy [expr $cy - $hdist * cos($face)]
#  set fromz [expr $cz + sin($prof) * $dist]

  set hdist [expr sin($prof)]
  set upx [expr $hdist * sin($face)]
  set upy [expr $hdist * cos($face)]
  set upz [expr cos($prof)]
  
  set rightx [expr cos($face)]
  set righty [expr - sin($face)]
  set rightz 0.0

  set xthmvv(cam,fwdx) $fwdx
  set xthmvv(cam,fwdy) $fwdy
  set xthmvv(cam,fwdz) $fwdz
  
  set xthmvv(cam,upx) $upx
  set xthmvv(cam,upy) $upy
  set xthmvv(cam,upz) $upz

  set xthmvv(cam,rightx) $rightx
  set xthmvv(cam,righty) $righty
  set xthmvv(cam,rightz) $rightz

  set pnear [expr sqrt($fromx * $fromx + $fromy * $fromy + $fromz * $fromz) - 2.0 * $diam]
  if {$pnear < 1.0} {
    set pnear 1.0
  }
  set pfar [expr $pnear + 4.0 * $diam]

  glMatrixMode $GL::GL_PROJECTION
  glLoadIdentity
  gluPerspective 40.0 [expr double($w) / double($h)] $pnear $pfar

  glMatrixMode $GL::GL_MODELVIEW
  glLoadIdentity
  if {$xthmvv(model,headlight) || $xthmvv(model,lightinpos)} {
    glLightfv $GL::GL_LIGHT0 $GL::GL_POSITION [list 0.0 0.0 1.0 0.0]
    set xthmvv(model,lightinpos) 0
  }
  if {$xthmvv(model,headlight)} {
    set xthmvv(model,lx) $fromx
    set xthmvv(model,ly) $fromy
    set xthmvv(model,lz) $fromz
  }
  gluLookAt $fromx $fromy $fromz $cx $cy $cz $upx $upy $upz
  if {!$xthmvv(model,headlight)} {
    glLightfv $GL::GL_LIGHT0 $GL::GL_POSITION [list $xthmvv(model,lx) $xthmvv(model,ly) $xthmvv(model,lz)  0.0]
  } else {
    glLightfv $GL::GL_LIGHT0 $GL::GL_POSITION [list $fromx $fromy $fromz 0.0]
  }
  
}

proc xth_mv_update {} {
  global xthmvv
  xth_mv_configure_camera {} {}
  xth_mv_draw
  set xthmvv(cam,profile) [expr double($xthmvv(cam,profile))]
  set xthmvv(cam,facing) [expr double($xthmvv(cam,facing))]
}

proc xth_mv_draw {} {
  global xthmvw xthmvv
  # nakreslime si model
  glEnable $GL::GL_BLEND
  glClear [expr $GL::GL_COLOR_BUFFER_BIT | $GL::GL_DEPTH_BUFFER_BIT]
  glCallList $xthmvv(list,bbox)
  glCallList $xthmvv(list,model)
  xth_mv_gl_wireframe
  glFlush
  $xthmvw swap
}

proc xth_mv_gl_wireframe {} {
  glShadeModel $GL::GL_FLAT
  glPolygonMode $GL::GL_FRONT_AND_BACK $GL::GL_LINE
  glDisable $GL::GL_LIGHTING
  glDepthMask $GL::GL_TRUE
  glDisable $GL::GL_BLEND
}

proc xth_mv_gl_walls {} {
  glShadeModel $GL::GL_SMOOTH
  glPolygonMode $GL::GL_FRONT_AND_BACK $GL::GL_FILL
  glEnable $GL::GL_LIGHTING
  glColor4f 1.0 1.0 1.0 1.0
  glDepthMask $GL::GL_TRUE
  glDisable $GL::GL_BLEND
  glLightModeliv $GL::GL_LIGHT_MODEL_TWO_SIDE $GL::GL_FALSE
  glMaterialfv $::GL::GL_FRONT_AND_BACK $::GL::GL_AMBIENT {0.0 0.0 0.0 1.0}
  glMaterialfv $::GL::GL_FRONT_AND_BACK $::GL::GL_DIFFUSE {1.0 1.0 1.0 1.0}
  glMaterialfv $::GL::GL_FRONT_AND_BACK $::GL::GL_SPECULAR {0.0 0.0 0.0 1.0}
  glMaterialfv $::GL::GL_FRONT_AND_BACK $::GL::GL_SHININESS 0.5
}

proc xth_mv_gl_surface {} {
  global xthmvv
  glShadeModel $GL::GL_SMOOTH
  glPolygonMode $GL::GL_FRONT_AND_BACK $GL::GL_FILL
  glEnable $GL::GL_LIGHTING
  if $xthmvv(model,surftrans) {
    glEnable $GL::GL_BLEND
    glDepthMask $GL::GL_FALSE
  } else {
    glDepthMask $GL::GL_TRUE
    glDisable $GL::GL_BLEND
  }
  glLightModeliv $GL::GL_LIGHT_MODEL_TWO_SIDE $GL::GL_TRUE
  glColor4f 0.0 1.0 0.0 1.0
  glMaterialfv $::GL::GL_FRONT $::GL::GL_AMBIENT {0.0 0.0 0.0 1.0}
  glMaterialfv $::GL::GL_FRONT $::GL::GL_DIFFUSE {0.3 1.0 0.1 0.5}
  glMaterialfv $::GL::GL_FRONT $::GL::GL_SPECULAR {0.0 0.0 0.0 1.0}
  glMaterialfv $::GL::GL_FRONT $::GL::GL_SHININESS 0.5
  glMaterialfv $::GL::GL_BACK  $::GL::GL_AMBIENT {0.0 0.0 0.0 1.0}
  glMaterialfv $::GL::GL_BACK  $::GL::GL_DIFFUSE {0.4 0.28 0.055 0.5}
  glMaterialfv $::GL::GL_BACK  $::GL::GL_SPECULAR {0.0 0.0 0.0 1.0}
  glMaterialfv $::GL::GL_BACK  $::GL::GL_SHININESS 0.5
}

proc xth_mv_init {} {

  global xthmvw xthmvv xth
  glClearColor 0.0 0.0 0.0 0.0
  glEnable $GL::GL_DEPTH_TEST
  glEnable $GL::GL_LIGHT0
  glLightfv $GL::GL_LIGHT0 $GL::GL_AMBIENT {0.2 0.2 0.2 1.0}
  glLightfv $GL::GL_LIGHT0 $GL::GL_DIFFUSE {0.8 0.8 0.8 1.0}

  glBlendFunc $GL::GL_SRC_ALPHA $GL::GL_ONE_MINUS_SRC_ALPHA
  #glEnable $GL::GL_BLEND
  
  # vytvorime default model
  set xthmvv(list,model) 1
  set xthmvv(list,bbox) 2
  glDeleteLists $xthmvv(list,model) 1
  glNewList $xthmvv(list,model) $GL::GL_COMPILE
  xth_mv_gl_walls
  set xthmvv(model,maxx) 1.0
  set xthmvv(model,maxy) 1.0
  set xthmvv(model,maxz) 1.0
  set xthmvv(model,minx) -1.0
  set xthmvv(model,miny) -1.0
  set xthmvv(model,minz) -1.0
#  if {[string equal $xth(gui,platform) windows]} {
#    set q [gluNewQuadric]
#    gluSphere $q 1.0 20 16
#    gluDeleteQuadric $q
#  }
  glEndList
}


proc xth_mv_reload_file {} {
  global xth xthmvv
  if {[catch {source $xth(mv,ffull)} opnerr]} {
      MessageDlg $xth(gui,message) -parent $xth(gui,main) \
        -icon error -type ok \
        -message $opnerr\
        -font $xth(gui,lfont)
      return 0
  }
  xth_mv_init_model 0
}


proc xth_mv_open_file {fpath} {

  global xthmvv xth

  if {[string length $fpath] == 0} {
    set fpath [tk_getOpenFile -filetypes $xth(app,mv,filetypes) \
      -parent $xth(gui,main) -initialdir $xth(gui,initdir)]
  }
  
  if {[string length $fpath] == 0} {
    return 0
  } else {
    set xth(gui,initdir) [file dirname $fpath]
  }

  xth_status_bar_push mv
  xth_status_bar_status mv "Opening $fpath ..."
  
  if {[catch {source $fpath} opnerr]} {
      MessageDlg $xth(gui,message) -parent $xth(gui,main) \
        -icon error -type ok \
        -message $opnerr\
        -font $xth(gui,lfont)
      xth_status_bar_pop mv
      return 0
  }

  set xth(mv,fopen) 1
  set xth(mv,fname) [file tail $fpath]
  set xth(mv,fpath) [file dirname $fpath]
  set xth(mv,ffull) $fpath
  
  xth_mv_init_model 1
  xth_app_title mv
  xth_status_bar_pop mv
  
  update idletasks
  return 1

}


proc xth_mv_init_camera {} {
  global xthmvv

  set xthmvv(cam,profile) 20.0
  set xthmvv(cam,facing) 160.0
  set mx $xthmvv(model,maxx)
  set my $xthmvv(model,maxy)
  set mz $xthmvv(model,maxz)
  set nx $xthmvv(model,minx)  
  set ny $xthmvv(model,miny)  
  set nz $xthmvv(model,minz)
  set xthmvv(cam,cx) [expr ($mx + $nx) / 2.0]
  set xthmvv(cam,cy) [expr ($my + $ny) / 2.0]
  set xthmvv(cam,cz) [expr ($mz + $nz) / 2.0]

  set xthmvv(cam,autorotate) 0
  set xthmvv(autorotate,dir) 1
  set xthmvv(autorotate,counter) 0
  if {$xthmvv(model,diam) > 0} {
    set xthmvv(cam,dist) [expr 4.0 * $xthmvv(model,diam)]
  } else {
    set xthmvv(cam,dist) 1.0
  }

}


proc xth_mv_init_model {initcam} {
  global xthmvv
  set mx $xthmvv(model,maxx)
  set my $xthmvv(model,maxy)
  set mz $xthmvv(model,maxz)
  set nx $xthmvv(model,minx)  
  set ny $xthmvv(model,miny)  
  set nz $xthmvv(model,minz)
  set dx [expr ($mx - $nx) / 2.0]
  set dy [expr ($my - $ny) / 2.0]
  set dz [expr ($mz - $nz) / 2.0]
  set diam [expr sqrt($dx * $dx + $dy * $dy + $dz * $dz)]
  set xthmvv(model,diam) $diam
  glDeleteLists $xthmvv(list,bbox) 1
  glNewList $xthmvv(list,bbox) $GL::GL_COMPILE
  xth_mv_gl_wireframe
  glBegin $GL::GL_LINE_STRIP
  glColor4f 1.0 0.0 0.0 1.0
  glVertex3f [expr $mx] [expr $my] [expr $mz]
  glVertex3f [expr $nx] [expr $my] [expr $mz]
  glVertex3f [expr $nx] [expr $ny] [expr $mz]
  glVertex3f [expr $mx] [expr $ny] [expr $mz]
  glVertex3f [expr $mx] [expr $my] [expr $mz]
  glVertex3f [expr $mx] [expr $my] [expr $nz]
  glVertex3f [expr $nx] [expr $my] [expr $nz]
  glVertex3f [expr $nx] [expr $my] [expr $mz]
  glVertex3f [expr $nx] [expr $my] [expr $nz]
  glVertex3f [expr $nx] [expr $ny] [expr $nz]
  glVertex3f [expr $nx] [expr $ny] [expr $mz]
  glVertex3f [expr $nx] [expr $ny] [expr $nz]
  glVertex3f [expr $mx] [expr $ny] [expr $nz]
  glVertex3f [expr $mx] [expr $ny] [expr $mz]
  glVertex3f [expr $mx] [expr $ny] [expr $nz]
  glVertex3f [expr $mx] [expr $my] [expr $nz]
  glVertex3f [expr $mx] [expr $my] [expr $mz]
  glEnd
  glEndList
  if {$initcam} {
    xth_mv_init_camera
  }
  xth_mv_update
}

proc xth_mv_change_profile {v} {
  xth_mv_update
}


proc xth_mv_start_drag {x y} {
  global xthmvv
  set xthmvv(drag,x) $x
  set xthmvv(drag,y) $y
  set xthmvv(drag,facing) $xthmvv(cam,facing)
  set xthmvv(drag,dist) $xthmvv(cam,dist)
}


proc xth_mv_start_shift {x y} {
  global xthmvv
  set xthmvv(shift,x) $x
  set xthmvv(shift,y) $y
  set xthmvv(shift,cx) $xthmvv(cam,cx)
  set xthmvv(shift,cy) $xthmvv(cam,cy)
  set xthmvv(shift,cz) $xthmvv(cam,cz)
}

proc xth_mv_start_walk {x y} {
  global xthmvv
  set xthmvv(walk,x) $x
  set xthmvv(walk,y) $y
  set xthmvv(walk,cx) $xthmvv(cam,cx)
  set xthmvv(walk,cy) $xthmvv(cam,cy)
  set xthmvv(walk,cz) $xthmvv(cam,cz)
}

proc xth_mv_continue_drag {x y} {
  global xthmvv
  set dx [expr $x - $xthmvv(drag,x)]
  set dy [expr $y - $xthmvv(drag,y)]
  if {!$xthmvv(cam,autorotate)} {
    set xthmvv(cam,facing) [expr double(int($dx + $xthmvv(drag,facing)) % 360)]
  }  
  set xthmvv(cam,dist) [expr $xthmvv(drag,dist) * pow(2.0, $dy/100.0)]
  xth_mv_update
}


proc xth_mv_check_center {} {
  global xthmvv
  set cx $xthmvv(cam,cx)
  set cy $xthmvv(cam,cy)
  set cz $xthmvv(cam,cz)
  set mx $xthmvv(model,maxx)
  set my $xthmvv(model,maxy)
  set mz $xthmvv(model,maxz)
  set nx $xthmvv(model,minx)  
  set ny $xthmvv(model,miny)  
  set nz $xthmvv(model,minz)
  if {$cx < $nx} {
    set xthmvv(cam,cx) $nx
  } elseif {$cx > $mx} {
    set xthmvv(cam,cx) $mx
  } 
  if {$cy < $ny} {
    set xthmvv(cam,cy) $ny
  } elseif {$cy > $my} {
    set xthmvv(cam,cy) $my
  } 
  if {$cz < $nz} {
    set xthmvv(cam,cz) $nz
  } elseif {$cz > $mz} {
    set xthmvv(cam,cz) $mz
  } 
}


proc xth_mv_continue_shift {x y} {
  global xthmvv
  set dx [expr double($x - $xthmvv(shift,x)) / 500.0 * $xthmvv(cam,dist)]
  set dy [expr double($y - $xthmvv(shift,y)) / 500.0 * $xthmvv(cam,dist)]
  if {!$xthmvv(cam,autorotate)} {
    set xthmvv(cam,cx) [expr $xthmvv(shift,cx) - $dx * $xthmvv(cam,rightx) + $dy * $xthmvv(cam,upx)]
    set xthmvv(cam,cy) [expr $xthmvv(shift,cy) - $dx * $xthmvv(cam,righty) + $dy * $xthmvv(cam,upy)]
    set xthmvv(cam,cz) [expr $xthmvv(shift,cz) - $dx * $xthmvv(cam,rightz) + $dy * $xthmvv(cam,upz)]
    xth_mv_check_center    
    xth_mv_update
  }  
}

proc xth_mv_continue_walk {x y} {
  global xthmvv
  set dy [expr double($y - $xthmvv(walk,y)) / 200.0 * $xthmvv(cam,dist)]
  if {!$xthmvv(cam,autorotate)} {
    set xthmvv(cam,cx) [expr $xthmvv(walk,cx) - $dy * $xthmvv(cam,fwdx)]
    set xthmvv(cam,cy) [expr $xthmvv(walk,cy) - $dy * $xthmvv(cam,fwdy)]
    set xthmvv(cam,cz) [expr $xthmvv(walk,cz) - $dy * $xthmvv(cam,fwdz)]
    xth_mv_check_center    
    xth_mv_update
  }  
}

proc xth_mv_camera_autorotate {} {
  global xthmvv
  if {$xthmvv(cam,autorotate)} {
    set xthmvv(cam,facing) [expr double(int($xthmvv(cam,facing) + $xthmvv(autorotate,dir)) % 360)]
    xth_mv_update
    if {$xthmvv(autorotate,counter) == 0} {
      set xthmvv(autorotate,watch) [clock clicks -milliseconds]
    }
    incr xthmvv(autorotate,counter)
    if {$xthmvv(autorotate,counter) == 50} {
      catch {
        $xthmvv(ctrlframe).fa configure -text "auto rotate ([format %.1f [expr 50000.0 / double([clock clicks -milliseconds] - $xthmvv(autorotate,watch))]] fps)"                 
      }
      set xthmvv(autorotate,counter) 0
      after 10 xth_mv_camera_autorotate
    } else {
      after idle xth_mv_camera_autorotate
    }
  } else {
    $xthmvv(ctrlframe).fa configure -text "auto rotate" 
    set xthmvv(autorotate,fps) {}
    set xthmvv(autorotate,counter) 0
    set xthmvv(cam,autorotate) 0
  }
}

bind $xthmvw <Configure> {
  xth_mv_configure_camera %w %h
  xth_mv_draw
}
bind $xthmvw <Expose> xth_mv_draw
bind $xthmvw <1> {xth_mv_start_drag %x %y}
bind $xthmvw <B1-Motion> {xth_mv_continue_drag %x %y}
bind $xthmvw <B1-ButtonRelease> {xth_mv_continue_drag %x %y}

bind $xthmvw <3> {xth_mv_start_shift %x %y}
bind $xthmvw <B3-Motion> {xth_mv_continue_shift %x %y}
bind $xthmvw <B3-ButtonRelease> {xth_mv_continue_shift %x %y}

bind $xthmvw <2> {xth_mv_start_walk %x %y}
bind $xthmvw <B2-Motion> {xth_mv_continue_walk %x %y}
bind $xthmvw <B2-ButtonRelease> {xth_mv_continue_walk %x %y}

case $xth(gui,platform) {
  unix {
    bind $xthmvw <4> {
      set xthmvv(cam,profile) [expr $xthmvv(cam,profile) - 10.0]
      xth_mv_update
    }
    bind $xthmvw <5> {
      set xthmvv(cam,profile) [expr $xthmvv(cam,profile) + 10.0]
      xth_mv_update
    }
  }
  windows {
    bind $xth(gui,main) <MouseWheel> {
      switch $xth(app,active) {
        mv {
          set xthmvv(cam,profile) [expr $xthmvv(cam,profile) - double(%D)/12.0]
          xth_mv_update
        }
      }
    }
  }
}

$xth(ctrl,mv,cam).pscale configure -command xth_mv_change_profile

xth_mv_init
xth_mv_init_model 1

# IF, CI SA MV KONA
} 







xth_app_finish
xth_app_clock

encoding system $xth(app,sencoding)
set xth(encoding_system) [encoding system]
if {[string length $xth(about,nvr)] > 0} {
  xth_about_status $xth(prj,title)
  after $xth(about,infotime) xth_about_hide
} else {
  xth_about_hide
}

wm deiconify $xth(gui,main)
xth_app_normalize

foreach xapp $xth(app,list) {
  catch {
    set xth(app,$xapp,relw) $xth(app,$xapp,tbwidth)
    xth_app_show $xapp
  }
}

if {[llength $xth(app,list)] > 2} {
  xth_app_show [lindex $xth(app,list) 2]
} else {
  xth_app_show [lindex $xth(app,list) 0]
}


set th2open 1
set cfgopen 1

foreach fname $argv {
  if {$cfgopen && [regexp -nocase {thconfig|thcfg} $fname]} {
    set cfgopen 0
    xth_app_show cp
    update idletasks
    xth_cp_open_file $fname
  } elseif {$th2open && [regexp -nocase {\.th2$} $fname]} {
    set th2open 0
    xth_app_show me
    update idletasks
    xth_me_open_file 0 $fname 1
  } elseif {[regexp -nocase {\.thm$} $fname]} {
    if {[string length $xthmvw] > 0} {
      xth_app_show mv
      update idletasks
      xth_mv_open_file $fname
    }
  } else {
    xth_app_show te
    update idletasks
    xth_te_open_file 0 $fname 1
  }
}







