#
#  gpsman --- GPS Manager: a manager for GPS receiver data
#
# Copyright (c) 1998-2008 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:  24 March 2008
#

## user-definitions: datums, ellipsoids, geo-reference files

# first field must be for identifier (unique for each definition type)
#  so that  *,dfields does not include it

array set DefSpecs {
    datum,dfields  {ellpsd dx dy dz reserved nb ex ey ez nsat
	latS latN longW longE}
    datum,fnames  {|name |ellpsd =dx =dy =dz reserved |rmrk =ex =ey =ez
	"=# sat" |latS |latN |longW |longE}
    datum,ftypes  {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}
    datum,datarr    GDATUM
    datum,ulist     UDatums
    datum,savecomm  SaveUserDatums
    ellpsd,dfields  {a invf nb}
    ellpsd,fnames   {|name =a =1/f |rmrk}
    ellpsd,ftypes   {entry float>0 float>0 text}
    ellpsd,datarr   ELLPSDDEF
    ellpsd,ulist    UEllipsoids
    ellpsd,savecomm SaveUserDatums
    backgrnd,dfields {file nb}
    backgrnd,fnames {|name |file |rmrk}
    backgrnd,ftypes {entry file=MapBkInfo text}
    backgrnd,datarr BACKGRNDS
    backgrnd,ulist  UBackgrnds
    backgrnd,savecomm SaveUserBackgrnds
}

proc Define {dtype args} {
    # create a dialog for a new definition
    #  $dtype in {datum, ellpsd, backgrnd}
    #  $args if defined is taken as the list of initial field values
    # return name of new definition or "" if operation is cancelled
    global DefSpecs

    return [Definition $dtype $DefSpecs($dtype,fnames) \
		$DefSpecs($dtype,ftypes) $args {create revert cancel}]
}

proc Inspect {dtype name args} {
    # create dialog for inspecting/editing a definition
    #  $dtype in {datum, ellpsd, backgrnd}
    global DefSpecs

    set datarr $DefSpecs($dtype,datarr) ; set ulist $DefSpecs($dtype,ulist)
    global $datarr $ulist
    set as {change revert create forget cancel}
    if { $dtype != "backgrnd" } {
	# there are GPSMan definitions apart from user ones
	if { [lsearch -exact [set $ulist] $name] == -1 } {
	    set as {create revert cancel}
	}
    }
    set d [linsert [set [set datarr]($name)] 0 $name]
    Definition $dtype $DefSpecs($dtype,fnames) $DefSpecs($dtype,ftypes) $d $as
    return
}

proc GetDefFields {dtype name fs} {
    # return list of field values for definition of given type and name
    #  $fs is list of field names (as in DefSpecs array)
    # result is empty if definition does not exist; unknown fields are
    #  ignored silently
    global DefSpecs

    set datarr $DefSpecs($dtype,datarr)
    global $datarr
    if { [catch {set data [set [set datarr]($name)]}] } { return "" }
    set res "" ; set dflds $DefSpecs($dtype,dfields)
    foreach f $fs {
	if { [set ix [lsearch -exact $dflds $f]] != -1 } {
	    lappend res [lindex $data $ix]
	}
    }
    return $res
}

proc FillBackgrndMenu {menu commd args} {
    # if $args is not empty it is a list of menu entries to be added to
    #  the beginning of the menu
    global UBackgrnds

    if { [regexp {@|(---)} $UBackgrnds] } {
	set l $args
	foreach x $UBackgrnds { lappend l " $x" }
    } else { set l [concat $args $UBackgrnds] }
    FillMenu $menu $commd $l
    return
}

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

    # assumed to be in system encoding
    source $UFile(datum,ell)
    return
}

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

    if { $UDatums == "" && $UEllipsoids == "" } {
	if { [file exists $UFile(datum,ell)] && \
		 [catch {file delete -- $UFile(datum,ell)}] } {
	    GMMessage $MESS(cantwrtdtel)
	}
	return
    }
    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 SetUpUserBackgrnds {} {
    # process information on user-defined map backgrounds
    global UFile BACKGRNDS UBackgrnds

    # assumed to be in system encoding
    source $UFile(backgrs)
    return
}

proc SaveUserBackgrnds {} {
    # save user-defined backgrounds
    global UFile BACKGRNDS UBackgrnds MESS

    if { $UBackgrnds == "" } {
	if { [file exists $UFile(backgrs)] && \
		 [catch {file delete -- $UFile(backgrs)}] } {
	    GMMessage $MESS(cantwrtmbaks)
	}
	return
    }
    if { [catch {set f [open $UFile(backgrs) w]}] } {
	GMMessage $MESS(cantwrtmbaks)
	return
    }
    puts $f ""
    puts $f "# $MESS(written) GPSMan [NowTZ]"
    puts $f "# $MESS(editrisk)"
    puts $f ""
    puts -nonewline $f "set UBackgrnds \{"
    WriteQuoteList $f $UBackgrnds
    puts $f "\}"
    puts $f ""
    puts $f "array set BACKGRNDS \{"
    foreach d $UBackgrnds {
	WriteQuote $f $d
	set l $BACKGRNDS($d)
	puts -nonewline $f " \{"
	WriteQuote $f [lindex $l 0]
	puts $f ""
	puts -nonewline $f "    [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
    # return name of new/changed definition or "" if operation is cancelled
    #  or definition is forgotten
    # 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)
    #       "file=FTYPE"  for a file path (entry and select button) of type
    #           FTYPE (see $filetypes in proc GMStart, main.tcl); can be void
    #           or refer to a non-existing file
    #       >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 DefCommand

    foreach x "kind types data" {
	set Datell($x) [set $x]
    }
    set Datell(grabs) [grab current]
    toplevel .datell
    wm protocol .datell WM_DELETE_WINDOW { set 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
	    }
	    file=* {
		regsub {file=} $t "" ftype
		frame $vw
		entry $vw.fn -width 50
		ShowTEdit $vw.fn $d 1
		button $vw.sel -text $TXT(select) \
		    -command "DefSelectFile $ftype $vw"
		grid $vw.fn -column 0 -row 0 -sticky nesw
		grid $vw.sel -column 1 -row 0 -sticky e
	    }
	    >* {
		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 ; \
		          set 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
    while 1 {
	tkwait variable DefCommand
	switch $DefCommand {
	    cancel {
		DestroyRGrabs .datell $Datell(grabs)
		return ""
	    }
	    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 {
			}
			file=* {
			    $vw.fn delete 0 end ; $vw.fn insert 0 $d
			}
			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
		    continue
		}
		set name [lindex $nd 0]
		if { [DefAction create $Datell(kind) $name "" \
			  [lreplace $nd 0 0]] } {
		    DestroyRGrabs .datell $Datell(grabs)
		    return $name
		}
	    }
	    change {
		set nd [DefData $Datell(kind) $frs $Datell(types)]
		if { [regexp {^[0-9]+$} $nd] } {
		    focus $frs.v$nd
		    continue
		}
		set name [lindex $nd 0] ; set oldname [lindex $Datell(data) 0]
		if { [DefAction change $Datell(kind) $name $oldname \
			  [lreplace $nd 0 0]] } {
		    DestroyRGrabs .datell $Datell(grabs)
		    return $name
		}
	    }
	    forget {
		if { [DefAction forget $Datell(kind) "" \
			  [lindex $Datell(data) 0] ""] } {
		    DestroyRGrabs .datell $Datell(grabs)
		    return ""
		}
	    }
	}
    }
    # not used
    return
}

proc DefSelectFile {ftype fr} {
    # get absolute file path and set appropriate entry in frame $fr
    global TXT File

    if { [set fn [GMGetFileName $TXT(select) $ftype r {} {}]] != ".." } {
	$fr.fn delete 0 end
	$fr.fn insert 0 $File($ftype)
    }
    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 Definition
    # 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"]
	    }
	    file=* {
		set d [string trim [$vw.fn get]]
	    }
	    >* {
		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, backgrnd}
    #  $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 DefSpecs

    foreach v "datarr ulist savecomm" {
	set $v $DefSpecs($kind,$v)
    }
    global $datarr $ulist
    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]]
		if { ! [catch {set p $DefSpecs($kind,chgcomm)}] } {
		    $p $oldname $name
		}
		unset [set datarr]($oldname)
	    }
	    set [set datarr]($name) $data
	}
	forget {
	    if { ! [GMConfirm [format $MESS(askforget) $TXT($kind)]] } {
		return 0
	    }
	    if { ! [catch {set p $DefSpecs($kind,chgcomm)}] } {
		$p $oldname ""
	    }
	    set $ulist [Delete [set $ulist] $oldname]
	    unset [set datarr]($oldname)
	}
    }
    $savecomm
    return 1
}
