#!/bin/sh
# -*- mode: Tcl -*-
# ======================================================================
#  AUTHOR:  Derrick S. Kearney, Purdue University
#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
#
#  See the file "license.terms" for information on usage and
#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# ======================================================================
#\
dir=`dirname $0` ; \
. $dir/rappture.env ; \
exec $dir/tclsh "$0" "$@"

package require Rappture
package require RapptureGUI

proc defaultHandler {child} {
    set childchildList {}
    set units [$child get "units"]
    # this is for nanowire
    if {[string is integer -strict $units]} {
        set units ""
    }
    set defaultVal [$child get "default"]
    if {"" != $defaultVal} {
        if {"" != $units} {
            set defaultVal [Rappture::Units::convert $defaultVal \
                            -context $units -to $units -units on]
        }
        $child put "current" $defaultVal
    } else {
        if {"components" != [$child element -as type]} {
            set childchildList [$child children]
        } elseif {"parameters" != [$child element -as type]} {
            set childchildList [$child children]
        } else {
            set childchildList [$child children]
        }
    }
    return $childchildList
}

proc numberHandler {child} {
    set value ""
    set units [$child get "units"]
    set min [$child get "min"]
    set max [$child get "max"]

    if {"" != $min} {
        if {"" != $units} {
            # check to see if the user added units to their min value
            # apps like mosfet need this check.
            set min [Rappture::Units::convert $min \
                        -context $units -to $units -units off]
            if {[string is double -strict $min]} {
                # pass
            }
        }
    }

    if {"" != $max} {
        if {"" != $units} {
            # check to see if the user added units to their min value
            # apps like mosfet need this check.
            set max [Rappture::Units::convert $max \
                        -context $units -to $units -units off]
            if {[string is double -strict $max]} {
                # pass
            }
        }
    }

    if {"yes" == [$child get "simset"]} {
        $child remove "simset"
    } else {
        if { ("" != $min) && ("" != $max) } {
            set value [random $min $max]
            $child put current $value$units
        } else {
            defaultHandler $child
        }
    }
}

proc integerHandler {child} {
    set value ""
    set units [$child get "units"]
    set min [$child get "min"]
    set max [$child get "max"]

    # nanowire needs this because they set units == 0 and 1 ???
    if {[string is integer -strict $units]} {
        set units ""
    }

    if {"" != $min} {
        if {"" != $units} {
            # check to see if the user added units to their min value
            # apps like mosfet need this check.
            set min [Rappture::Units::convert $min \
                        -context $units -to $units -units off]
            if {[string is integer -strict $min]} {
                # pass
            }
        }
    }

    if {"" != $max} {
        if {"" != $units} {
            # check to see if the user added units to their min value
            # apps like mosfet need this check.
            set max [Rappture::Units::convert $max \
                        -context $units -to $units -units off]
            if {[string is integer -strict $max]} {
                # pass
            }
        }
    }

    if {"yes" == [$child get "simset"]} {
        $child remove "simset"
    } else {
        if { ("" != $min) && ("" != $max) } {
            set value [randomInt $min $max]
            $child put current $value$units
        } else {
            defaultHandler $child
        }
    }

}

proc booleanHandler {child} {
    if {"yes" == [$child get "simset"]} {
        $child remove "simset"
    } else {
        set value [expr {int(rand()*2)}]
        if {$value == 1} {
            set value "yes"
        } else {
            set value "no"
        }
        $child put "current" $value
    }
}

proc loaderHandler {child toolDir} {

    set exDir [file join $toolDir "examples"]
    if {! [file isdirectory $exDir]} {
        # in this case we should try to keep processing, not exit
        puts "could not find examples directory: $exDir"
        exit 0
    }

    set exPathExp [$child get example]
    set fpath [file join $exDir $exPathExp]
    set exFileList [glob -nocomplain $fpath]

    if {0 == [llength $exFileList]} {
        puts "while searching examples directory: $exDir"
        puts "could not open find files matching regex: $exPathExp"
        set defaultEx [$child get "default"]
        if {[file exists [file join $exDir $defaultEx]]} {
            lappend exFileList $defaultEx
            puts "using default example file"
        } else {
            puts "default example file does not exists, exiting"
            exit 0;
        }
    }

    set importExFileIdx [expr {int(rand()*[llength $exFileList])}]
    set importExFile [lindex $exFileList $importExFileIdx]

    if {! [file exists $importExFile]} {
        # importExFile does not exist
    }

    set exlib [Rappture::library $importExFile]

    # get the about.label from the file
    # if about.label does not exist, use the file name
    set importExLabel [$exlib get about.label]
    if {"" != $importExLabel} {
        set currentVal $importExLabel
    } else {
        set currentVal [file tail $importExFile]
    }

    $child put "current" $currentVal

    set exlibChildList [::Rappture::entities -as object $exlib "input"]
    return $exlibChildList
}

proc groupHandler {child} {
    return [$child children -as object]
}

proc choiceHandler {valType child} {
    if {"yes" == [$child get "simset"]} {
        $child remove "simset"
    } else {
        set optList [$child children -as object -type option]
        set optLib ""
        set value ""
        if {[llength $optList] > 0} {
            if {"random" == $valType} {
                set optIdx [expr {int(rand()*[llength $optList])}]
                set optLib [lindex $optList $optIdx]
                set value [$optLib get value]
            } elseif {"default" == $valType} {
                set defaultVal [$child get default]
                foreach optLib $optList {
                    set label [$optLib get about.label]
                    set valTag [$optLib get value]
                    if {($defaultVal == $label) || ($defaultVal == $valTag)} {
                        set value $valTag
                        break
                    }
                }
            }

            if {"" == $value} {
                set optLib [lindex $optList 0]
                set value [$optLib get value]
                if {"" == $value} {
                    set value [$optLib get about.label]
                }
            }
        }
        $child put "current" $value
    }
}

proc defaultize {xmlobj toolDir} {
    set childList [$xmlobj children -as object input]

    while {[llength $childList]} {
        set child [lrange $childList 0 0]
        set childList [lreplace $childList 0 0]

        switch -- [$child element -as type] {
            number      { defaultHandler $child }
            integer     { defaultHandler $child }
            boolean     { defaultHandler $child }
            string      { defaultHandler $child }
            choice      { choiceHandler default $child }
            loader      { loaderHandler  $child $toolDir }
            structure   { defaultHandler $child }
            group       { set cclist [groupHandler $child]
                          set childList [concat $childList $cclist] }
            phase       { set cclist [groupHandler $child]
                          set childList [concat $childList $cclist] }
            default     { defaultHandler $child }
        }
    }
}

proc randomize {presetArr xmlobj toolDir} {
    upvar $presetArr presets
    set childList [$xmlobj children -as object input]

    while {[llength $childList]} {

        set child [lrange $childList 0 0]
        set childList [lreplace $childList 0 0]

        set cpath [cleanPath [$child element -as path]]

        set ppath [$child parent -as path]
        set cPresets [array get presets $cpath*]

        foreach {cPresetsPath cPresetsVal} $cPresets {
            set cutIdx [expr {[string length $cpath] + 1}]
            set iPath [string range $cPresetsPath $cutIdx end]

            # apply the preset value and remove from preset array
            $child put $iPath $cPresetsVal
            unset presets($cPresetsPath)

            # if the value was set on a current node, then set a preset flag
            if {"current" == $iPath} {
                $child put simset "yes"
            }
        }

        switch -- [$child element -as type] {
            number    { numberHandler  $child }
            integer   { integerHandler $child }
            boolean   { booleanHandler $child }
            string    { defaultHandler $child }
            choice    { choiceHandler random  $child }
            loader    {
                set cpath [$child element -as path]
                set ccList [loaderHandler $child $toolDir]
                foreach cc $ccList {
                    set ccpath [$cc element -as path]
                    # even though the loader might have been returned in ccList
                    # do not add the loader back to the childList or you might
                    # get an infinite loop
                    if {$cpath != $ccpath} {
                        set ccpath [cleanPath $ccpath]
                        $xmlobj copy $ccpath from $cc ""
                        lappend childList [$xmlobj element -as object $ccpath]
                    }
                }
            }
            structure { defaultHandler $child }
            group     {
                set ccList [groupHandler $child]
                set childList [concat $childList $ccList]
            }
            phase     {
                set ccList [groupHandler $child]
                set childList [concat $childList $ccList]
            }
            default   { defaultHandler $child }
        }
    }
}

proc random {m M} {
    return [expr {$m+(rand()*($M-$m))}]
}

proc randomInt {m M} {
    return [expr {int(rand()*($M-$m+1)+$m)}]
}

proc cleanPath { path } {
    if {"." == [string index $path 0]} {
        # this is because tcl's library module (element -as path)
        # returns a crazy dot in the 0th position
        set path [string range $path 1 end]
    }
    return $path
}

proc parsePathVal {listVar returnVar} {
    upvar $listVar params
    upvar $returnVar presetArr
    catch {unset presetArr}

    # initialize variables
    set pathValStr ""
    set match "junk"

    while {"" != $match} {
        set match ""
        set path ""
        set val ""
        set val2 ""
        set val3 ""
        set val4 ""
        set pathValStr [string trimleft [join $params " "]]

        # search the params for:
        # 1) xml path
        # 2) followed by = sign
        # 3) followed by a starting " sign
        # 4) followed by any text (including spaces)
        # 5) followed by an ending " sign
        # ex: input.number(temperature).current="400K"
        # ex: input.number(temperature).current=400K
        # ex: input.string(blahh).current="hi momma, i love you!"
        #    \"([^\"]+)\"
        #    ((\"([^\"]+)\")|(:([^:]+):)|(\'([^\']+)\')|([^\s]+))
        regexp -expanded {
            (
                [a-zA-Z0-9]+(\([a-zA-Z0-9._]+\))?
                (\.[a-zA-Z0-9]+(\([a-zA-Z0-9._]+\))?)*
            )
            =
            ((\"([^\"]+)\")|(\'([^\']+)\')|([^\s]+))
        } $pathValStr match path junk junk junk val junk val2 junk val3 val4


        if {"" != $match} {
            # remove the matching element from orphaned params list
            foreach p [split $match] {
                set paramsIdx [lsearch -exact $params $p]
                set params [lreplace $params $paramsIdx $paramsIdx]
            }

            if {("" != $val2) && ("" == $val3) && ("" == $val4)} {
                set val $val2
            } elseif {("" == $val2) && ("" != $val3) && ("" == $val4)} {
                set val $val3
            } elseif {("" == $val2) && ("" == $val3) && ("" != $val4)} {
                set val $val4
            }

            # add the name and value to our preset array
            set presetArr($path) $val
        }
    }
}

proc printHelp {} {
    set help {
simsim [OPTIONS] [CONST]

simulator simulator - simulate simulation

OPTIONS:
 -tool <path>        - use the tool.xml file specified at <path>
 -values <valtype>   - the type of values used to populate driver file.
                       valid <valtype>'s include:
                       "default" - replace <current> values with <default>'s,
                       "current" - use <current> values (ie do nothing),
                       "random" - generate random values for <current>.
 -driver <path>      - write a driver file to <path>.
 -compare <path>     - compare the results with the run.xml
                       file at <path>.
 -runfile <path>     - move the run file to <path>
 -nosim              - no simulation.
 -help               - print this help menu.

CONST:
 when -values is set to random, constant values can be set for
 specific inputs. the general form for constant values is:

   xmlpath(id)=value

 where xmlpath is the path of the element in the xml tree,
 id is the id of the xml node and value is the constant value
 you want to place in the element. the following the constant
 will set input.number(Ef).current to the value "2eV":

   input.number(Ef)=2eV

EXAMPLES:
simulate using ./tool.xml, default values, no comparisons or driver
    simsim

simulate using ./tool.xml, random values, no comparisons or driver
    simsim -values random

from ./tool.xml, create a driver file named "mydriverfile.xml"
with default values
    simsim -nosim -driver mydriverfile.xml

from ./tool.xml, create a driver file named "mydriverfile.xml"
with random values
    simsim -values random -nosim -driver mydriverfile.xml

from ./tool.xml, simulate with random values but set
input.number(Ef) to "2eV"
    simsim -values random input.number(Ef).current=2eV

run a simulation using the current values from driver.xml,
"-values current" is only useful if you are asking
simsim to run the simulation and you provide a driver file.
    simsim -tool driver.xml -values current

compare two xml file, don't do a simulation, don't print a driver.xml
    simsim -tool driver.xml -compare previousrun.xml -nosim

run a simulation and compare the result to previousrun.xml
    simsim -compare previousrun.xml

}
    puts $help
    exit 0
}

proc diffs {xmlobj1 xmlobj2} {
    set rlist ""

    # query the values for all entities in both objects
    set thisv [concat [Rappture::entities $xmlobj1 "input"] [Rappture::entities $xmlobj1 "output"]]
    set otherv [concat [Rappture::entities $xmlobj2 "input"] [Rappture::entities $xmlobj2 "output"]]

    # scan through values for this object and compare against other one
    foreach path $thisv {
        set i [lsearch -exact $otherv $path]
        if {$i < 0} {
            foreach {raw norm} [value $xmlobj1 $path] break
            lappend rlist - $path $raw ""
        } else {
            foreach {traw tnorm} [value $xmlobj1 $path] break
            foreach {oraw onorm} [value $xmlobj2 $path] break
            if {![string equal $tnorm $onorm]} {
                lappend rlist c $path $traw $oraw
            }
            set otherv [lreplace $otherv $i $i]
        }
    }

    #add any values left over in the other object
    foreach path $otherv {
        foreach {oraw onorm} [Rappture::LibraryObj::value $xmlobj2 $path] break
        lappend rlist + $path "" $oraw
    }
    return $rlist
}

proc value {libobj path} {
    switch -- [$libobj element -as type $path] {
        structure {
            set raw $path
            # try to find a label to represent the structure
            set val [$libobj get $path.about.label]
            if {"" == $val} {
                set val [$libobj get $path.current.about.label]
            }
            if {"" == $val} {
                if {[$libobj element $path.current] != ""} {
                    set comps [$libobj children $path.current.components]
                    set val "<structure> with [llength $comps] components"
                } else {
                    set val "<structure>"
                }
            }
            return [list $raw $val]
        }
        number {
            # get the usual value...
            set raw ""
            if {"" != [$libobj element $path.current]} {
                set raw [$libobj get $path.current]
            } elseif {"" != [$libobj element $path.default]} {
                set raw [$libobj get $path.default]
            }
            if {"" != $raw} {
                set val $raw
                # then normalize to default units
                set units [$libobj get $path.units]
                if {"" != $units} {
                    set val [Rappture::Units::convert $val \
                        -context $units -to $units -units off]
                }
            }
            return [list $raw $val]
        }
        curve {
            set raw ""
            if {"" != [$libobj element $path.component.xy]} {
                set raw [$libobj get $path.component.xy]
            }
            return [list $raw $raw]
        }
        log {
            set raw ""
            if {"" != [$libobj element]} {
                set raw [$libobj get]
            }
            return [list $raw $raw]
        }
        cloud {
            set raw ""
            if {"" != [$libobj element $path.points]} {
                set raw [$libobj get $path.points]
            }
            return [list $raw $raw]
        }
        field {
            set raw ""
            if {"" != [$libobj element $path.component.values]} {
                set raw [$libobj get $path.component.values]
            }
            return [list $raw $raw]
        }


    }

    # for all other types, get the value (current, or maybe default)
    set raw ""
    if {"" != [$libobj element $path.current]} {
        set raw [$libobj get $path.current]
    } elseif {"" != [$libobj element $path.default]} {
        set raw [$libobj get $path.default]
    }
    return [list $raw $raw]
}

proc compare {orig result} {
    if {"" == $orig} {
        return
    }
    if {"" == $result} {
        return
    }

    if {![Rappture::library isvalid $orig]} {
        set origObj [Rappture::library $orig]
        if {![Rappture::library isvalid $origObj]} {
            puts "cannot create Rappture library from $orig\n"
            return
        }
    } else {
        set origObj $orig
    }

    if {![Rappture::library isvalid $result]} {
        set resultObj [Rappture::library $result]
        if {![Rappture::library isvalid $resultObj]} {
            puts "cannot create Rappture library from $result\n"
            return
        }
    } else {
        set resultObj $result
    }

    foreach {op vpath oldval newval} [diffs $origObj $resultObj] {
        puts "$op $vpath $oldval $newval"
    }
}

proc parseOptions {listVar returnVar} {
    upvar $listVar argv
    upvar $returnVar params

    # parse command line arguments
    set argc [llength $argv]
    for {set i 0} {$i < $argc} {incr i} {
        set opt [lindex $argv $i]
        if { ("-t" == $opt)    ||
             ("-tool" == $opt) ||
             ("--tool" == $opt)   } {
            if {[expr {$i + 1}] < $argc} {
                incr i
                set params(--tool) [lindex $argv $i]
                # need to check to see if file exists, if not raise error
            } else {
                printHelp
            }
        } elseif {  ("-tooldir" == $opt) ||
                    ("--tooldir" == $opt)    } {
            if {[expr {$i + 1}] < $argc} {
                incr i
                set params(--tooldir) [lindex $argv $i]
                # need to check to see if directory exists, if not raise error
            } else {
                printHelp
            }
        } elseif {  ("-d" == $opt)      ||
                    ("-driver" == $opt) ||
                    ("--driver" == $opt)    } {
            if {[expr {$i + 1}] < $argc} {
                incr i
                set params(--driver) [lindex $argv $i]
                # need to check to see if file exists, if not raise error
            } else {
                printHelp
            }
        } elseif {  ("-r" == $opt)      ||
                    ("-runfile" == $opt) ||
                    ("--runfile" == $opt)    } {
            if {[expr {$i + 1}] < $argc} {
                incr i
                set params(--runfile) [lindex $argv $i]
            } else {
                printHelp
            }
        } elseif {  ("-v" == $opt)      ||
                    ("-values" == $opt) ||
                    ("--values" == $opt)    } {
            if {[expr {$i + 1}] < $argc} {
                incr i
                set valuesFlag [lindex $argv $i]
                if {("default" == $valuesFlag) ||
                    ("current" == $valuesFlag) ||
                    ("random" == $valuesFlag)  } {
                    set params(--values) $valuesFlag
                } else {
                    printHelp
                }
            } else {
                printHelp
            }
        } elseif {  ("-c" == $opt)      ||
                    ("-compare" == $opt)||
                    ("--compare" == $opt)   } {
            if {[expr {$i + 1}] < $argc} {
                incr i
                set params(--compare) [lindex $argv $i]
                # need to check to see if file exists, if not raise error
            } else {
                printHelp
            }
        } elseif {  ("-n" == $opt)      ||
                    ("-nosim" == $opt)  ||
                    ("--nosim" == $opt)     } {
            set params(--nosim) true
        } elseif {  ("-h" == $opt)      ||
                    ("-help" == $opt)   ||
                    ("--help" == $opt)      } {
            printHelp
        } else {
            # place all extra params in the params array
            lappend params(oParams) $opt
        }
    }
}

proc storeoutput {data} {
    global _d
    append _d $data
}

proc main {argv} {
    # set default values
    array set presets []
    set i 0

    array set params {
        --compare ""
        --values default
        --nosim false
        --driver ""
        --runfile ""
        --tool "./tool.xml"
        --tooldir ""
        oParams {}
    }

    parseOptions argv params

    # keep the wish window from popping up
    catch {wm withdraw .}

    # parse out path=val combinations from the list of orphaned parameters
    parsePathVal params(oParams) presets
    if {0 != [llength $params(oParams)]} {
        puts "Could not understand the following parameters"
        puts "params(oParams) = $params(oParams)"
        puts "length params(oParams) = [llength $params(oParams)]"
    }

    set err ""
    if {! [file exists $params(--tool)]} {
        append err "\ntool file \""
        append err $params(--tool)
        append err "\" does not exist, use -t option\n"
        puts $err
        printHelp
    }

    set xmlobj [Rappture::library $params(--tool)]
    if {$params(--tooldir) == ""} {
        set installdir [file dirname $params(--tool)]
    } else {
        set installdir $params(--tooldir)
    }

    # need a better way to do this,
    # maybe just take xmldiff functionality out of simsim
    if {(!$params(--nosim)) || ("" != $params(--driver))} {
        switch -- $params(--values) {
            random      { randomize presets $xmlobj $installdir }
            current     { }
            default     { defaultize $xmlobj $installdir }
        }
    }

    if {"" != $params(--driver)} {
        set fid [open $params(--driver) w]
        puts $fid {<?xml version="1.0"?>}
        puts $fid [$xmlobj xml]
        close $fid
    }

    if {$params(--nosim)} {
        if {"" != $params(--compare)} {
            compare $xmlobj $params(--compare)
        }
        exit 0
    }




    set tool [Rappture::Tool ::#auto $xmlobj $installdir]

    # read the run.xml file.
    # from analyzer.tcl:

    set result ""
    # execute the job
    foreach {status result} [eval $tool run -output storeoutput] break

    # if run was successful, check to see if we should compare
    if {$status == 0 && $result != "ABORT"} {
        global _d
        if {[regexp {=RAPPTURE-RUN=>([^\n]+)} $_d match result]} {
            if {[string compare "" $params(--runfile)] != 0} {
                if {[catch {file rename -force -- $result $params(--runfile)} out]} {
                    puts stderr "while moving $result to $params(--runfile): $out"
                }
            }
            # do comparison if user chose to compare with other results
            if {"" != $params(--compare)} {
                compare $params(--compare) $result
            }
        } else {
            set status 1
            puts "Can't find result file in output.\nDid you call Rappture::result in your simulator?"
        }
    } else {
        puts $result
    }
}

main $argv
exit 0
