#
# This file is part of:
#
#  gpsman --- GPS Manager: a manager for GPS receiver data
#
# Copyright (c) 1998-2013 Miguel Filgueiras migfilg@t-online.de
#
#    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 3 of the License, or
#      (at your option) 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.
#
#  File: cluster.tcl
#  Last change:  6 October 2013
#

proc DistCluster {w dtxt dist args} {
    # make (possibly non-disjoint) groups of WPs that are at less than
    #  given distance (in kilometres) from a WP in GR in window $w
    # if $args != "", first element is taken as the minimum distance WPs
    #   should be from the centre WP, and other elements as increasing
    #   bounds for new clusters
    # $dtxt is external representation of distance range
    # undefined WPs will be left out
    global WPName WPPosn WPDatum TXT Cluster MESS

    set Cluster(info) $TXT(collcntr)
    update idletasks
    switch [set wpixs [GMGRCollectWPs $w]] {
	void -
	error { return }
    }
    if { $args != "" } {
	set min [lindex $args 0]
    } else { set min 0 }
    set wgs ""
    foreach ix $wpixs {
	if { $ix != -1 } { lappend wgs $ix }
    }
    if { $wgs == "" } {
	GMMessage $MESS(allundef)
	return
    }
    set cls0 ""
    if { $min == 0 } {
	set cls0 [Apply $wgs NameOf WP]
    } else {
	set cls0 ""
	foreach w $wgs { lappend cls0 "" }
    }
    set bds [lreplace $args 0 0 $dist]
    if { [set n [llength $bds]] > 1 } {
	set l ""
	foreach w $wgs { lappend l "" }
	for { set i 1 } { $i < $n } { incr i } { set cls$i $l }
    }
    set Cluster(info) $TXT(compclstr)
    update idletasks
    if { $Cluster(abort) } { return }
    set nseen 0
    foreach ix [array names WPName] {
	set pos $WPPosn($ix) ; set datum $WPDatum($ix)
	if { [incr nseen]%10 == 0 } {
	    update
	    if { $Cluster(abort) } { return }
	}
	set i 0
	foreach wpix $wgs {
	    if { $ix != $wpix } {
		set db [CompDistBearDatums $WPPosn($wpix) $WPDatum($wpix) \
			                   $pos $datum]
		if { [set d [lindex $db 0]] >= $min } {
		    set k 0
		    foreach bd $bds {
			if { $d <= $bd } {
			    set cl [lindex [set cls$k] $i]
			    lappend cl $WPName($ix)
			    set cls$k [lreplace [set cls$k] $i $i $cl]
			    break
			}
			incr k
		    }
		}
	    }
	    incr i
	}
    }
    set Cluster(info) $TXT(crtgclstrgrs)
    update idletasks
    if { $Cluster(abort) } { return }
    set n 0 ; set k 0
    foreach bd $bds {
	foreach wpix $wgs cl [set cls$k] {
	    if { $cl != "" } {
		CreateGRFor cluster "$TXT(centre): $WPName($wpix)\n$dtxt" \
		    [list [list WP $cl]]
	    }
	}
	set min $bd
	incr k
    }
    return
}

proc QuadrCluster {w dlat dlong} {
    # make (possibly non-disjoint) groups of WPs that belong to each
    #  quadrangle $dlatx$dlong centred at a WP in GR in window $w
    # undefined WPs will be left out
    global WPName WPPosn WPDatum TXT MESS Cluster

    set Cluster(info) $TXT(collcntr)
    update idletasks
    switch [set wpixs [GMGRCollectWPs $w]] {
	void -
	error { return }
    }
    set wgs ""
    foreach ix $wpixs {
	if { $ix != -1 } { lappend wgs $ix }
    }
    if { $wgs == "" } {
	GMMessage $MESS(allundef)
	return
    }
    set gd "" ; set datum $WPDatum([lindex $wgs 0])
    foreach cix $wgs {
	set cl($cix) ""
	set p $WPPosn($cix)
	if { $WPDatum($cix) != $datum } {
	    set p [ToDatum [lindex $p 0] [lindex $p 1] $WPDatum($cix) $datum]
	}
	set gd [AddToGData $gd [lindex $p 0] [lindex $p 1] $cix]
    }
    set Cluster(info) $TXT(compclstr)
    update idletasks
    if { $Cluster(abort) } { return }
    set nseen 0
    foreach ix [array names WPName] {
	if { [incr nseen]%1000 == 0 } {
	    update
	    if { $Cluster(abort) } { return }
	}	    
	set p $WPPosn($ix)
	if { $WPDatum($ix) != $datum } {
	    set p [ToDatum [lindex $p 0] [lindex $p 1] $WPDatum($ix) $datum]
	}
	foreach cix [LookupQuadrGData $gd [lindex $p 0] [lindex $p 1] \
		$dlat $dlong] {
	    lappend cl($cix) $WPName($ix)
	}
    }
    set Cluster(info) $TXT(crtgclstrgrs)
    update idletasks
    if { $Cluster(abort) } { return }
    set dlatext [ExtDegrees DMSsimpl $dlat]
    set dlongext [ExtDegrees DMSsimpl $dlong]
    set n 0
    foreach cix $wgs {
	if { $cl($cix) != "" } {
	    CreateGRFor cluster \
		"$TXT(centre): $WPName($cix)\n${dlatext}x$dlongext" \
		[list [list WP $cl($cix)]]
	}
    }
    return
}

proc MakeClusters {w} {
    # create dialog for gathering the parameters needed for making clusters
    #  centred at the WPs in GR window $w
    global Cluster PositionFormat TXT EPOSX EPOSY COLOUR MAPCOLOUR \
	    DISTUNIT DLUNIT

    destroy .clstr
    GMToplevel .clstr cluster +$EPOSX+$EPOSY {} \
        {WM_DELETE_WINDOW {destroy .clstr}} \
        [list <Key-Return> "DoMakeClusters $w"]
    catch { unset Cluster }
    set Cluster(how) inquadr
    set Cluster(min) 0

    frame .clstr.fr -relief flat -borderwidth 5 -bg $COLOUR(selbg)
    label .clstr.fr.title -text $TXT(mkclusters) -relief sunken
    set frs .clstr.fr.frsel
    frame $frs -relief flat -borderwidth 0
    set cw 74 ; set ch 54
    set cw2 [expr $cw/2] ; set ch2 [expr $ch/2]
    radiobutton $frs.riq -text $TXT(quadr) -variable Cluster(how) \
	    -value inquadr -anchor w -selectcolor $COLOUR(check)
    canvas $frs.ciq -width $cw -height $ch -relief flat \
	    -bg $COLOUR(bg)
    $frs.ciq create rectangle [expr $cw2-30] [expr $ch2-20] \
	    [expr $cw2+30] [expr $ch2+20] -fill $MAPCOLOUR(mapsel)
    $frs.ciq create line [expr $cw2-3] $ch2 [expr $cw2+4] $ch2
    $frs.ciq create line $cw2 [expr $ch2-4] $cw2 [expr $ch2+4]
    frame $frs.eiq -relief flat -borderwidth 0
    label $frs.eiq.tla -text $TXT(dlat)
    entry $frs.eiq.ela -textvariable Cluster(dlat)
    bind $frs.eiq.ela <Any-Key> { set Cluster(how) inquadr }
    label $frs.eiq.tlo -text $TXT(dlong)
    entry $frs.eiq.elo -textvariable Cluster(dlong)
    bind $frs.eiq.elo <Any-Key> { set Cluster(how) inquadr }
    set Cluster(pformt) $PositionFormat
    menubutton $frs.eiq.mf -text $TXT($PositionFormat) -relief raised \
	    -direction below -menu $frs.eiq.mf.m -width 6
    menu $frs.eiq.mf.m -tearoff 0
    foreach f "DMS DMM DDD" {
	set t $TXT($f)
	$frs.eiq.mf.m add command -label $t \
		-command "$frs.eiq.mf configure -text {$t} ; \
			  set Cluster(pformt) $f"
    }
    grid configure $frs.eiq.tla -row 0 -column 0 -sticky w
    grid configure $frs.eiq.ela -row 0 -column 1 -sticky nesw
    grid configure $frs.eiq.tlo -row 1 -column 0 -sticky w
    grid configure $frs.eiq.elo -row 1 -column 1 -sticky nesw
    grid configure $frs.eiq.mf -row 0 -rowspan 2 -column 3 -sticky ew

    radiobutton $frs.rbd -text $TXT(distance) -variable Cluster(how) \
	    -value bydist -anchor w -selectcolor $COLOUR(check)
    canvas $frs.cbd -width $cw -height $ch -relief flat \
	    -bg $COLOUR(bg)
    $frs.cbd create oval [expr $cw2-20] [expr $ch2-20] \
	    [expr $cw2+20] [expr $ch2+20] -fill $MAPCOLOUR(mapsel)
    $frs.cbd create oval [expr $cw2-10] [expr $ch2-10] \
	    [expr $cw2+10] [expr $ch2+10] -fill $COLOUR(bg)
    $frs.cbd create line [expr $cw2-3] $ch2 [expr $cw2+4] $ch2
    $frs.cbd create line $cw2 [expr $ch2-4] $cw2 [expr $ch2+4]
    frame $frs.ebd -relief flat -borderwidth 0
    label $frs.ebd.tmn -text $TXT(min)
    entry $frs.ebd.emn -textvariable Cluster(min)
    bind $frs.ebd.emn <Any-Key> { set Cluster(how) bydist }
    label $frs.ebd.tmx -text $TXT(max)
    entry $frs.ebd.emx -textvariable Cluster(max)
    bind $frs.ebd.emx <Any-Key> { set Cluster(how) bydist }
    set Cluster(unit) dist=$DISTUNIT
    menubutton $frs.ebd.mu -text $DLUNIT($DISTUNIT,dist) -relief raised \
	    -direction below -menu $frs.ebd.mu.m -width 6
    menu $frs.ebd.mu.m -tearoff 0
    set us ""
    foreach u "KM NAUTMILE STATMILE" {
	foreach t "dist subdist" {
	    set nm $DLUNIT($u,$t)
	    if { [lsearch -exact $us $nm] == -1 } {
		$frs.ebd.mu.m add command -label $nm \
			-command "$frs.ebd.mu configure -text {$nm} ; \
			          set Cluster(unit) $t=$u"
		lappend us $nm
	    }
	}
    }
    grid configure $frs.ebd.tmn -row 0 -column 0 -sticky w
    grid configure $frs.ebd.emn -row 0 -column 1 -sticky nesw
    grid configure $frs.ebd.tmx -row 1 -column 0 -sticky w
    grid configure $frs.ebd.emx -row 1 -column 1 -sticky nesw
    grid configure $frs.ebd.mu -row 0 -rowspan 2 -column 3 -sticky ew

    grid configure $frs.riq -row 0 -column 0 -sticky nesw
    grid configure $frs.ciq -row 0 -column 1 -sticky nesw
    grid configure $frs.eiq -row 1 -column 1 -sticky w
    grid configure $frs.rbd -row 2 -column 0 -sticky nesw
    grid configure $frs.cbd -row 2 -column 1 -sticky nesw
    grid configure $frs.ebd -row 3 -column 1 -sticky w

    frame .clstr.fr.frbs -relief flat -borderwidth 0
    button .clstr.fr.frbs.ok -text Ok \
	    -command ".clstr.fr.frbs.ok configure -state normal ; \
	              DoMakeClusters $w"
    button .clstr.fr.frbs.cnc -text $TXT(cancel) -command { destroy .clstr }

    pack .clstr.fr.frbs.ok .clstr.fr.frbs.cnc -side left -padx 3
    pack .clstr.fr.title $frs .clstr.fr.frbs -side top -pady 5
    pack .clstr.fr
    update idletasks
    return
}

proc DoMakeClusters {w} {
    # use information in dialog created by proc MakeClusters to call
    #  the procedures that do the actual computation of clusters
    global Cluster TXT DSCALEFOR DLUNIT MESS

    switch $Cluster(how) {
	bydist {
	    set min $Cluster(min)
	    if { $min == "" } {
		set min 0
	    } elseif { ! [CheckFloat GMMessage $min] || \
		    ! [CheckFloat GMMessage $Cluster(max)] } { return }
	    regexp {(.*)=(.*)} $Cluster(unit) z type unit
	    if { $type == "subdist" } {
		set sc [expr $DSCALEFOR(sub,$unit)/$DSCALEFOR($unit)]
	    } else {
		set sc [expr 1.0/$DSCALEFOR($unit)]
	    }
	    set dtxt "$min-${Cluster(max)}$DLUNIT($unit,$type)"
	    set max [expr $sc*$Cluster(max)]
	    set min [expr $sc*$min]
	}
	inquadr {
	    set pf $Cluster(pformt)
	    if { ! [CheckLat GMMessage $Cluster(dlat) $pf] || \
		    ! [CheckLong GMMessage $Cluster(dlong) $pf] } { return }
	    if { [set dlat [Coord $pf $Cluster(dlat) S]] < 0 || \
		    [set dlong [Coord $pf $Cluster(dlong) W]] < 0 } {
		GMMessage $MESS(negdlatlong)
		return
	    }
	}
    }
    set Cluster(info) "..." ; set Cluster(abort) 0
    frame .clstr.fr.state -relief flat -borderwidth 0
    label .clstr.fr.state.info -width 30 -textvariable Cluster(info)
    button .clstr.fr.state.ab -text $TXT(abort) \
	    -command { set Cluster(abort) 1 }
    pack forget .clstr.fr.frbs
    pack .clstr.fr.state.info .clstr.fr.state.ab -side top -pady 5
    pack .clstr.fr.state -side top -pady 5
    update idletasks
    switch $Cluster(how) {
	bydist {
	    if { $min == 0 } {
		DistCluster $w $dtxt $max
	    } else { DistCluster $w $dtxt $max $min }
	}
	inquadr {
	    QuadrCluster $w $dlat $dlong
	}
    }
    destroy .clstr
    return
}

