##+##########################################################################
 #
 # azimuth.tcl - plots distance/azimuth which locates a benchmark
 # by Keith Vetter, March 3, 2004
 #
 package require Tk
 
 set S(title) "Azimuth Plotting"
 set colors {
    yellow cyan green magenta steelblue red gold
    darkturquoise chartreuse3 violetred
 }
 set PI [expr {atan(1)*4}]
 
 proc PlotIt {} {
    Clear
    set xy [GetPoints]                          ;# Get raw, unscaled points
    if {$xy == {}} return
    set s [GetScale $xy]
 
    foreach {x y id txt anchor} $xy {           ;# Scale and plot each point
        set px [expr {$x * $s}]
        set py [expr {$y * $s}]
        set color [lindex $::colors $id]
        set txt [TwoLines $txt]
        .c create line 0 0 $px $py -tag [list az az$id]
        .c create oval [MakeBox $px $py 3] -fil $color -tag [list az az$id]
        .c create text $px $py -text $txt -anchor $anchor -tag [list az az$id]
        .c bind az$id <Enter> [list HighlightRow $id]
    }
    .c raise stn
    DrawScale $s
 }
 proc DoDisplay {} {
    global S
    
    wm title . $S(title)
    label .x ; .x configure  -font "[font actual [.x cget -font]] -weight bold"
    option add *font [.x cget -font] ; destroy .x
    frame .screen -bd 2 -relief raised
    frame .ctrl -relief ridge -bd 2 -padx 5 -pady 5
    canvas .c -bd 0 -height 500 -width 500 -highlightthickness 0 -bg lightgreen
    canvas .s -bd 0 -width 500 -height 30 -highlightthickness 0 -bg lightgreen
    
    grid .screen .ctrl -row 0 -sticky news
    grid rowconfigure . 0 -weight 1
    grid columnconfigure . 0 -weight 2
    grid columnconfigure . 1 -weight 1
    
    grid .c -in .screen -sticky news -row 0
    grid .s -in .screen -sticky ews
    grid rowconfigure .screen 1 -weight 1
    grid columnconfigure .screen 0 -weight 1
 
    DrawSymbol 0 0 10 
    .c bind stn <Enter> {HighlightRow -1}
 
    image create photo ::img::blank -width 1 -height 1
    set txt "$::S(title)\nby Keith Vetter, March 2004\n\n"
    append txt "see http://www.geocaching.com/mark/ for details"
    button .about -image ::img::blank -highlightthickness 0 -command \
        [list tk_messageBox -title "About $::S(title)" -message $txt]
        
    place .about -in .ctrl -relx 1 -rely 1 -anchor nw
    bind all <Key-F2> {console show}
    bind .c <Configure> {ReCenter %W %h %w}
 
    DoCtrlFrame
    update
 }
 proc DoCtrlFrame {} {
    
    grid [frame .cmid] -in .ctrl -sticky ew -pady 10
    label .what -text "What"
    label .dist -text Distance
    label .azim -text "Azimuth"
    grid .dist .azim .what -in .cmid -row 0 -sticky ew
    for {set i 0} {$i < 10} {incr i} {
        entry .d_$i -textvariable data(dist,$i) -width 8
        entry .a_$i -textvariable data(azim,$i) -width 8
        entry .w_$i -textvariable data(what,$i) -width 18
        grid .d_$i .a_$i .w_$i -in .cmid -sticky ew
    }
    grid columnconfigure .cmid 2 -weight 1
    frame .fbuttons
    button .reset -text Reset -command Reset
    button .clear -text Clear -command Clear
    button .plot -text "Plot It" -command PlotIt
    
    grid .fbuttons -in .ctrl -sticky ew
    grid columnconfig .fbuttons {0 1 2 3} -weight 1    
    grid .reset .clear .plot -in .fbuttons -ipadx 10
 
    tk_optionMenu .example S(who) "Example 1" "Example 2" "Example 3" \
        "Example 4" "Example 5" "Example 6"
    trace add variable ::S(who) write DoExample
    grid .example -in .ctrl -row 100
    
    grid rowconfigure .ctrl 50 -weight 1
    grid columnconfigure .ctrl 0 -weight 1
 }
 proc ReCenter {W h w} {                   ;# Called by configure event
    set ::S(h2) [expr {$h / 2}] ; set ::S(w2) [expr {$w / 2}]
    $W config -scrollregion [list -$::S(w2) -$::S(h2) $::S(w2) $::S(h2)]
    North
    PlotIt
 }
 proc DrawSymbol {x y r} {
    foreach {X0 Y0 X1 Y1} [MakeBox $x $y $r] break
    foreach {x0 y0 x1 y1} [MakeBox $x $y [expr {sqrt($r*$r /2.0)}]] break
 
    .c create oval $X0 $Y0 $X1 $Y1 -tag stn -fill yellow -outline red 
    .c create line $x0 $y0 $x1 $y1 -tag stn -fill red
    .c create line $x0 $y1 $x1 $y0 -tag stn -fill red
    .c create line $X0 $y  $X1 $y  -tag stn -fill red
    .c create line $x  $Y0 $x  $Y1 -tag stn -fill red
 }
 proc MakeBox {x y d} {
    return [list [expr {$x-$d}] [expr {$y-$d}] [expr {$x+$d}] [expr {$y+$d}]]
 }
 proc Clear {} {
    .c delete az
    .s delete all
    HighlightRow -1
 }
 proc Reset {} {
    Clear
    foreach arr [array names ::data] { set ::data($arr) ""}
 }
 proc GetPoints {} {
    set xy {}
    for {set i 0} {$i < 10} {incr i} {
        if {[scan $::data(dist,$i) "%g" d] == -1} break ;# Stupid octal
        if {[scan $::data(azim,$i) "%g" a] == -1} break ;# Stupid octal
 
        set a1 [expr {360 - ($a - 90)}]         ;# Convert to cartesian angle
        set a2 [expr {$a1 * $::PI / 180.0}]     ;# Convert to radians
        set x [expr {$d * cos($a2)}]
        set y [expr {-1 * $d * sin($a2)}]
        set anchor [expr {($a >= 90 && $a <= 270) ? "n" : "s"}]
        lappend xy $x $y $i $::data(what,$i) $anchor
    }
    return $xy
 }
 proc GetScale {xy} {
    if {$xy == {}} {return 1}                   ;# Be safe
    
    set mx [set my 0]                           ;# Get max X and Y
    foreach {x y . . .} $xy {
        if {abs($x) > $mx} {set mx [expr {abs($x)}]}
        if {abs($y) > $my} {set my [expr {abs($y)}]}
    }
    set wx [expr {[winfo width .c] / 2 - 40}]
    if {$wx < 0} {set wx 1}
    set wy [expr {[winfo height .c] / 2 - 40}]
    if {$wy < 0} {set wy 1}
 
    set sx [expr {$wx / $mx}]
    set sy [expr {$wy / $my}]
    return [expr {$sx < $sy ? $sx : $sy}]
 }
 proc HighlightRow {row} {
    set bg [lindex [.w_0 config -bg] 3]
    for {set i 0} {$i < 10} {incr i} {
        set color [expr {$i == $row ? [lindex $::colors $i] : $bg}]
        .w_$i config -bg $color
        .d_$i config -bg $color
        .a_$i config -bg $color
    }
 }
 proc DrawScale {sscale} {
    set w .s
    set width [expr {.9 * [winfo width $w]}]
    set ppf $sscale                             ;# Pixels per feet
 
    set ft [expr {$width / $ppf}]               ;# How many miles per width
    if {$ft < 1} return
    foreach {limit tBig tMed} {
        1000 500 100 500 500 100
         400 200 100 200 100  50
         100  50  10  50  50  10 
          10   5   1   5   5   1
           1   1   1
    } {
        if {$ft > $limit} {
            set ft $limit
            break
        }
    }
    set x1 [expr {$ft * $ppf}]                  ;# End of scale
    set lh 25                                   ;# Where to draw line
 
    $w delete all
    $w create line 0 $lh $x1 $lh
    set numTicks [expr {$ft / $tMed}]
    for {set tick 0} {$tick <= $numTicks} {incr tick} {
        set dist [expr {$tick * $tMed}]
        set ::dist $dist
        set big [expr {($dist % $tBig) == 0}]
        set h [expr {$big ? 12 : 6}]
        set x [expr {0 + $tick * $tMed * $ppf}]
        $w create line $x $lh $x [expr {$lh - $h}]
        if {$big} {
            $w create text $x [expr {$lh-10}] -text $dist -anchor s -tag ft
        }
    }
    foreach {. . x y} [$w bbox ft] break
    $w create text $x $y -text "ft" -anchor sw
 
    # Center the scale 
    foreach {x0 . x1 .} [$w bbox all] break
    set dx [expr {([winfo width $w] - ($x0 + $x1)) / 2.0}]
    $w move all $dx 0
 }
 
 proc North {} {
    global S
    
    .c delete north
    set x [expr {30 - $S(w2)}]
    set y [expr {5 - $S(h2)}]
    .c create text $x $y -tag north -anchor n -text "N" -font [.what cget -font]
    set y1 [lindex [.c bbox north] 3]
    set y2 [expr {$y1 + 80}]
    .c create line $x $y1 $x $y2 -tag north -width 5 -arrow first
 }
 proc TwoLines {txt} {
    regsub -all {\s+} [string trim $txt] " " txt ;# Compress spaces
 
    set len [string length $txt]
    if {$len < 19} { return $txt }
    set best $len
    foreach index [regexp -all -inline -indices {\s} $txt] {
        set index [lindex $index 0]
        set err [expr {$len / 2 - $index}]
        if {abs($err) < $best} {set best $err}
    }
    if {$best == $len} { return [list $txt ""] }
    set idx [expr {$len / 2 - $best}]
    set result "[string range $txt 0 [expr {$idx-1}]]\n"
    append result [string range $txt [expr {$idx+1}] end]
    return $result
 }
 proc DoExample {args} {
    global S data example
 
    Reset
    regexp {\d+} $S(who) who
    array set data $example($who)
    PlotIt
 }
 set example(1) {
    id AH7625
    dist,0  39.2 azim,0 293 what,0 "Maple tree"
    dist,1  43.5 azim,1 125 what,1 "Mail box #1603"
    dist,2 101.6 azim,2  33 what,2 "Corner stone pier"
    dist,3 111.7 azim,3 109 what,3 "Corner stone pier"
 }
 set example(2) {
    id AH7654
    dist,0 18.7 azim,0 125 what,0 "Power pole 550-20/40T"
    dist,1 87.4 azim,1 270 what,1 "Sign post for turning lanes"
    dist,2  9.0 azim,2 204 what,2 "Guy anchor"
 }
 set example(3) {
    id AH7624
    dist,0  76.4 azim,0  31 what,0 {The east corner of the baseball dugout} 
    dist,1  73.7 azim,1 357 what,1 {The west corner of the baseball dugout} 
    dist,2  49.7 azim,2 347 what,2 {one inch in diameter balsm tree} 
    dist,3 137.5 azim,3 142 what,3 {Gas line marker} 
 }
 set example(4) {
    id AH7656
    dist,0 43.2 azim,0 25  what,0 "Utility pole with the number 0065 084/552B4-6"
    dist,1 8.6  azim,1 90  what,1 "The centerline of overhead electric wires"
    dist,2 124  azim,2 184  what,2 "Utility pole"
 }
 set example(5) {
    id AH7608
    dist,0 36.8  azim,0 208  what,0 "Fence gate post"
    dist,1 44.4  azim,1 229  what,1 "Fence gate post"
    dist,2 55.9  azim,2 320  what,2 "28 inch sugar maple tree"
    dist,3 68.2  azim,3 10  what,3 "Mail box post"
 }
 set example(6) {
    id AH7641
    dist,0 16.1  azim,0 15  what,0 "Two foot by two foot square grate drop inlet"
    dist,1 23.4  azim,1 275  what,1 "One foot by two feet metal drop inlet at the curb"
    dist,2 62.9  azim,2 149  what,2 "Power pole with the number 505D4-167"
    dist,3 65.6  azim,3 286  what,3 "Street and stop sign pole"
 }
 
 DoDisplay
 set S(who) "Example 1"