#
# Control panel for the Monte Carlo generator
#
# See the Carlo man page for more information.
#
# $Id: carlo.tcl,v 1.4 1994/08/10 18:28:04 weibel Exp $
#

proc gui_carlo {} {
    global carlo ssa
    
    catch {destroy .car}
    toplevel .car -bd 1m
    wm title .car {Monte Carlo Test}

    scale .car.th -label {Significance (%)} -from 50 -to 100 -orient horizontal -length 200 -command {set carlo(sig)}
    mkRadioPanel .car.a "Noise model" {"white noise" carlo(ar) {-w}} {AR(1) carlo(ar) {-ar}}
    frame .car.n
    label  .car.n.l -text " realizations"
    entry  .car.n.e  -relief sunken  -width 10 -textvariable carlo(n)
    checkbutton .car.tog -text "Compute SSA" -variable carlo(ssatog) -relief flat \
	-command {expose_ssa $carlo(ssatog)}
    frame .car.s
    label .car.s.la -text Seeds
    entry .car.s.i1 -relief sunken -width 6 -textvariable carlo(i1)
    entry .car.s.i2 -relief sunken -width 6 -textvariable carlo(i2)
    entry .car.s.i3 -relief sunken -width 6 -textvariable carlo(i3)
    entry .car.s.i4 -relief sunken -width 6 -textvariable carlo(i4)
    frame .car.ssa
    checkbutton .car.wol -text "Fix SSA components" -variable carlo(wol) -relief flat -command {expose_comps $carlo(wol)}
    entry .car.wo  -relief sunken -textvariable carlo(comps) -width 18
    label .car.t -width 16
    button .car.ok -text "Go for it" -relief groove -bd 4 -padx 1m -command {do_carlo $datadir/$infile}
    button .car.bye -text "Done" -relief raised -bd 1 -padx 2m -command {destroy .car}

    pack .car.n .car.th .car.a .car.s .car.tog .car.t -side top -padx 2m -pady 1m -anchor w 
    pack .car.s.la -side top -anchor w
    pack .car.s.i1 .car.s.i2 .car.s.i3 .car.s.i4 -side left -padx 2 -anchor w
    pack .car.n.e .car.n.l -in .car.n -side left -expand 1
    pack .car.wol -in .car.ssa -pady 1m -anchor w
    pack .car.ok -side left -padx 2m -pady 1m
    pack .car.bye -side left -expand 1
    if {$carlo(ssatog)} { expose_ssa 1}
    if {$carlo(wol)} { expose_comps 1 }
   
    if ![info exists carlo(sig)] {set carlo(sig) 95}
    if {![info exists ssa(wlength)] || $ssa(wlength) == {}} {set ssa(wlength) 100}
    if {![info exists carlo(n)] || $carlo(n) == {}} {set carlo(n) 200}
    if {![info exists carlo(ar)] || $carlo(ar) == {}} {set carlo(ar) -w}
    if {![info exists carlo(i1)] || $carlo(i1) == {}} {
	set carlo(i1) 7; set carlo(i2) 20; set carlo(i3) 55 ; set carlo(i4) 4}
    .car.th set $carlo(sig)

# Clean-O, clean-o, clean!
    bind .car <Destroy> {catch {eval exec rm mcarlo.out mcsig.out}}
}

proc do_carlo {infile} {
    global carlo ssa viz

    if [Badseeds] {return -1}
    set seeds [list -seed "$carlo(i1) $carlo(i2) $carlo(i3) $carlo(i4)" ] 
    .car.t configure -text "Working..."  ;  Reverse .car.t  ;  update
    if {$carlo(wol)} then {
	set components [list -wo $carlo(comps)]
    } else {
	set components {}
    }
    if {$carlo(ssatog)} {
	set legends [list "[expr 50 + $carlo(sig)/2.] percentile" "[expr 50 - $carlo(sig)/2.] percentile"]
	# Do carlo with ssa tests
	set status [catch {eval exec carlo $infile -v -n $carlo(n) $carlo(ar) $ssa(cov) $seeds \
		     -sig $carlo(sig) -ssa $ssa(wlength) $components} msg]
	if {$status == 0} {
	    plot_$viz $ssa(ev_win_p) linear-log {test_ev.out xydydy curve} [list mcsig.out xy1y2... curve $legends]
	}
    } else {
	#Do carlo without ssa tests
	set status [catch {eval exec carlo $infile -v -n $carlo(n) $carlo(ar) $seeds -sig $carlo(sig)} msg]
    }
    exec echo $msg >> spectra.log
    if {$status == 0} {
	.car.t configure -text Done  ;  Reverse .car.t
    } else {
	.car.t configure -text Error ;  Reverse .car.t ;  ErrorBox "Carlo Error:\n$msg"
    }
}


proc expose_ssa { expose } {
    global carlo
    if {$expose} {
	if ![winfo ismapped .car.ssa] {
	    pack .car.ssa -after .car.tog -pady 1m -padx 2m -anchor w
	}
    } else {
	if [winfo ismapped .car.ssa] {
	    pack forget .car.ssa
	}
    }
}

proc expose_comps { expose } {
    if {$expose} {
	if ![winfo ismapped .car.wo] {
	    pack .car.wo -after .car.wol -pady 1m -anchor w
	}
    } else {
	if [winfo ismapped .car.wo] {
	    pack forget .car.wo
	}
    }
}


proc Badseeds {} {
    global carlo
    if {$carlo(i1) < 1 || $carlo(i1) > 178} {
	ErrorBox {You must replace the first seed with a number between 1 and 178.}
	return 1
    }
    if {$carlo(i2) < 1 || $carlo(i2) > 178} {
	ErrorBox {You must replace the second seed with a number between 1 and 178.}
	return 1
    }
    if {$carlo(i3) < 1 || $carlo(i3) > 178} {
	ErrorBox {You must replace the third seed with a number between 1 and 178.}
	return 1
    }
    if {$carlo(i4) < 0 || $carlo(i4) > 168} {
	ErrorBox {You must replace the fourth seed with a number between 0 and 168.}
	return 1
    }
    return 0
}