#
#  gpsman --- GPS Manager: a manager for GPS receiver data
#
#  Copyright (c) 2004 Miguel Filgueiras (mig@ncc.up.pt) / Universidade do Porto
#
#    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
#      (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: datumell.tcl
#  Last change:  16 October 2004
#

## user-defined datums and ellipsoids

proc DefineDatum {} {
    # create dialog for defining a new datum

    Definition datum \
	    {|name |ellpsd =dx =dy =dz reserved |rmrk =ex =ey =ez "=# sat" \
	       |latS |latN |longW |longE} \
	    {entry >FillEllipsoidMenu float float float reserved text \
	      poss:float>-1 poss:float>-1 poss:float>-1 poss:float>-1 \
	      poss:lat poss:lat poss:long poss:long} \
	    {} {create revert cancel}
    return
}

proc DefineEllipsoid {} {
    # create dialog for defining a new ellipsoid

    Definition ellpsd {|name =a =1/f |rmrk} {entry float>0 float>0 text} \
	    {} {create revert cancel}
    return
}

proc OpenDatum {datum args} {
    # create dialog for inspecting/editing $datum
    #  $args is the name of the menu from which this proc was called (not used)
    global UDatums GDATUM

    if { [lsearch -exact $UDatums $datum] == -1 } {
	set as {create revert cancel}
    } else {
	set as {change revert create forget cancel}
    }
    set d [linsert $GDATUM($datum) 0 $datum]
    Definition datum \
	    {|name |ellpsd =dx =dy =dz reserved |rmrk =ex =ey =ez "=# sat" \
	       |latS |latN |longW |longE} \
	    {entry >FillEllipsoidMenu float float float reserved text \
	      poss:float>-1 poss:float>-1 poss:float>-1 poss:float>-1 \
	      poss:lat poss:lat poss:long poss:long} $d $as
    return
}

proc OpenEllipsoid {ell args} {
    # create dialog for inspecting/editing ellipsoid $ell
    #  $args is the name of the menu from which this proc was called (not used)
    global UEllipsoids ELLPSDDEF

    if { [lsearch -exact $UEllipsoids $ell] == -1 } {
	set as {create revert cancel}
    } else {
	set as {change revert create forget cancel}
    }
    set d [linsert $ELLPSDDEF($ell) 0 $ell]
    Definition ellpsd {|name =a =1/f |rmrk} {entry float>0 float>0 text} $d $as
    return
}

proc SetUpUserDatums {} {
    # process information on user-defined datums and ellipsoids
    global UFile UDatums UEllipsoids GDATUM ELLPSDDEF

    source $UFile(datum,ell)
    return
}

proc SaveUserDatums {} {
    # save user-defined datums and ellipsoids
    global UFile UDatums UEllipsoids GDATUM ELLPSDDEF MESS

    if { [catch {set f [open $UFile(datum,ell) w]}] } {
	GMMessage $MESS(cantwrtdtel)
	return
    }
    puts $f ""
    puts $f "# $MESS(written) GPSMan [NowTZ]"
    puts $f "# $MESS(editrisk)"
    puts $f ""
    puts -nonewline $f "set UDatums \{"
    WriteQuoteList $f $UDatums
    puts $f "\}"
    puts $f ""
    if { "$UDatums" != "" } {
	puts $f "array set GDATUM \{"
	foreach d $UDatums {
	    WriteQuote $f $d
	    set l $GDATUM($d)
	    puts -nonewline $f " \{"
	    WriteQuote $f [lindex $l 0]
	    puts $f ""
	    puts $f "    [lindex $l 1] [lindex $l 2] [lindex $l 3]"
	    puts -nonewline $f "    [lindex $l 4] "
	    WriteQuote $f [lindex $l 5]
	    puts $f "\}"
	    puts $f ""
	}
	puts $f "\}"
	puts $f ""
    }
    puts -nonewline $f "set UEllipsoids \{"
    WriteQuoteList $f $UEllipsoids
    puts $f "\}"
    puts $f ""
    if { "$UEllipsoids" != "" } {
	puts $f "array set ELLPSDDEF \{"
	foreach d $UEllipsoids {
	    WriteQuote $f $d
	    set l $ELLPSDDEF($d)
	    puts $f " \{[lindex $l 0] [lindex $l 1]"
	    WriteQuote $f [lindex $l 2]
	    puts $f "\}"
	    puts $f ""
	}
	puts $f "\}"
	puts $f ""
    }
    close $f
    return
}

proc Definition {kind fields types data acts} {
    # open a dialog for creating/inspecting/editing a definition of an
    #  object
    #  $kind  must be an index of TXT, and is used as an argument to
    #    proc DefAction that must be updated for each new kind
    # the dialog will contain entries/menus for the name of the defined
    #  object and its parameters; in the next 3 lists the name corresponds
    #  always to the first element; these 3 lists are all aligned:
    #  $fields is a list with elements under the form:
    #       "reserved" field to be hidden
    #       =TEXT      field with label TEXT
    #       |TEXT      field with label $TXT(TEXT)
    #  $types is a list with elements that can be
    #       "reserved" field to be hidden and set to "_" when saving
    #       poss:EL field that can be either void or the description EL
    #       "entry" for an entry with any text (but the name cannot be void)
    #       "text"  for any text (but the name cannot be void)
    #       >PROC   for a value in a menu filled in by PROC that will be
    #           called with two arguments: the menu and the command to be
    #           invoked by a selection; this command will have two arguments:
    #           the selected value and the menu
    #       any of the types accepted by proc BadParam (check.tcl)
    #  $data is a list (may be empty) of initial values for all the entries;
    #    it is truncated to the length of $fields
    #  $acts are the possible actions allowed in the set:
    #    {cancel, create, change, revert, forget}
    # the dialog grabs the focus but cannot be kept raised because of menus
    global Datell EPOSX EPOSY COLOUR MESS TXT OBSWIDTH OBSHEIGHT

    foreach x "kind types data" {
	set Datell($x) [set $x]
    }
    set Datell(grabs) [grab current]
    toplevel .datell
    wm protocol .datell WM_DELETE_WINDOW { DefCommand cancel }
    wm title .datell "$TXT($kind)/GPS Manager"
    wm transient .datell
    wm geometry .datell +$EPOSX+$EPOSY

    frame .datell.fr -relief flat -borderwidth 5 -bg $COLOUR(selbg)
    label .datell.fr.title -text $TXT($kind) -relief sunken
    set frs .datell.fr.frsel
    frame $frs -relief flat -borderwidth 0
    set data [lrange $data 0 [expr [llength $fields]-1]]
    set n 0
    foreach f $fields t $types d $data {
	switch -glob $f {
	    reserved {
		incr n
		continue
	    }
	    |* {
		set lab $TXT([string range $f 1 end])
	    }
	    =* {
		set lab [string range $f 1 end]
	    }
	}
	label $frs.l$n -text $lab
	set vw $frs.v$n
	regsub {poss:} $t "" t
	switch -glob $t {
	    entry {
		entry $vw -width 30
		ShowTEdit $vw $d 1
	    }
	    text {
		text $vw -wrap word -width $OBSWIDTH -height $OBSHEIGHT \
			    -exportselection true
		$vw insert 1.0 $d
		TextBindings $vw
	    }
	    >* {
		set mn $vw.mn
		menubutton $vw -text $d -relief raised -direction below \
			-menu $mn
		menu $mn -tearoff 0 \
			-postcommand "[string range $t 1 end] $mn DefMenuSel"
	    }
	    default {
		entry $vw -width 15
		$vw insert 0 $d
	    }
	}
	grid configure $frs.l$n -column 0 -row $n -sticky nesw
	grid configure $vw -column 1 -row $n -sticky nesw
	incr n
    }
    set frb .datell.fr.frb
    frame $frb -relief flat -borderwidth 0
    foreach e $acts {
	button $frb.b$e -text $TXT($e) \
		-command "$frb.b$e configure -state normal ; \
		          DefCommand $e"
	pack $frb.b$e -side left
    }

    pack .datell.fr.title $frs $frb -side top -pady 5
    pack .datell.fr

    update idletasks
    # cannot use RaiseWindow because of menus
    grab .datell
    return
}

proc DefCommand {act} {
    # execute command called from the definitions dialog
    global Datell

    set frs .datell.fr.frsel
    switch $act {
	cancel {
	    DestroyRGrabs .datell $Datell(grabs)
	}
	revert {
	    set n 0
	    foreach t $Datell(types) d $Datell(data) {
		set vw $frs.v$n
		regsub {poss:} $t "" t
		switch -glob $t {
		    text {
			$vw delete 1.0 end ; $vw insert 1.0 $d
		    }
		    >* {
			$vw configure -text $d
		    }
		    reserved {
		    }
		    entry -
		    default {
			$vw delete 0 end ; $vw insert 0 $d
		    }
		}
		incr n
	    }
	}
	create {
	    set nd [DefData $Datell(kind) $frs $Datell(types)]
	    if { [regexp {^[0-9]+$} $nd] } {
		focus $frs.v$nd
		return
	    }
	    set name [lindex $nd 0]
	    if { [DefAction $act $Datell(kind) $name "" [lreplace $nd 0 0]] } {
		DestroyRGrabs .datell $Datell(grabs)
	    }
	}
	change {
	    set nd [DefData $Datell(kind) $frs $Datell(types)]
	    if { [regexp {^[0-9]+$} $nd] } {
		focus $frs.v$nd
		return
	    }
	    set name [lindex $nd 0] ; set oldname [lindex $Datell(data) 0]
	    if { [DefAction $act $Datell(kind) $name $oldname \
		    [lreplace $nd 0 0]] } {
		DestroyRGrabs .datell $Datell(grabs)
	    }
	}
	forget {
	    if { [DefAction forget $Datell(kind) "" \
		    [lindex $Datell(data) 0] ""] } {
		DestroyRGrabs .datell $Datell(grabs)
	    }
	}
    }
    update idletasks
    return
}

proc DefMenuSel {value menu} {
    # a $value was selected in $menu

    [winfo parent $menu] configure -text $value
    return
}

proc DefData {kind frs types} {
    # collect and check data in the definition dialog
    #  $kind gives the kind of object being defined (used in error messages)
    #  $frs is the frame with the widgets containing the data
    #  $types as in proc Define
    # return list with values or an integer on error giving the number of the
    #  widget (from 0) with bad value
    global TXT MESS

    set nd "" ; set n 0
    foreach t $types {
	set vw $frs.v$n
	set poss [regsub {poss:} $t "" t]	    
	switch -glob $t {
	    entry {
		set d [string trim [$vw get]]
		if { $n == 0 && "$d" == "" } {
		    GMMessage $MESS(namevoid)
		    return 0
		}
	    }
	    text {
		set d [string trim [$vw get 1.0 end] " \n"]
	    }
	    >* {
		set d [$vw cget -text]
	    }
	    reserved {
		set d "_"
	    }
	    default {
		set d [$vw get]
		if { ! $poss && "$d" != "" && [BadParam $TXT($kind) $t $d] } {
		    return $n
		}
	    }
	}
	lappend nd $d
	incr n
    }
    return $nd
}

proc DefAction {act kind name oldname data} {
    # try to act on definition of object under $name (was $oldname)
    #  $act in {change, create, forget}
    #  $kind in {datum, ellpsd}
    #  $data is list with all the values except name (not used if $act==forget)
    # return 0 if action fails, and 1 otherwise
    # it is assumed that for each kind there a list of names of user-defined
    #  objects, data array indexed by the object name and a proc that is to
    #  be called upon a successful action
    # this proc is NOT checking if objects are in use when changing/forgetting
    global MESS TXT GDATUM UDatums ELLPSDDEF UEllipsoids

    switch $kind {
	datum {
	    set datarr GDATUM ; set ulist UDatums
	    set savecomm SaveUserDatums
	}
	ellpsd {
	    set datarr ELLPSDDEF ; set ulist UEllipsoids
	    set savecomm SaveUserDatums
	}
    }
    switch $act {
	create {
	    if { [lsearch -exact [array names $datarr] $name] != -1 } {
		GMMessage $MESS(idinuse)
		return 0
	    }
	    set $ulist [lsort -dictionary [linsert [set $ulist] 0 $name]]
	    set [set datarr]($name) $data
	}
	change {
	    if { "$name" != "$oldname" } {
		if { [lsearch -exact [array names $datarr] $name] != -1 } {
		    GMMessage $MESS(idinuse)
		    return 0
		}
		set $ulist [lsort -dictionary \
			[linsert [Delete [set $ulist] $oldname] 0 $name]]
		unset [set datarr]($oldname)
	    }
	    set [set datarr]($name) $data
	}
	forget {
	    if { ! [GMConfirm [format $MESS(askforget) $TXT($kind)]] } {
		return 0
	    }
	    set $ulist [Delete [set $ulist] $oldname]
	    unset [set datarr]($oldname)
	}
    }
    $savecomm
    return 1
}
