#!/bin/sh
#ClipPlanes  -*- TCL -*- Created: ramsan Jul-1997, Modified: ramsan Jul-1997


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

set ClipPlanesRunningAlone 0
catch {
    if {$argv0 == [info script] } {
	set ClipPlanesRunningAlone 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 ClipPlanesOriginal {} {
    global CliPPriv
    set CliPPriv(AvoidUpdate) 1
    .central.s process clip original
    after idle set CliPPriv(AvoidUpdate) 0 ; FillClipPlanesInfo
}

proc PickPointInClipPlanes {} {
    global CliPPriv
    set xyz [::GidUtils::GetCoordinates [_ "Pick rotation center"]]
    if { $xyz != "" } { 
	set CliPPriv(Xcenter) [lindex $xyz 0]
	set CliPPriv(Ycenter) [lindex $xyz 1]
	set CliPPriv(Zcenter) [lindex $xyz 2]
    }
}

proc FillClipPlanesInfo {} {
    global GidPriv CliPPriv

    if { $CliPPriv(AvoidUpdate) } { return }

    set w $GidPriv(ClipPlanesWindow)

    set ortholimits [.central.s info ortholimits]
    set graphcenter [.central.s info graphcenter]
    set graphcenterOrig [.central.s info graphcenter -original]

    set CliPPriv(Xcenter) [lindex $graphcenter 0]
    set CliPPriv(Ycenter) [lindex $graphcenter 1]
    set CliPPriv(Zcenter) [lindex $graphcenter 2]

    set CliPPriv(XcenterOrig) [lindex $graphcenterOrig 0]
    set CliPPriv(YcenterOrig) [lindex $graphcenterOrig 1]
    set CliPPriv(ZcenterOrig) [lindex $graphcenterOrig 2]


    set CliPPriv(Near) [ format %g [expr -1.0*[lindex $ortholimits 4]-$CliPPriv(Zcenter)]]
    set CliPPriv(Far) [ format %g [expr $CliPPriv(Zcenter)+[lindex $ortholimits 5]]]

    set CliPPriv(ExtOrtho) [expr [lindex $ortholimits 6]*$CliPPriv(Boundariesfactor)]
    set CliPPriv(ExtOrthoReal) [expr $CliPPriv(ExtOrtho)+sqrt( \
	    pow($CliPPriv(Xcenter)-$CliPPriv(XcenterOrig),2)+ \
	    pow($CliPPriv(Ycenter)-$CliPPriv(YcenterOrig),2)+ \
	    pow($CliPPriv(Zcenter)-$CliPPriv(ZcenterOrig),2))]

    set dig [ expr ceil( log10( abs( $CliPPriv(ExtOrthoReal))))]
    set Ortho1000 [ expr ceil( $CliPPriv(ExtOrthoReal) / pow( 10.0, $dig - 3))]
    set nuevo_ortho [ expr $Ortho1000 * pow( 10.0, $dig - 3)]
    
    # set resolution [expr $CliPPriv(ExtOrthoReal)/100.0]
    # set from [expr $CliPPriv(ExtOrthoReal)-$resolution]
    # set to [expr $resolution-$CliPPriv(ExtOrthoReal)]

    #set resolution [expr $nuevo_ortho / 100.0]
    set resolution [ expr pow( 10.0, $dig - 3)]
    set from [expr $nuevo_ortho - $resolution]
    set to [expr $resolution - $nuevo_ortho]
    $w.f1.s conf -from $from -to $to -resolution $resolution
    $w.f1.s set $CliPPriv(Far)

    $w.f2.s conf -from $from -to $to -resolution $resolution

    $w.f2.s set $CliPPriv(Near)

    #set CliPPriv(From) $from
    #set CliPPriv(To) $to
    set CliPPriv(Resolution) $resolution
    #WarnWin "$from - $to, $resolution"
    set CliPPriv(ChangingPlanes) 0

    # after idle is important when window opens at the very beginning of GiD
    after idle ActualizeClipPlanesCanvas

}

proc SendClipPlaneInfo { { DoTest yes } { Fastredraw yes } } {
    global GidPriv CliPPriv

    set w $GidPriv(ClipPlanesWindow)

    set CliPPriv(AvoidUpdate) 1

    foreach i "Xcenter Ycenter Zcenter" {
	if { ![IsWord real $CliPPriv($i) $w ""] } {
	    set axename [string tolower [string index $i 0]]
	    $w.f4.e$axename sel from 0
	    $w.f4.e$axename sel to end
	    return
	}
    }
    if { $DoTest == "yes" } {
	if { [ChangeClipPlane Far $CliPPriv(Far)] == "error" } { return }
    }

    set x [string trim $CliPPriv(Xcenter)]
    set y [string trim $CliPPriv(Ycenter)]
    set z [string trim $CliPPriv(Zcenter)]

    set xold [lindex [.central.s info graphcenter] 0]
    set yold [lindex [.central.s info graphcenter] 1]
    set zold [lindex [.central.s info graphcenter] 2]

    if { [expr abs($x-$xold)] > 1.0e-7 ||
    [expr abs($x-$xold)] > 1.0e-7 ||
    [expr abs($x-$xold)] > 1.0e-7 } {
	.central.s process rotate center FNoJoin $x,$y,$z
    }
    set FOrtho [expr -1.0*($z-1.0*$CliPPriv(Far))]
    set NOrtho [expr -1.0*($z+1.0*$CliPPriv(Near))]

    if { $Fastredraw != "yes" } {
	.central.s process clip $NOrtho $FOrtho
    } else {
	.central.s process clip fastdraw $NOrtho $FOrtho
    }

    after idle set CliPPriv(AvoidUpdate) 0 ; FillClipPlanesInfo

}

proc ActualizeClipPlanesCanvas {} {
    global GidPriv CliPPriv

    set w $GidPriv(ClipPlanesWindow)

    $w.dib delete movilef movilen 

    set factorf [expr 66-36*$CliPPriv(Far)/[$w.f1.s cget -from]]
    set factorft [expr 66-18*$CliPPriv(Far)/[$w.f1.s cget -from]]

    if { $CliPPriv(Far) > 0 } { 
	set fartext +Far 
    } else { set fartext -Far }

    $w.dib create line 20 66 20 $factorf -arrow both -tags movilef \
	    -arrowshape "3 1 3"
    $w.dib create line 25 $factorf 140 $factorf -tags movilef
    $w.dib create text 15 $factorft -text $fartext -tags movilef -anchor w

    set factorn [expr 66+34*$CliPPriv(Near)/[$w.f2.s cget -from]]
    set factornt [expr 66+17*$CliPPriv(Near)/[$w.f2.s cget -from]]

    if { $CliPPriv(Near) > 0 } { 
	set neartext +Near
    } else { set neartext -Near }

    $w.dib create line 140 66 140 $factorn -arrow both -tags movilen \
	    -arrowshape "3 1 3"
    $w.dib create line 25 $factorn 140 $factorn -tags movilen
    $w.dib create text 145 $factornt -text $neartext -tags movilen -anchor e


}

proc ChangeClipPlane { which newval } {
    global GidPriv CliPPriv

    if { [ info exist CliPPriv(ChangingPlanes)] && $CliPPriv(ChangingPlanes)} { return}

    set CliPPriv(ChangingPlanes) 1

    set w $GidPriv(ClipPlanesWindow)
    switch $which {
	Far { 
	    set fr f1
	    set frother f2
	    set other Near
	}
	Near { 
	    set fr f2 
	    set frother f1
	    set other Far
	}
    }

    if { ![IsWord real $newval $w " In $which field"] } {
	$w.$fr.e sel from 0
	$w.$fr.e sel to end

	set CliPPriv(ChangingPlanes) 0
	return error
    }

    if { $newval < -$CliPPriv(ExtOrthoReal) || \
	    $newval > $CliPPriv(ExtOrthoReal) } {
	tk_dialogRAM $w.tempwin [_ "Error window"] [_ "Value out of limits"] \
	    error 0 [_ "OK"]
	$w.$fr.e sel from 0
	$w.$fr.e sel to end

	set CliPPriv(ChangingPlanes) 0
	return error
    }

    if { $CliPPriv(FixedDistanceFlag) && \
	    ![IsWord real+ $CliPPriv(FixedDistance) $w ] } {
	set CliPPriv(FixedDistanceFlag) 0
 	$w.f3.e sel from 0
 	$w.f3.e sel to end

	after 100 [list tk_dialogRAM $w.tempwin [_ "Error window"] \
		[_ "One positive number must be entered."] error 0 [_ "OK"]]

	set CliPPriv(ChangingPlanes) 0
	return error
    }


    set CliPPriv($which) [ format %g $newval]

    if { !$CliPPriv(FixedDistanceFlag) } {
	if { [expr -1.0*$CliPPriv($which)] > $CliPPriv($other) } {
	    set CliPPriv($other) [ format %g [expr -1.0*$CliPPriv($which)]]
	}
    } else {

	#WarnWinText " $CliPPriv(FixedDistance) / $CliPPriv(Resolution)"
	
	set int_fact [ expr int( $CliPPriv(FixedDistance) / $CliPPriv(Resolution))]
	set CliPPriv(FixedDistance) [ expr double( $int_fact) * $CliPPriv(Resolution)]
	
	#WarnWinText " = $CliPPriv(FixedDistance)"

	#WarnWin hola

	set CliPPriv($other) \
		[ format %g [expr $CliPPriv(FixedDistance)-1.0*$CliPPriv($which)]]
	if { $CliPPriv($other) > $CliPPriv(ExtOrthoReal) } {
	    set CliPPriv($other) [ format %g $CliPPriv(ExtOrthoReal)]
	}
	if { $CliPPriv($other) < -$CliPPriv(ExtOrthoReal) } {
	    set CliPPriv($other) [ format %g -$CliPPriv(ExtOrthoReal)]
	}

    }
    
    if { $CliPPriv($which) != [$w.$fr.s get ] } {
	$w.$fr.s set $CliPPriv($which)
    }
    if { $CliPPriv($other) != [$w.$frother.s get ] } {
	$w.$frother.s set $CliPPriv($other)
    }

    if { $CliPPriv(DynamicUpdate) } { SendClipPlaneInfo no }

    ActualizeClipPlanesCanvas

    set CliPPriv(ChangingPlanes) 0

} 

proc ClipPlanes { { w .gid.wClipPlanes } } {
    global GIDDEFAULT CliPPriv
    InitWindow $w [_ "Clip planes"] ClipPlanesWindowGeom ClipPlanes


#     label $w.dib -bitmap @$GIDDEFAULT/bitmaps/clipplane.xbm \
# 	    -relief groove -bd 2

    canvas $w.dib -relief groove -bd 2 -width 154 -height 142

    $w.dib create bitmap -30 -40 -bitmap @$GIDDEFAULT/bitmaps/clipplane-base.xbm \
	    -anchor nw

    frame $w.f0
    button $w.f0.b1 -text [_ "Increase bound"] -command {
	set CliPPriv(Boundariesfactor) [expr $CliPPriv(Boundariesfactor)*2.0]
	FillClipPlanesInfo
    }
    button $w.f0.b2 -text [_ "Reset bound"] -command {
	set CliPPriv(Boundariesfactor) 1.0
	FillClipPlanesInfo
    }
    pack $w.f0.b1 $w.f0.b2 -side left -fill x -expand 1

    frame $w.f1 -relief ridge -bd 2
    label $w.f1.l -text [_ "Far plane:"]
    entry $w.f1.e -relief sunken -textvariable CliPPriv(Far)
    bind $w.f1.e <Return> { ChangeClipPlane Far $CliPPriv(Far) }
    scale $w.f1.s -highlightbackground black -orient h \
	    -command "ChangeClipPlane Far"

    grid $w.f1.l -sticky w -row 0 -column 0
    grid $w.f1.e -sticky ew -row 0 -column 1
    grid $w.f1.s -sticky ew -row 1 -column 0 -columnspan 2
    grid columnconfigure $w.f1 1 -weight 1

    frame $w.f2 -relief ridge -bd 2
    label $w.f2.l -text [_ "Near plane:"]
    entry $w.f2.e -relief sunken -textvariable CliPPriv(Near)
    bind $w.f2.e <Return> { ChangeClipPlane Near $CliPPriv(Near) }
    scale $w.f2.s -highlightbackground black -orient h \
	    -command "ChangeClipPlane Near"

    grid $w.f2.l -sticky w -row 0 -column 0
    grid $w.f2.e -sticky ew -row 0 -column 1
    grid $w.f2.s -sticky ew -row 1 -column 0 -columnspan 2
    grid columnconfigure $w.f2 1 -weight 1

    frame $w.f3
    checkbutton $w.f3.c -text [_ "Fixed distance"] \
	    -variable CliPPriv(FixedDistanceFlag)
    entry $w.f3.e -relief sunken -textvariable CliPPriv(FixedDistance)

    grid $w.f3.c -sticky w -row 0 -column 0
    grid $w.f3.e -sticky ew -row 0 -column 1
    grid columnconfigure $w.f3 1 -weight 1

    checkbutton $w.din -text [_ "Dynamic update"] \
	    -variable CliPPriv(DynamicUpdate)
    set CliPPriv(DynamicUpdate) 1

    frame $w.f4 -relief ridge -bd 2
    label $w.f4.l -text [_ "Rotation center:"]
    button $w.f4.b -text [_ "Pick"] -command PickPointInClipPlanes
    label $w.f4.lx -text x:
    entry $w.f4.ex -relief sunken -textvariable CliPPriv(Xcenter) -width 4
    label $w.f4.ly -text y:
    entry $w.f4.ey -relief sunken -textvariable CliPPriv(Ycenter) -width 4
    label $w.f4.lz -text z:
    entry $w.f4.ez -relief sunken -textvariable CliPPriv(Zcenter) -width 4

    grid $w.f4.l -sticky w -row 0 -column 0 -columnspan 4
    grid $w.f4.b -sticky e -row 0 -column 4 -columnspan 2
    grid $w.f4.lx  -sticky w -row 1 -column 0
    grid $w.f4.ex  -sticky ew -row 1 -column 1
    grid $w.f4.ly  -sticky w -row 1 -column 2
    grid $w.f4.ey  -sticky ew -row 1 -column 3
    grid $w.f4.lz  -sticky w -row 1 -column 4
    grid $w.f4.ez  -sticky ew -row 1 -column 5
    grid columnconfigure $w.f4 1 -weight 1
    grid columnconfigure $w.f4 3 -weight 1
    grid columnconfigure $w.f4 5 -weight 1



    frame $w.but
    button $w.but.accept -text [_ "Accept"] -command "SendClipPlaneInfo yes no"
    button $w.but.original -text [_ "Original"] -command "ClipPlanesOriginal"
    button $w.but.close -text [_ "Close"] -command "destroy $w"

    grid $w.but.accept $w.but.original $w.but.close


    grid $w.dib -pady 3
    grid $w.f0 -sticky ew -padx 3 -pady 3
    grid $w.f1 -sticky ew -padx 3 -pady 3
    grid $w.f2 -sticky ew -padx 3 -pady 3
    grid $w.f3 -sticky ew -padx 3 -pady 3
    grid $w.din -sticky w -padx 3 -pady 3
    grid $w.f4 -sticky ew -padx 3 -pady 3
    grid $w.but -padx 3 -pady 3
    grid columnconfigure $w 0 -weight 1
    grid rowconfigure $w 0 -weight 1

    set CliPPriv(AvoidUpdate) 0
    set CliPPriv(Boundariesfactor) 1.0

    FillClipPlanesInfo
}


#----------------------CopyMove ALONE---------------------------
if { $ClipPlanesRunningAlone == 1 } {
    ClipPlanes
} 
#-----------------------------------------------------------------
