Description: Use more colours and shortcuts in xtherion
  Use different colours to distinguish walls, rocks, slopes, pits
  Add keyboard shortcuts for zooming and deleting

Author: Vladimir Geogiev <vld.georgiev@gmail.com>
Origin: http://mailman.speleo.sk/pipermail/therion/2016-February/005798.html
Reviewed-By: Wookey <wookey@wookware.org>
Last-Update: 2016-02-19

Index: therion-5.3.16/xtherion/app.tcl
===================================================================
--- therion-5.3.16.orig/xtherion/app.tcl
+++ therion-5.3.16/xtherion/app.tcl
@@ -258,12 +258,16 @@ proc xth_app_finish {} {
   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) <$xth(kb_control)-Key-D> xth_app_control_shift_d
   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
+  bind $xth(gui,main) <$xth(kb_control)-Up> xth_app_control_up
+  bind $xth(gui,main) <$xth(kb_control)-Down> xth_app_control_down
+
   foreach aname $xth(app,list) {
     $xth($aname,menu) add cascade -label [mc "Window"] -menu $m -underline 0 \
       -font $xth(gui,lfont)
@@ -465,6 +469,12 @@ proc xth_app_control_d {} {
   }
 }  
 
+proc xth_app_control_shift_d {} {
+  global xth
+  switch $xth(app,active) {
+    me  {xth_me_cmds_delete_linept {} {}}
+  }
+}
 
 proc xth_app_control_l {} {
   global xth
@@ -486,6 +496,26 @@ proc xth_app_escape {} {
   }
 }
 
+proc xth_app_control_up {} {
+  global xth
+  switch $xth(app,active) {
+    me {
+			if {$xth(me,zoom)*2 > 800} return;
+      xth_me_area_zoom_to [ expr {$xth(me,zoom) * 2} ]
+    }
+  }
+}
+
+proc xth_app_control_down {} {
+  global xth
+  switch $xth(app,active) {
+    me {
+			if {$xth(me,zoom)*2 < 12} return;
+			xth_me_area_zoom_to [ expr {$xth(me,zoom) / 2} ]
+    }
+  }
+}
+
 
 proc xth_app_show {aname} {
 
Index: therion-5.3.16/xtherion/me_cmds.tcl
===================================================================
--- therion-5.3.16.orig/xtherion/me_cmds.tcl
+++ therion-5.3.16/xtherion/me_cmds.tcl
@@ -1989,24 +1989,42 @@ proc xth_me_cmds_update_point {id nx ny
 
 proc xth_me_cmds_calc_point_coords {id} {
   global xth
-  set x1 [expr [xth_me_real2canx $xth(me,cmds,$id,x)] - $xth(gui,me,point,psize)]
-  set y1 [expr [xth_me_real2cany $xth(me,cmds,$id,y)] - $xth(gui,me,point,psize)]
-  set x2 [expr [xth_me_real2canx $xth(me,cmds,$id,x)] + $xth(gui,me,point,psize)]
-  set y2 [expr [xth_me_real2cany $xth(me,cmds,$id,y)] + $xth(gui,me,point,psize)]
-  return [list $x1 $y1 $x2 $y2]
- # 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)]
- # ]
+  switch $xth(me,cmds,$id,type) {
+    station {
+      # draw a triangle for the station points
+      set x1 [expr [xth_me_real2canx $xth(me,cmds,$id,x)] - $xth(gui,me,point,psize)]
+      set y1 [expr [xth_me_real2cany $xth(me,cmds,$id,y)] + $xth(gui,me,point,psize)]
+      set x2 [expr [xth_me_real2canx $xth(me,cmds,$id,x)] + $xth(gui,me,point,psize)]
+      set y2 [expr [xth_me_real2cany $xth(me,cmds,$id,y)] + $xth(gui,me,point,psize)]
+      set x3 [expr [xth_me_real2canx $xth(me,cmds,$id,x)]]
+      set y3 [expr [xth_me_real2cany $xth(me,cmds,$id,y)] - $xth(gui,me,point,psize)/2]
+      return [list $x1 $y1 $x2 $y2 $x3 $y3]
+      }
+    default {
+      set x1 [expr [xth_me_real2canx $xth(me,cmds,$id,x)] - $xth(gui,me,point,psize)]
+      set y1 [expr [xth_me_real2cany $xth(me,cmds,$id,y)] - $xth(gui,me,point,psize)]
+      set x2 [expr [xth_me_real2canx $xth(me,cmds,$id,x)] + $xth(gui,me,point,psize)]
+      set y2 [expr [xth_me_real2cany $xth(me,cmds,$id,y)] + $xth(gui,me,point,psize)]
+      return [list $x1 $y1 $x2 $y2]
+    }
+  }
 }
 
 
 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
+  set coords [xth_me_cmds_calc_point_coords $id]
+  switch $xth(me,cmds,$id,type) {
+    station {
+      # draw a triangle for the station points
+      $xth(me,can) create polygon [xth_me_cmds_calc_point_coords $id] \
+        -tags "command point pt$id" -width 1 -outline blue -fill blue
+    }
+    default {
+      $xth(me,can) create oval $coords \
+        -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,sbar)\""
   $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"
Index: therion-5.3.16/xtherion/me_cmds2.tcl
===================================================================
--- therion-5.3.16.orig/xtherion/me_cmds2.tcl
+++ therion-5.3.16/xtherion/me_cmds2.tcl
@@ -3091,7 +3091,7 @@ proc xth_me_cmds_set_colors {} {
   set llen [llength $xth(me,cmds,xlist)]
   set cid $xid
 
-  set dcol #fff222
+  set dcol $xth(gui,me,unselectedfill)
   set scol $xth(gui,me,pasivefill)
   if {$xth(me,cmds,$xth(me,cmds,selid),ct) == 4} {
     set col $dcol
@@ -3106,27 +3106,66 @@ proc xth_me_cmds_set_colors {} {
 
   set xth(me,curscrap) {}
   set godown 1
+  set selectedscrap 1
   if {$cid < 0} {
     set cid [expr $xid + 1]
     set godown 0
+    set selectedscrap 0
   }
   while {(($cid >= 0) && ($cid < $llen)) || ($godown)} {
     set id [lindex $xth(me,cmds,xlist) $cid]
     switch $xth(me,cmds,$id,ct) {
-      2 {        
+      2 {   # point
+        if {$selectedscrap} {
+          switch $xth(me,cmds,$id,type) {
+            station {
+              set col $xth(gui,me,stationcolor)
+            }
+            default {
+              set col $scol
+            }
+          }
+        }
         $xth(me,can) itemconfigure pt$id -outline $col -fill $col -state normal
         if {$xth(me,hinactives) && ($col == $dcol)} {
           $xth(me,can) itemconfigure pt$id -state hidden
         }
       }
-      3 {
+
+      3 {  # line/line point
+        if {$selectedscrap} {
+          switch $xth(me,cmds,$id,type) {
+            wall {
+              set col $xth(gui,me,wallcolor)
+            }
+            pit {
+              set col $xth(gui,me,pitcolor)
+            }
+            slope {
+              set col $xth(gui,me,slopecolor)
+            }
+            "rock-border" - "rock-edge" {
+              set col $xth(gui,me,rockcolor)
+            }
+            border {
+              set col $xth(gui,me,bordercolor)
+            }
+            default {
+              set col $scol
+            }
+          }
+        }
         $xth(me,can) itemconfigure lnpt$id -outline $col -fill $col -state normal
         $xth(me,can) itemconfigure lnln$id -fill $col -state normal
         if {$xth(me,hinactives) && ($col == $dcol)} {
           $xth(me,can) itemconfigure ln$id -state hidden  
         }
       }
-      4 - 5 {
+
+      4 - 5 { # scrap/endscrap
+        if {(($xth(me,cmds,$id,ct) == 4) && ($godown) && ($selectedscrap)) || (($xth(me,cmds,$id,ct) == 5) && ($selectedscrap))} {
+          set selectedscrap 0
+        }
         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]} {
@@ -3147,6 +3186,7 @@ proc xth_me_cmds_set_colors {} {
       if {$cid < 0} {
         set cid [expr $xid + 1]
         set godown 0
+        set selectedscrap 1
         set col $ocol
       }
     } else {
@@ -3706,4 +3746,3 @@ proc xth_me_cmds_line_poly2bezier {} {
   xth_me_cmds_set_mode 0
   return
 }
-  
\ No newline at end of file
Index: therion-5.3.16/xtherion/tools.tcl
===================================================================
--- therion-5.3.16.orig/xtherion/tools.tcl
+++ therion-5.3.16/xtherion/tools.tcl
@@ -219,13 +219,13 @@ frame $xth(gui,tb).edif
 
 button $xth(gui,tb).edif.zoo+b -image {zoom+_img} \
 		-command {
-			if {$::xth(me,zoom)*2 > 400} return
+			if {$::xth(me,zoom)*2 > 800} return
 			xth_me_area_zoom_to [expr {$::xth(me,zoom) * 2}]
 		} -state disabled
   xth_status_bar me $xth(gui,tb).edif.zoo+b [mc "Zoom in"]
 button $xth(gui,tb).edif.zoo-b -image {zoom-_img} \
 		-command {
-			if {$::xth(me,zoom)/2 < 25} return
+			if {$::xth(me,zoom)/2 < 12} return
 			xth_me_area_zoom_to [expr {$::xth(me,zoom) / 2}]
 		} -state disabled
 xth_status_bar me $xth(gui,tb).edif.zoo-b [mc "Zoom out"]
Index: therion-5.3.16/xtherion/xtherion.ini
===================================================================
--- therion-5.3.16.orig/xtherion/xtherion.ini
+++ therion-5.3.16/xtherion/xtherion.ini
@@ -77,7 +77,7 @@
 # set xth(gui,me,point,psize) 4
 
 ## size of line point
-# set xth(gui,me,line,psize) 4
+# set xth(gui,me,line,psize) 3
 
 ## line width
 # set xth(gui,me,line,width) 3
@@ -97,6 +97,20 @@
 ## whether inactive scraps should be hidden by default
 # set xth(me,hinactives) 0 
 
+## Drawing item colors
+## for color names, see http://wiki.tcl.tk/37701
+## RGB values can be written as  #F1B2C3
+#set xth(gui,me,activefill) red
+#set xth(gui,me,pasivefill) green
+#set xth(gui,me,controlfill) blue
+#set xth(gui,me,highlightfill) cyan
+#set xth(gui,me,unselectedfill) lightgray
+#set xth(gui,me,wallcolor) brown
+#set xth(gui,me,pitcolor) magenta
+#set xth(gui,me,slopecolor) gold
+#set xth(gui,me,rockcolor) snow4
+#set xth(gui,me,bordercolor) turquoise
+#set xth(gui,me,stationcolor) darkorange
 
 ## DXF/SVG import settings
 ## size of imported image in pixels
Index: therion-5.3.16/xtherion/global.tcl
===================================================================
--- therion-5.3.16.orig/xtherion/global.tcl
+++ therion-5.3.16/xtherion/global.tcl
@@ -183,11 +183,11 @@ set xth(gui,me,point,psize) 4
 #########################################
 # LINE
 # size of line point
-set xth(gui,me,line,psize) 4
+set xth(gui,me,line,psize) 3
 # line width
 set xth(gui,me,line,width) 3
 # size of line control point
-set xth(gui,me,line,cpsize) 4
+set xth(gui,me,line,cpsize) 3
 # width of line between point and control point
 set xth(gui,me,line,clwidth) 2
 # size of start line tick
@@ -195,10 +195,18 @@ set xth(gui,me,line,ticksize) 15
 # width of start line tick
 set xth(gui,me,line,tickwidth) 3
 
+# for color names, see http://wiki.tcl.tk/37701
 set xth(gui,me,activefill) red
-set xth(gui,me,pasivefill) blue
+set xth(gui,me,pasivefill) green
 set xth(gui,me,controlfill) blue
 set xth(gui,me,highlightfill) cyan
+set xth(gui,me,unselectedfill) lightgray
+set xth(gui,me,wallcolor) brown
+set xth(gui,me,pitcolor) magenta
+set xth(gui,me,slopecolor) gold
+set xth(gui,me,rockcolor) snow4
+set xth(gui,me,bordercolor) turquoise
+set xth(gui,me,stationcolor) darkorange
 
 set xth(gui,me,typelistwidth) 16
 set xth(gui,rmb) 3