#!/bin/sh
#SetCoord  -*- TCL -*- Created: ramsan Jan-1997, Modified: ramsan Jan-1997


#----------------------SetCoord ALONE---------------------------
# the next line restarts using wish \
	exec wish4.2 "$0" "$@"

set SetCoordRunningAlone 0
# catch {
#     if {$argv0 == [info script] } {
# 	set SetCoordRunningAlone 1
# 	set tcl_interactive 0
# 	set tk_strictMotif 1
	
# 	if { [catch { set GIDDEFAULT $env(GIDDEFAULT)}]!=1 } {
# 	    set GIDDEFAULTTCL $GIDDEFAULT
# 	    catch { set GIDDEFAULTTCL $env(GIDDEFAULTTCL) }
# 	    set auto_path "$GIDDEFAULTTCL"
# 	    source $GIDDEFAULTTCL/init.tcl
# 	    source $GIDDEFAULTTCL/tk.tcl
# 	}
# 	wm withdraw .
#     }
# }

#  LOOK AT THE END OF THE FILE !!!
#-------------------------------------------------------------------


proc PickPointInSetCoord {} {
    global SetCoordPriv
    set p1 [::GidUtils::GetCoordinates [_ "Enter point (ESC to leave)"]]
    if { $p1 != "" } {
	set SetCoordPriv(xrel) [lindex $p1 0]
	set SetCoordPriv(yrel) [lindex $p1 1]
	set SetCoordPriv(zrel) [lindex $p1 2]
    }
}

proc RelativeCenterWinClose { w } {
    global SetCoordPriv
    set axes { x y z }
    foreach i $axes {
	if { ![regexp  {^[  ]*([+-]?[0-9]*\.?[0-9]*([eE][+-]?[0-9]*)?)[  ]*$} \
		$SetCoordPriv(${i}rel)] || [regexp {^[ ]*$} \
		$SetCoordPriv(${i}rel)]} {
	    set win [winfo toplevel $w].err
	    tk_dialogRAM $win [_ "error"] \
		[_ "value '%s' is not a number" $SetCoordPriv(${i}rel)] \
		error 0 [_ "OK"]
	    focus $w.${i}e
	    return
	}
    }
    destroy $w
}

proc ChangeCoordLA { name1 name2 op } {
    global GidPriv SetCoordPriv
    set w $GidPriv(SetCoordWindow).relcen

    if { $SetCoordPriv(CoordTypeLA) == "-Relative center-" } {
	InitWindow $w [_ "Relative center"] SetCoordRelCenterWindowGeom "" "" 1

	frame $w.frmCoord
	set axes { x y z }
	foreach i $axes {
	    if { ![info exists SetCoordPriv(${i}rel)] } {
		set SetCoordPriv(${i}rel) 0.00000
	    }
	    label $w.${i}l -text "$i:"
	    entry $w.${i}e -relief sunken -width 20 -textvariable \
		    SetCoordPriv(${i}rel)
	    bind $w.${i}e <FocusIn> { 
		if { [%W get] != "" } {
		    %W sel from 0 
		    %W sel to end
		}
	    }
	    bind $w.${i}e <FocusOut> { %W sel clear}
	}

	set def_back [$w cget -background]
	frame $w.frmButtons -bg [CCColorActivo $def_back]

	button $w.frmButtons.btnpick -text [_ "Pick"] \
		-command "PickPointInSetCoord" \
		-underline 0 -width 6 -takefocus 0
	
	button $w.frmButtons.btnclose -text [_ "Close"] \
		-command "RelativeCenterWinClose $w" \
		-underline 0 -width 6 -takefocus 0

	grid $w.xl $w.xe -in $w.frmCoord -sticky ew
	grid $w.yl $w.ye -in $w.frmCoord -sticky ew
	grid $w.zl $w.ze -in $w.frmCoord -sticky ew
	grid columnconf $w.frmCoord "1" -weight 1

	grid $w.frmCoord -sticky ew -padx 3 -pady 3
	grid $w.frmButtons -sticky ews -columnspan 7
	grid $w.frmButtons.btnpick $w.frmButtons.btnclose -padx 5 -pady 6
	grid columnconf $w "0" -weight 1
	grid rowconfigure $w "1" -weight 1

	focus $w.xe

	bind $w <Return> "tkButtonInvoke $w.frmButtons.btnpick"
	bind $w <Alt-c> "tkButtonInvoke $w.frmButtons.btnclose"
	bind $w <Escape> "tkButtonInvoke $w.frmButtons.btnclose"

    } elseif { $SetCoordPriv(CoordTypeLA) == "-Define new...-" } {
	.central.s process escape escape escape escape data LocalAxes DefineLocAxes
	set SetCoordPriv(CoordTypeLA) "-Global-"
    }
}

proc ChangeCoordType { name1 name2 op } {
    global GidPriv SetCoordPriv
    set w $GidPriv(SetCoordWindow)
    switch $SetCoordPriv(CoordType) {
	Cartesian {
	    $w.xl conf -text "x:"
	    $w.yl conf -text "y:"
	    $w.zl conf -text "z:"
	}
	Cilindrical {
	    $w.xl conf -text "r:"
	    $w.yl conf -text "theta:"
	    $w.zl conf -text "z:"
	}
	Spherical {
	    $w.xl conf -text "r:"
	    $w.yl conf -text "theta:"
	    $w.zl conf -text "phi:"
	}
    }

}


proc ApplyCmd { w } {
    global GidPriv SetCoordPriv
    set w $GidPriv(SetCoordWindow)
    
    set axes { x y z }
    set retval "FNoJoin "
    if { $SetCoordPriv(CoordTypeLA) == "-Relative last-" || \
	$SetCoordPriv(CoordTypeLA) == "-Relative center-" } {
	append retval @
    }
    if { ![regexp {^-[^-]*-$} $SetCoordPriv(CoordTypeLA)] } {
	append retval '$SetCoordPriv(CoordTypeLA)'
    }

    foreach i $axes {
	if { ![regexp  {^[  ]*([+-]?[0-9]*\.?[0-9]*([eE][+-]?[0-9]*)?)[  ]*$} \
		[$w.${i}e get] trash number] || [regexp {^[ ]*$} \
		[$w.${i}e get]]} {

	    tk_dialogRAM $w.dd [_ "error"] \
		[_ "value '%s' is not a number" [$w.${i}e get]] \
		error 0 [_ "OK"]
	    focus $w.${i}e
	    return
	}
	append retval $number
	if { $i == "x" } {
	    if { $SetCoordPriv(CoordType) == "Cartesian" } {
		append retval ,
	    } else { append retval < }
	} elseif { $i == "y" } {
	    if { $SetCoordPriv(CoordType) == "Spherical"} {
		append retval <
	    } else { append retval , }
	}
    }

    if { $SetCoordPriv(CoordTypeLA) == "-Relative center-" } {
	set retvalLA ""
	foreach i $axes {
	    if { ![regexp  {^[  ]*([+-]?[0-9]*\.?[0-9]*([eE][+-]?[0-9]*)?)[  ]*$} \
		    $SetCoordPriv(${i}rel) trash number] || [regexp {^[ ]*$} \
		    $SetCoordPriv(${i}rel)]} {
		tk_dialogRAM $w.dd [_ "error"] \
		    [_ "value '%s' in local center is not a number" $SetCoordPriv(${i}rel)] \
		    error 0 [_ "OK"]
		catch { focus $w.relcen.${i}e }
		return
	    }
	    append retvalLA $number
	    if { $i != "z" } { append retvalLA , }
	}
	.central.s process options EnterRelative $retvalLA $retval
    } else { .central.s process $retval}

    
    set oldtext [$w.message cget -text]
    if { $oldtext != "Entered one new point" } {
	$w.message conf -text [_ "Entered one new point"]
	after 1000 "$w.message conf -text [list $oldtext]"
    }
}


proc UpdateSetCoord {} {
    global SetCoordPriv
    
    if { [$SetCoordPriv(LAmenu) index end] >= 4 } {
	$SetCoordPriv(LAmenu) del 4 end
    }

    set found 0
    foreach i [.central.s info localaxes] {
	$SetCoordPriv(LAmenu) add command -label $i -command \
		[list set SetCoordPriv(CoordTypeLA) $i]
	if { $SetCoordPriv(CoordTypeLA) == $i } { set found 1 }
    }

    if { !$found && $SetCoordPriv(CoordTypeLA) != "-Global-" && \
	    $SetCoordPriv(CoordTypeLA) != "-Relative center-" && \
	    $SetCoordPriv(CoordTypeLA) != "-Relative last-" } {
	set SetCoordPriv(CoordTypeLA) "-Global-"
    }

    set input [.central.s info variable CreateAlwaysNewPoint]

    if { $input == 1 } { 
	set SetCoordPriv(CreateNewPoint) Always
    } elseif { $input == 0 } { 
	set SetCoordPriv(CreateNewPoint) Ask 
    } elseif { $input == -2 } { 
	set SetCoordPriv(CreateNewPoint) Never
    } else {set SetCoordPriv(CreateNewPoint) No }
 
}

proc SetCoordEnable { what { w .gid.wSetCoord } } {
    if { ![winfo exists $w] } { return }
    if { $what == "yes" } {
	$w.frmButtons.btnApply conf -state normal
    } else {
	$w.frmButtons.btnApply conf -state disabled
    }
}

proc SetCoord { { w .gid.wSetCoord } } {
    global GidPriv SetCoordPriv

    InitWindow $w [_ "Coordinates window"] SetCoordWindowGeom SetCoord


    set def_back [$w cget -background]
    
    frame $w.frmButtons -bg [CCColorActivo $def_back]

    button $w.frmButtons.btnApply -text [_ "Apply"] \
	    -command "ApplyCmd $w" \
	    -underline 0 -width 6 -state disabled -takefocus 0
   
    button $w.frmButtons.btnclose -text [_ "Close"] \
	    -command ".central.s process escape ;  grab release $w ; destroy $w" \
	    -underline 0 -width 6 -takefocus 0


    label $w.csl -text [_ "C. System:"]
    set SetCoordPriv(LAmenu) [tk_optionMenuRAM $w.csla SetCoordPriv(CoordTypeLA) \
	    [list [_ "-Global-"] [_ "-Relative center-"] [_ "-Relative last-"] [_ "-Define new...-"]] \
	    {-Global- "-Relative center-" "-Relative last-" "-Define new...-"}]
    $w.csla conf -width 12 -highlightthickness 0
    trace variable SetCoordPriv(CoordTypeLA) w ChangeCoordLA

    label $w.lae -text [_ "Local axes:"]
    tk_optionMenuRAM $w.cs SetCoordPriv(CoordType) \
	    [list [_ "Cartesian"] [_ "Cilindrical"] [_ "Spherical"]] \
	    {Cartesian Cilindrical Spherical}
    $w.cs conf -width 12 -highlightthickness 0
    trace variable SetCoordPriv(CoordType) w ChangeCoordType

    frame $w.coord

    set axes { x y z }
    foreach i $axes {
	label $w.${i}l -text "$i:"
	entry $w.${i}e -relief sunken -width 20 -textvariable \
		SetCoordPriv(${i}axe)
	$w.${i}e del 0 end
	$w.${i}e ins end 0.00000
	bind $w.${i}e <FocusIn> { 
	    if { [%W get] != "" } {
		%W sel from 0 
		%W sel to end
	    }
	}
	bind $w.${i}e <FocusOut> { %W sel clear}
	bind $w.${i}e <Return> "$w.frmButtons.btnApply conf -relief sunken ; \
		update idletasks ; $w.frmButtons.btnApply invoke ; $w.frmButtons.btnApply conf \
		-relief raised"
    }

    frame $w.newpnt
    label $w.newpntl1 -text [_ "New point:"]
    label $w.newpntl2 -relief ridge -bd 2 -textvar SetCoordPriv(CreateNewPoint)
    button $w.newpntb -text [_ "Change"] -padx 1 -command ChangeVariables -takefocus 0

    label $w.message -text [_ "Use 'tab Shift-tab and Return'"] -relief ridge -bd 2

    grid $w.newpntl1 $w.newpntl2 $w.newpntb -in $w.newpnt -padx 2 -pady 2
    grid conf $w.newpntl2 -ipadx 2 -ipady 2

    grid $w.csl $w.cs -sticky e -padx 2 -pady 2
    grid  $w.lae $w.csla -sticky e -padx 2 -pady 2

    grid $w.xl $w.xe -in $w.coord -sticky ew -padx 2 -pady 2
    grid conf $w.xl -sticky w
    grid $w.yl $w.ye -in $w.coord -sticky ew -padx 2 -pady 2
    grid conf $w.yl -sticky w
    grid $w.zl $w.ze -in $w.coord -sticky ew -padx 2 -pady 2
    grid conf $w.zl -sticky w
    grid columnconf $w.coord "1" -weight 1

    grid $w.coord -sticky ew -columnspan 7

    grid $w.newpnt -sticky e -columnspan 7

    grid $w.message -sticky ews -columnspan 7

    grid $w.frmButtons -sticky ews -columnspan 7
    grid $w.frmButtons.btnApply $w.frmButtons.btnclose -padx 5 -pady 6
    grid columnconf $w "0" -weight 1
    grid rowconfigure $w "4" -weight 1

    wm minsize $w 175 200

    focus $w.xe

    bind $w <Alt-c> "tkButtonInvoke $w.frmButtons.btnclose"
    bind $w <Escape> "tkButtonInvoke $w.frmButtons.btnclose"

    foreach i [bind .gid] {
	bind $w $i [bind .gid $i]
    }
    UpdateSetCoord
}


#----------------------SetCoord ALONE---------------------------
# if { $SetCoordRunningAlone == 1 } {
#     SetCoord .wSetCoord
# } 
#-----------------------------------------------------------------
