#!/usr/bin/wish
# The next line restarts using wish8.4 \
exec wish8.4 $0 ${1+"$@"}
#====================================================================#
#    A launcher for modele-ii de @author Pierre Legendre             #
#                                                                    #
#       @author Michel PICARD                                        #
#       @date 2007                                                   #
#====================================================================#
#                                                                    #
#  Regression de modele II                                           #
#     pour les cas ou y et x sont deux variables aleatoires.         #
#     Estimation des parametres  de l'equation fonctionnelle         #
#     y = b0 + b1*x                                                  #
#                    (c) Pierre Legendre, 1994, 1999, 2000           #
#   Departement de sciences biologiques, Univ. de Montreal           #
#                                                                    #
#====================================================================#
#                                                                    #
#  requirements : tcl/tk (8.4) scripting and graphic language        #
#             msgcat (1.3) tcl package to manage multi-lingual GUI   #
#             gnuplot for graphic outputs                            #
#                                                                    #
#====================================================================#
#  known bug :

#==========================================#
# Read static configuration data           #
#==========================================#

    set rundir [pwd]                                        ;#! where the script is called
    set datdir [pwd]                                        ;# where the data file are
    set srcdir [file dirname $argv0]                        ;# where the script components are sourced
#    set srcdir ""                                          ;# for freewrap
#    set srcdir $starkit::topdir/lib/app-deskin             ;# for tclkit
    set srcdir [file normalize $srcdir]
    set exedir $srcdir                                      ;# where the external programs are
    set icodir [file join $srcdir icon]                     ;#! for GUI icons and bitmaps

#==========================================#
# Read installation setup                  # (file fixed during installation)
#==========================================#
    set inifile [file join $rundir lmodel2.ini]             ;#! initial config file name
    if [file exist $inifile] {
        catch [source $inifile]                             ;# reads init values
    }

#==========================================#
# Read user preferences                    # (file updated at each exit)
#==========================================#

    set helpdir $rundir
    set helpfile [file join $rundir error.html]             ;#! help file name with path

    set cfgfile [file join $rundir lmodel2.cfg]
    if [file exist $cfgfile] {
        catch [source $cfgfile]                             ;# reads init values
    } else {                                                ;# else use default values 
        wm geometry . 600x400+10+15
    }

#==========================================#
# Check for available package              #
# Get some small utilities                 #
#==========================================#

    source [file join $srcdir util.tcl]                     ;# some small utilities
    package require msgcat 1.3
    IntlMsg $srcdir                                         ;# get messages in local language

#==========================================#
# Build main GUI and display main page     #
#==========================================#
    source [file join $srcdir guidef.tcl]                   ;# Build main GUI

#==========================================#
# Load call backs and help routines        #
#==========================================#
    source [file join $srcdir callbck1.tcl]                 ;# Callback for read write

#==========================================#
# bindings                                 #
#==========================================#

######################################################################
#  End of GUI construction, now the user acts with the GUI           #
######################################################################

#==========================================#
# create a small console to execute        #
# external programs                        #
#==========================================#
# cmdproc : procedure à  executer
# this procedure is called by the gui widget
proc topconsole {cmdproc} {
global cst run_button
global exedir

# Create topwindow
#------------------------------
    catch [destroy .fene]
    toplevel .fene -width 15c -height 5c
    set csl .fene.console                                                ;# console = display term
    frame $csl -bd 1  -relief sunken
    pack $csl -side top -expand yes -fill both

# Add a text widget to trace input and output
#------------------------------
    set cst $csl.txt                                                      ;# writing zone
    text $cst -borderwidth 2 -relief raised -setgrid true -bg white \
          -yscrollcommand "$csl.scroll set"
    scrollbar $csl.scroll -command "$cst yview"                           ;# vertical scroll
    pack $csl.scroll -side right -fill y
    pack $cst -side left -fill both -expand true

# Define visual tags and display exe directory
#------------------------------
    $cst tag configure tagbleu -foreground darkblue -background lightblue
    $cst tag configure tagrouge -foreground darkred -background pink
    $cst insert end "init dir $exedir\n" tagbleu

# Add a bottom button toolbar
#------------------------------
    set fc .fene.bts
    frame $fc -bd 1
    pack $fc -side top

    button $fc.dir -text "[::msgcat::mc "Change directory"] exe" -width 18 -command \
         {set exedir [ChangeDir $exedir ]}
    button $fc.quitte -text [msgcat::mc Close] -width 14 \
       -command {destroy [winfo children .fene ] .fene}               ;# quit boutton
    set run_button [button $fc.calc -text [msgcat::mc "Run"] -command $cmdproc -width 14]
    pack $fc.dir $fc.calc $fc.quitte -padx 2 -side left

    tkwait visibility $fc.quitte                                      ;# wait till all widgets are visible
    return $cst
}

#===================================#
#  Lance le programme de calcul     #
#===================================#
# pas d'arguments, procedure appelée par topconsole
proc LanceExe {} {
global nomfichdat nomfichres exedir
global cst input run_button                                         ;# variables de topconsole
global tcl_platform

   # prepare les arguments
   #----------------------

    set nomexe [file join $exedir model-iiub]
    if {$tcl_platform(os) == "Windows"} {
       set nomexe $nomexe.exe
    }
    if ![file exist $nomexe] {
        $cst insert end "$nomexe not found\n" tagrouge
    }

    set command $nomexe
    $cst insert end $command\n tagbleu           ;# affiche la ligne de commande dans la console

    # spécifique à ce programme !
    set dirdat [file dirname $nomfichdat]
    cd $dirdat

    # Ouvre un pipeline de calcul
    #-----------------------------
    set comm [concat $command]
    if [catch {open "|$comm"  "r+"} input] {
        $cst insert end $input\n                             ;# pb ouverture du pipeline
    } else {
        fconfigure $input -buffering line
        fileevent $input readable [list ecritrace LanceExe]    ;# interception evenement pour afficher
        $run_button configure -text [msgcat::mc "Stop"] -command [list stop LanceExe]   ;# le bouton devient stop
    }
}

#======================================#
# Read and log output from the program #
#======================================#
proc ecritrace {cmdproc} {
global cst input run_button                                     ;#  console window ; pipe input ; bouton lance
global nomfichdat nomfichres
global AMDC ordre permu nbligne cadx cady

    if [eof $input] {                                           ;# teste si c'est le pipe est encore actif
        catch {close $input}                                    ;# close pipe
        $cst insert end "... Fin de programme ...\n" tagrouge
        $run_button configure -text [ ::msgcat::mc "Compute"] -command $cmdproc
    } else {
        gets $input ligne
        if [regexp {(?i)err(o|eu)r} $ligne] {
            $cst insert end $ligne\n tagrouge                    ;# la ligne contient ERREUR
        } elseif [regexp {(msg|stop)} $ligne] {
            $cst insert end $ligne\n tagbleu
        } else {
            $cst insert end $ligne\n                             ;# ligne normale du programme
        }
    update idletasks

# répond aux questions
        if [regexp {(English)} $ligne] {
           puts $input 1
           $cst insert end 1\n
        } elseif [regexp {(Nom du fichier de resultats)} $ligne] {
           puts $input [file tail $nomfichres]
           $cst insert end [file tail $nomfichres]\n
        } elseif [regexp {(Nom du fichier de donnees)} $ligne] {
           puts $input [file tail $nomfichdat]
           $cst insert end [file tail $nomfichdat]\n
        } elseif [regexp {(Nombre de lignes de la matrice)} $ligne] {
           puts $input $nbligne
           $cst insert end $nbligne\n
        } elseif [regexp {(y d'abord, x ensuite)} $ligne] {
           puts $input $ordre
           $cst insert end $ordre\n
        } elseif [regexp {(\(0\) non,  \(1\) oui)} $ligne] {
           puts $input $AMDC
           $cst insert end $AMDC\n
        } elseif [regexp {(pas de test par permutation)} $ligne] {
           puts $input $permu
           $cst insert end $permu
        } elseif [regexp {(y' = (y-ymin)/(ymax-ymin))} $ligne] {
           puts $input $cady
           $cst insert end $cady
         } elseif [regexp {(x' = (x-xmin)/(xmax-xmin))} $ligne] {
           puts $input $cadx
           $cst insert end $cadx
        }
    }

    $cst see end
    update idletasks
}

#=======================================#
# Stop the program and fix up the button
#=======================================#
proc stop {cmdproc} {
global input run_button
    catch {close $input}
    $run_button config -text [ ::msgcat::mc "Compute"] -command $cmdproc
}