# Copyright (C) 2005, 2006 Frank Michler, Philipps-University Marburg, Germany
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
set None -9999
proc MakeList2D {x y {DefaultValue 0}} {
set tmprow {}
for {set i 0} {$i < $y} {incr i} {
lappend tmprow $DefaultValue
}
set arr2d {}
for {set j 0} {$j < $x} {incr j} {
lappend arr2d $tmprow
}
return $arr2d
}
proc MakeList3D {x y z {DefaultValue 0}} {
set tmprow [MakeList2D $y $z]
set arr3d {}
for {set j 0} {$j < $x} {incr j} {
lappend arr3d $tmprow
}
return $arr3d
}
proc List2DToArray2D {OriList} {
set i 0
array set OutputArray {}
foreach Row $OriList {
set j 0
foreach Elm $Row {
set OutputArray($i,$j) $Elm
incr j
}
incr i
}
set OutputArray(x) $i
set OutputArray(y) $j
return [array get OutputArray]
}
proc Array2DToList2D {ParaArray} {
array set OriArray $ParaArray
set OutputList {}
for {set i 0} {$i < $OriArray(x)} {incr i} {
set tmprow {}
for {set j 0} {$j < $OriArray(y)} {incr j} {
lappend tmprow $OriArray($i,$j)
}
lappend OutputList $tmprow
}
return $OutputList
}
proc SetArray2DToList2D {ParaArray Value} {
array set OriArray $ParaArray
set OutputList {}
for {set i 0} {$i < $OriArray(x)} {incr i} {
set tmprow {}
for {set j 0} {$j < $OriArray(y)} {incr j} {
lappend tmprow $Value
}
lappend OutputList $tmprow
}
return $OutputList
}
proc SetDiagonal2D {ArrayName value} {
upvar $ArrayName MyArr
for {set xx 0} {$xx<$MyArr(x)} {incr xx} {
set MyArr($xx,$xx) $value
}
}
proc SetWholeArray2D {ArrayName value} {
upvar $ArrayName MyArr
for {set xx 0} {$xx<$MyArr(x)} {incr xx} {
for {set yy 0} {$yy<$MyArr(x)} {incr yy} {
set MyArr($xx,$yy) $value
}
}
}
proc L1Dincr {MyList x} {
upvar $MyList UpList
lset UpList $x [expr [lindex $UpList $x]+1]
}
proc L2Dincr {MyList x y} {
upvar $MyList UpList
lset UpList $x $y [expr [lindex $UpList $x $y]+1]
}
#nicht effizient, aber allgemein
# evtl. mit case-Abfrage die Länge von args berücksichtigen
proc lincr {MyList args} {
upvar $MyList UpList
eval lset [concat UpList $args [expr [eval lindex [concat [list $UpList] $args]] +1]]
}
proc TestLibSimcontrol {} {
puts "LibSimcontrol, Version 0.01"
}
proc DestroyElements {ElementList} {
foreach w $ElementList {
destroy $w
}
}
#####################################
#HIER GEHTS WEITER
proc SetSimDirAndFileNames {SName} {
puts "SimulationName= $SName"
set ::SimDir [pwd]
set ::SimDir "${::SimDir}/"
set ::SimName ${::SimDir}${::SimulationName}
puts "SimName= $::SimName"
set ::SimConfigFile ${::SimDir}settings_${::SimulationName}.cfg
set ::SimOptionsFile ${::SimDir}options_${::SimulationName}.cfg
ReadSimConfigFile
# SimDataDir aus config file auslesen, $HOME durch $::env(HOME) ersetzen
puts "DataDirectory= $::SimOptions(DataDirectory) \n"
set ::SimDataDir [regsub {\$HOME} $::SimOptions(DataDirectory) $::env(HOME)]
#set ::SimDataDir "$::env(HOME)/data/sim/csim/$::SimulationName/"
if {[regexp "/$" $::SimDataDir] != 1} {
puts "add trailing slash to SimDataDir\n";
set ::SimDataDir $::SimDataDir/
}
puts "DataDirectory= $::SimDataDir"
}
proc SimFlagsEntry {ParaName ParaLabel ParentFrame} {
lappend ::SimFlagsList $ParaLabel
set CurCheckbutton [checkbutton ${ParentFrame}.$ParaName -text "$ParaLabel" -variable ::SimFlags($ParaLabel)]
pack $CurCheckbutton -anchor sw -side top
}
proc SimFlagsEntry2 {ParaName ParaLabel ParentFrame} {
lappend ::SimFlagsList $ParaLabel
frame ${ParentFrame}.${ParaName}
pack ${ParentFrame}.${ParaName} -anchor e
set curframe2 ${ParentFrame}.${ParaName}
set CurCheckbutton [checkbutton ${curframe2}.checkbutton -text "$ParaLabel" -variable ::SimFlags($ParaLabel)]
pack $CurCheckbutton -anchor sw -side left
pack [button ${curframe2}.hideButton -command "HideOptionEntry $curframe2 $ParaLabel" -text "Hide"] -side left -anchor center -pady 0
}
proc SimOptionsEntry {ParaName ParaLabel ParentFrame} {
lappend ::SimOptionsList $ParaLabel
frame ${ParentFrame}.${ParaName}
pack ${ParentFrame}.${ParaName} -anchor e
set curframe2 ${ParentFrame}.${ParaName}
label ${curframe2}.${ParaName}label -text "$ParaLabel="
pack ${curframe2}.${ParaName}label -anchor sw -side left
# set mybut [entry ${curframe2}.${ParaName}entry -textvariable ::$ParaLabel -width 7 -bg white -relief flat -border 5 -highlightcolor green]
set mybut [entry ${curframe2}.${ParaName}entry -textvariable ::SimOptions($ParaLabel) -width 7 -bg white -relief sunken -border 1 -highlightcolor green]
pack $mybut -side left -anchor n -side right -pady 2
}
proc SimOptionsEntry2 {ParaName ParentFrame} {
set ParaLabel $ParaName
set FrameName soe$ParaName
lappend ::SimOptionsList $ParaLabel
frame ${ParentFrame}.${FrameName}
pack ${ParentFrame}.${FrameName} -anchor e
set curframe2 ${ParentFrame}.${FrameName}
label ${curframe2}.${FrameName}label -text "$ParaLabel="
pack ${curframe2}.${FrameName}label -anchor sw -side left
set mybut [entry ${curframe2}.${FrameName}entry -textvariable ::SimOptions($ParaName) -width 7 -bg white -relief sunken -border 1 -highlightcolor green]
pack $mybut -side left -anchor n -side right -pady 2
}
proc HideOptionEntry {Frame Label} {
destroy $Frame
set size [file size ${::SimOptionsFile}]
set fd [open ${::SimOptionsFile}]
set xml [read $fd $size]
close $fd
set doc [dom parse -simple $xml]
set root [$doc documentElement]
set node [$root child 1 $Label]
$node setAttribute flag 0
set fd [open ${::SimOptionsFile} w]
puts $fd [$root asXML]
close $fd
$doc delete
}
proc SimOptionsEntry3 {ParaName ParaLabel ParentFrame} {
lappend ::SimOptionsList $ParaLabel
frame ${ParentFrame}.${ParaName}
pack ${ParentFrame}.${ParaName} -anchor e
set curframe2 ${ParentFrame}.${ParaName}
label ${curframe2}.${ParaName}label -text "$ParaLabel="
pack ${curframe2}.${ParaName}label -anchor center -side left -pady 0
set mybut [entry ${curframe2}.${ParaName}entry -textvariable ::SimOptions($ParaLabel) -width 7 -bg white -relief sunken -border 1 -highlightcolor green]
pack $mybut -side left -anchor center -pady 0
pack [button ${curframe2}.hideButton -command "HideOptionEntry $curframe2 $ParaLabel" -text "Hide"] -side left -anchor center -pady 0
}
proc SimParaEntry {ParaName ParaLabel ParentFrame} {
frame ${ParentFrame}.${ParaName}
pack ${ParentFrame}.${ParaName} -anchor e
set curframe2 ${ParentFrame}.${ParaName}
label ${curframe2}.${ParaName}label -text "$ParaLabel="
pack ${curframe2}.${ParaName}label -anchor sw -side left
# set mybut [entry ${curframe2}.${ParaName}entry -textvariable ::$ParaLabel -width 7 -bg white -relief flat -border 5 -highlightcolor green]
set mybut [entry ${curframe2}.${ParaName}entry -textvariable ::$ParaLabel -width 7 -bg white -relief sunken -border 1 -highlightcolor green]
pack $mybut -side left -anchor n -side right -pady 2
}
proc SimParaEntry2 {ParaName ParentFrame} {
set ParseString "::"
set Nothing {}
set ParaLabel [regsub $ParseString $ParaName $Nothing]
set FrameName spe$ParaLabel
frame ${ParentFrame}.${FrameName}
pack ${ParentFrame}.${FrameName} -anchor e
set curframe2 ${ParentFrame}.${FrameName}
label ${curframe2}.${FrameName}label -text "$ParaLabel="
pack ${curframe2}.${FrameName}label -anchor sw -side left
# set mybut [entry ${curframe2}.${FrameName}entry -textvariable ::$ParaLabel -width 7 -bg white -relief flat -border 5 -highlightcolor green]
set mybut [entry ${curframe2}.${FrameName}entry -textvariable ::$ParaLabel -width 7 -bg white -relief sunken -border 1 -highlightcolor green]
pack $mybut -side left -anchor n -side right -pady 2
}
array set SimOptions {}
array set SimFlags {}
set SimOptionsList {}
set SimFlagsList {}
proc ReadSimConfigFile {} {
puts "Read SimConfigFile= $::SimConfigFile"
set fw [open $::SimConfigFile "r"]
while {[eof $fw] != 1} {
set CurLine [gets $fw]
if {[regexp "^\[\[:space:\]\]*\[\[:alpha:\]\]" $CurLine] == 1} {
# puts "Line $CurLine"
set ParseOption "^\[\[:space:\]\]*(\[\[:alnum:\]\]*)\[\[:space:\]\]{1,}:\[\[:space:\]\]{1,}(\[^\[:space:\]\]*)"
if {[regexp $ParseOption $CurLine Match Name Value] == 1} {
# puts "Option $Name = $Value"
set ::SimOptions($Name) $Value
} else {
set ParseFlag "^\[\[:space:\]\]*(\[\[:alpha:\]\]*)"
if {[regexp $ParseFlag $CurLine Match Name] == 1} {
if {[regexp "^No(.*)" $Name Match FlagName] ==1} {
set Value 0
} else {
set FlagName $Name
set Value 1
}
# puts "Flag $FlagName = $Value"
set ::SimFlags($FlagName) $Value
}
}
}
}
}
proc ShowOptionsWindow {OptionsWindowName} {
set ::VisibleSimOptions 1
toplevel $OptionsWindowName
wm protocol $OptionsWindowName WM_DELETE_WINDOW "HideWin $OptionsWindowName ::VisibleSimOptions"
set curframe ${::OptionsWindowName}
# ScrolledWindow ${curframe}.scrollwin
# set curframe2 ${curframe}
# pack $curframe2
# frame ${curframe}.lbframe
# pack ${curframe}.lbframe -side bottom
# set curframe1 ${curframe}.lbframe
# set LBname ${curframe1}.lb
# set SBname ${curframe1}.sb
# ScrollableFrame ${LBname} -areaheight 30
# scrollbar ${SBname} -command [list ${LBname} yview]
# ${LBname} configure -yscrollcommand [list ${SBname} set]
# pack ${SBname} ${LBname} -in ${curframe1} -side right -expand 1 -fill both
# set curframe2 $LBname
# Programmzeilen aus http://wiki.tcl.tk/9924
set sw [ScrolledWindow ${curframe}.sw]
pack $sw -fill both -expand 0
set sf [ScrollableFrame $sw.sf -areawidth 0 -height 600]
$sw setwidget $sf
set uf [$sf getframe]
set curframe2 $uf
if {[file exists ${::SimOptionsFile}] == 0} {
set initFile [open ${::SimOptionsFile} a+]
puts $initFile ""
puts $initFile ""
close $initFile
}
set size [file size ${::SimOptionsFile}]
set fd [open ${::SimOptionsFile}]
set xml [read $fd $size]
close $fd
set doc [dom parse -simple $xml]
set root [$doc documentElement]
puts "Read SimConfigFile= $::SimConfigFile"
set fw [open $::SimConfigFile "r"]
while {[eof $fw] != 1} {
set CurLine [gets $fw]
if {[regexp "^\[\[:space:\]\]*\[\[:alpha:\]\]" $CurLine] == 1} {
# puts "Line $CurLine"
set ParseOption "^\[\[:space:\]\]*(\[\[:alnum:\]_\]*)\[\[:space:\]\]{1,}:\[\[:space:\]\]{1,}(\[^\[:space:\]\]*)"
if {[regexp $ParseOption $CurLine Match Name Value] == 1} {
# puts "Option $Name = $Value"
set node [$root child 1 $Name]
if {$node == ""} {
$root appendFromList [list $Name {flag 1} {}]
set ::SimOptions($Name) $Value
SimOptionsEntry3 win$Name $Name $curframe2
} else {
if {[$node getAttribute flag] == 1} {
set ::SimOptions($Name) $Value
SimOptionsEntry3 win$Name $Name $curframe2
}
}
} else {
set ParseFlag "^\[\[:space:\]\]*(\[\[:alpha:\]\]*)"
if {[regexp $ParseFlag $CurLine Match Name] == 1} {
if {[regexp "^No(.*)" $Name Match FlagName] ==1} {
set Value 0
} else {
set FlagName $Name
set Value 1
}
# puts "Flag $FlagName = $Value"
set node [$root child 1 $FlagName]
if {$node == ""} {
$root appendFromList [list $FlagName {flag 1} {}]
set ::SimFlags($FlagName) $Value
SimFlagsEntry2 win$FlagName $FlagName $curframe2
} else {
if {[$node getAttribute flag] == 1} {
set ::SimFlags($FlagName) $Value
SimFlagsEntry2 win$FlagName $FlagName $curframe2
}
}
}
}
}
}
set fd [open ${::SimOptionsFile} w]
puts $fd [$root asXML]
close $fd
$doc delete
# scrollbar ${SBname} -command [list ${LBname} yview]
# ${LBname} configure -yscrollcommand [list ${SBname} set]
# pack ${SBname} ${LBname} -in ${curframe1} -side right -expand 1 -fill both
}
proc HideWin {WinName WinVisible} {
upvar $WinVisible VisibleState
wm withdraw $WinName
set VisibleState 0
}
proc ShowHideWin {WinName WinVisible} {
upvar $WinVisible VisibleState
if {$VisibleState == 0} {
wm withdraw $WinName
} else {
wm deiconify $WinName
}
}
proc OpenIDL {} {
set ::idl [open "|idl-console-start" "w"]
fconfigure $::idl -blocking 0 -buffering line -translation crlf -eofchar {}
puts "OpenIDL"
}
proc ResetIDL {} {
puts $::idl "retall"
puts $::idl "widget_control,/reset"
puts $::idl "close,/all"
puts $::idl "heap_gc,/verbose"
# close $::idl
# OpenIDL
}
proc RestartIDL {} {
close $::idl
OpenIDL
}
proc ShowSpikes {} {
set ShowOptions {}
# if {$::NType == 0} {
# append ShowOptions ",CutSpikes=$::CutSpikePot "
# }
if {$::ShowTestSpikes == 1} {
append ShowOptions ",/Test, TrialNr= $::TrialNr "
}
if {$::UseMinMaxTime == 1} {
append ShowOptions ",Time=\[$::MinTime, $::MaxTime\]"
}
# if {$::SimOptions(NeuronType) == 0} {
# append ShowOptions ",CutSpikes=$::CutSpikePot "
# }
if {$::SpikeOpt != {}} {
append ShowOptions ", $::SpikeOpt "
}
append ShowOptions ",ShowPotentials=$::ShowPotLayer "
set Command "gklearn_showsimspikes, dirname=\"$::SimDataDir\", /ShowSpikes, /sec $ShowOptions \n"
# set Command "csim_showsimspikes, dirname=\"$::SimDataDir\", /sec \n"
puts $Command
puts $::idl $Command
}
proc ShowMovie {} {
set ShowOptions {}
append ShowOptions ",Tau=\[$::MovieTau0, $::MovieTau1\]"
append ShowOptions ",Gain=\[$::MovieGain0, $::MovieGain1\]"
if {$::ShowTestSpikes == 1} {
append ShowOptions ",/Test, TrialNr= $::TrialNr "
}
set Command "gklearn_showsimspikes, dirname=\"$::SimDataDir\", /sec, /movie $ShowOptions \n"
# set Command "csim_showsimspikes, dirname=\"$::SimDataDir\", /sec \n"
puts $Command
puts $::idl $Command
}
proc ShowMovieF2 {} {
set ShowOptions {}
append ShowOptions ",Tau=\[$::MovieTau0, $::MovieTau1, $::MovieTau1\]"
append ShowOptions ",Gain=\[$::MovieGain0, $::MovieGain1, $::MovieGain1\]"
if {$::ShowTestSpikes == 1} {
append ShowOptions ",/Test, TrialNr= $::TrialNr "
}
append ShowOptions ", /XLinear"
set Command "gklearn_showsimspikes, dirname=\"$::SimDataDir\", /sec, /movie $ShowOptions \n"
# set Command "csim_showsimspikes, dirname=\"$::SimDataDir\", /sec \n"
puts $Command
puts $::idl $Command
}
proc ConnectionNames {} {
#ToDo: Check wether SimInfoFile exists or not!!
set ::ConnectionList {}
set SimInfoFile ${::SimDataDir}Sim.SimInfo
puts "InfoFilename $SimInfoFile"
set fw [open $SimInfoFile "r"]
while {[eof $fw] != 1} {
set CurLine [gets $fw]
set exp "