PerlTk - Newbie question

Author

Newbie question

Herman

2004-08-06, 3:57 pm

Hi everyone, I have to create a TCL/TK UI for a project at university,
and it consists of a small window with input data for several
variables, all of which are to be written to a file. However, I have
to add another toplevel window that collects two variables, and
appends them to the same file, and I would have to open this window
repeatedly, in a for loop that depends on a number entered in the main
toplevel window. The reason for this is that I have to collect a set
of data repeatedly, the number of times is dependent on a number
entered in the prior window.

Any ideas for a script (or a better way) for doing this? I am using
Visual TCL to make all these windows, and my current code is appended
to this message.

Also, if anyone here is familiar with interfacing TCL code to the
"SciLab" application, or can point me to a good resource, please let
me know!

Thanks!

-------------------------------------------------------------------------------
#!/bin/sh
# the next line restarts using wish\
exec wish "$0" "$@"

if {![info exists vTcl(sourcing)]} {

package require Tk
switch $tcl_platform(platform) {
windows {
option add *Button.padY 0
}
default {
option add *Scrollbar.width 10
option add *Scrollbar.highlightThickness 0
option add *Scrollbar.elementBorderWidth 2
option add *Scrollbar.borderWidth 2
}
}

}

########################################
#####################################
# Visual Tcl v1.60 Project
#

#################################
# VTCL LIBRARY PROCEDURES
#

if {![info exists vTcl(sourcing)]} {
########################################
#####################################
## Library Procedure: Window

proc ::Window {args} {
## This procedure may be used free of restrictions.
## Exception added by Christian Gavin on 08/08/02.
## Other packages and widget toolkits have different licensing
requirements.
## Please read their license agreements for details.

global vTcl
foreach {cmd name newname} [lrange $args 0 2] {}
set rest [lrange $args 3 end]
if {$name == "" || $cmd == ""} { return }
if {$newname == ""} { set newname $name }
if {$name == "."} { wm withdraw $name; return }
set exists [winfo exists $newname]
switch $cmd {
show {
if {$exists} {
wm deiconify $newname
} elseif {[info procs vTclWindow$name] != ""} {
eval "vTclWindow$name $newname $rest"
}
if {[winfo exists $newname] && [wm state $newname] ==
"normal"} {
vTcl:FireEvent $newname <<Show>>
}
}
hide {
if {$exists} {
wm withdraw $newname
vTcl:FireEvent $newname <<Hide>>
return}
}
iconify { if $exists {wm iconify $newname; return} }
destroy { if $exists {destroy $newname; return} }
}
}
########################################
#####################################
## Library Procedure: vTcl:DefineAlias

proc ::vTcl:DefineAlias {target alias widgetProc top_or_alias
cmdalias} {
## This procedure may be used free of restrictions.
## Exception added by Christian Gavin on 08/08/02.
## Other packages and widget toolkits have different licensing
requirements.
## Please read their license agreements for details.

global widget
set widget($alias) $target
set widget(rev,$target) $alias
if {$cmdalias} {
interp alias {} $alias {} $widgetProc $target
}
if {$top_or_alias != ""} {
set widget($top_or_alias,$alias) $target
if {$cmdalias} {
interp alias {} $top_or_alias.$alias {} $widgetProc
$target
}
}
}
########################################
#####################################
## Library Procedure: vTcl:DoCmdOption

proc ::vTcl:DoCmdOption {target cmd} {
## This procedure may be used free of restrictions.
## Exception added by Christian Gavin on 08/08/02.
## Other packages and widget toolkits have different licensing
requirements.
## Please read their license agreements for details.

## menus are considered toplevel windows
set parent $target
while {[winfo class $parent] == "Menu"} {
set parent [winfo parent $parent]
}

regsub -all {\%widget} $cmd $target cmd
regsub -all {\%top} $cmd [winfo toplevel $parent] cmd

uplevel #0 [list eval $cmd]
}
########################################
#####################################
## Library Procedure: vTcl:FireEvent

proc ::vTcl:FireEvent {target event {params {}}} {
## This procedure may be used free of restrictions.
## Exception added by Christian Gavin on 08/08/02.
## Other packages and widget toolkits have different licensing
requirements.
## Please read their license agreements for details.

## The window may have disappeared
if {![winfo exists $target]} return
## Process each binding tag, looking for the event
foreach bindtag [bindtags $target] {
set tag_events [bind $bindtag]
set stop_processing 0
foreach tag_event $tag_events {
if {$tag_event == $event} {
set bind_code [bind $bindtag $tag_event]
foreach rep "\{%W $target\} $params" {
regsub -all [lindex $rep 0] $bind_code [lindex
$rep 1] bind_code
}
set result [catch {uplevel #0 $bind_code} errortext]
if {$result == 3} {
## break exception, stop processing
set stop_processing 1
} elseif {$result != 0} {
bgerror $errortext
}
break
}
}
if {$stop_processing} {break}
}
}
########################################
#####################################
## Library Procedure: vTcl:Toplevel:WidgetProc

proc ::vTcl:Toplevel:WidgetProc {w args} {
## This procedure may be used free of restrictions.
## Exception added by Christian Gavin on 08/08/02.
## Other packages and widget toolkits have different licensing
requirements.
## Please read their license agreements for details.

if {[llength $args] == 0} {
## If no arguments, returns the path the alias points to
return $w
}
set command [lindex $args 0]
set args [lrange $args 1 end]
switch -- [string tolower $command] {
"setvar" {
foreach {varname value} $args {}
if {$value == ""} {
return [set ::${w}::${varname}]
} else {
return [set ::${w}::${varname} $value]
}
}
"hide" - "show" {
Window [string tolower $command] $w
}
"showmodal" {
## modal dialog ends when window is destroyed
Window show $w; raise $w
grab $w; tkwait window $w; grab release $w
}
"startmodal" {
## ends when endmodal called
Window show $w; raise $w
set ::${w}::_modal 1
grab $w; tkwait variable ::${w}::_modal; grab release $w
}
"endmodal" {
## ends modal dialog started with startmodal, argument is
var name
set ::${w}::_modal 0
Window hide $w
}
default {
uplevel $w $command $args
}
}
}
########################################
#####################################
## Library Procedure: vTcl:WidgetProc

proc ::vTcl:WidgetProc {w args} {
## This procedure may be used free of restrictions.
## Exception added by Christian Gavin on 08/08/02.
## Other packages and widget toolkits have different licensing
requirements.
## Please read their license agreements for details.

if {[llength $args] == 0} {
## If no arguments, returns the path the alias points to
return $w
}

set command [lindex $args 0]
set args [lrange $args 1 end]
uplevel $w $command $args
}
########################################
#####################################
## Library Procedure: vTcl:toplevel

proc ::vTcl:toplevel {args} {
## This procedure may be used free of restrictions.
## Exception added by Christian Gavin on 08/08/02.
## Other packages and widget toolkits have different licensing
requirements.
## Please read their license agreements for details.

uplevel #0 eval toplevel $args
set target [lindex $args 0]
namespace eval ::$target {set _modal 0}
}
}

if {[info exists vTcl(sourcing)]} {

proc vTcl:project:info {} {
set base .top47
namespace eval ::widgets::$base {
set set,origin 1
set set,size 1
set runvisible 1
}
namespace eval ::widgets::$base.mes48 {
array set save {-text 1 -width 1}
}
namespace eval ::widgets::$base.rad49 {
array set save {-text 1 -value 1 -variable 1}
}
namespace eval ::widgets::$base.rad50 {
array set save {-text 1 -value 1 -variable 1}
}
namespace eval ::widgets::$base.rad51 {
array set save {-text 1 -value 1 -variable 1}
}
namespace eval ::widgets::$base.mes52 {
array set save {-text 1 -width 1}
}
namespace eval ::widgets::$base.rad55 {
array set save {-text 1 -value 1 -variable 1}
}
namespace eval ::widgets::$base.rad56 {
array set save {-text 1 -value 1 -variable 1}
}
namespace eval ::widgets::$base.rad57 {
array set save {-text 1 -value 1 -variable 1}
}
namespace eval ::widgets::$base.rad58 {
array set save {-text 1 -value 1 -variable 1}
}
namespace eval ::widgets::$base.mes59 {
array set save {-text 1 -width 1}
}
namespace eval ::widgets::$base.ent60 {
array set save {-background 1 -textvariable 1}
}
namespace eval ::widgets::$base.mes61 {
array set save {-text 1 -width 1}
}
namespace eval ::widgets::$base.ent62 {
array set save {-background 1 -textvariable 1}
}
namespace eval ::widgets::$base.mes63 {
array set save {-text 1 -width 1}
}
namespace eval ::widgets::$base.ent64 {
array set save {-background 1 -textvariable 1}
}
namespace eval ::widgets::$base.mes65 {
array set save {-text 1 -width 1}
}
namespace eval ::widgets::$base.mes66 {
array set save {-text 1 -width 1}
}
namespace eval ::widgets::$base.ent67 {
array set save {-background 1 -textvariable 1}
}
namespace eval ::widgets::$base.ent68 {
array set save {-background 1 -textvariable 1}
}
namespace eval ::widgets::$base.mes69 {
array set save {-text 1 -width 1}
}
namespace eval ::widgets::$base.ent70 {
array set save {-background 1 -textvariable 1}
}
namespace eval ::widgets::$base.mes71 {
array set save {-text 1 -width 1}
}
namespace eval ::widgets::$base.ent72 {
array set save {-background 1 -textvariable 1}
}
namespace eval ::widgets::$base.mes73 {
array set save {-text 1 -width 1}
}
namespace eval ::widgets::$base.ent74 {
array set save {-background 1 -textvariable 1}
}
namespace eval ::widgets::$base.but75 {
array set save {-command 1 -pady 1 -text 1}
}
namespace eval ::widgets_bindings {
set tagslist _TopLevel
}
namespace eval ::vTcl::modules::main {
set procs {
init
main
writefile
}
set compounds {
}
set projectType single
}
}
}

#################################
# USER DEFINED PROCEDURES
#
########################################
#####################################
## Procedure: main

proc ::main {argc argv} {}
########################################
#####################################
## Procedure: writefile

proc ::writefile {} {
global widget
set cachee [Toplevel1 setvar selectedButton]
set sortie [Toplevel1 setvar selectedButton2]
set nue [Toplevel1 setvar ent60]
set nuc [Toplevel1 setvar ent62]
set nus [Toplevel1 setvar ent64]
set max [Toplevel1 setvar ent67]
set gain [Toplevel1 setvar ent68]
set moment [Toplevel1 setvar ent70]
set appren [Toplevel1 setvar ent72]
set test [Toplevel1 setvar ent74]
set handle [open "config" w]
puts $handle "$cachee $sortie"
puts $handle "$nue $nuc $nus"
puts $handle "$max"
puts $handle "$gain $moment"
puts $handle "$appren $test"
puts $handle "n"
close $handle
}

########################################
#####################################
## Initialization Procedure: init

proc ::init {argc argv} {}

init $argc $argv

#################################
# VTCL GENERATED GUI PROCEDURES
#

proc vTclWindow. {base} {
if {$base == ""} {
set base .
}
###################
# CREATING WIDGETS
###################
wm focusmodel $top passive
wm geometry $top 200x200+132+174; update
wm maxsize $top 1404 1028
wm minsize $top 115 1
wm overrideredirect $top 0
wm resizable $top 1 1
wm withdraw $top
wm title $top "vtcl"
bindtags $top "$top Vtcl all"
vTcl:FireEvent $top <<Create>>
wm protocol $top WM_DELETE_WINDOW "vTcl:FireEvent $top
<<DeleteWindow>>"

###################
# SETTING GEOMETRY
###################

vTcl:FireEvent $base <<Ready>>
}

proc vTclWindow.top47 {base} {
if {$base == ""} {
set base .top47
}
if {[winfo exists $base]} {
wm deiconify $base; return
}
set top $base
###################
# CREATING WIDGETS
###################
vTcl:toplevel $top -class Toplevel
wm focusmodel $top passive
wm geometry $top 609x422+425+369; update
wm maxsize $top 1404 1028
wm minsize $top 115 1
wm overrideredirect $top 0
wm resizable $top 1 1
wm deiconify $top
wm title $top "Interface Reseau Neuron"
vTcl:DefineAlias "$top" "Toplevel1" vTcl:Toplevel:WidgetProc "" 1
bindtags $top "$top Toplevel all _TopLevel"
vTcl:FireEvent $top <<Create>>
wm protocol $top WM_DELETE_WINDOW "vTcl:FireEvent $top
<<DeleteWindow>>"

message $top.mes48 \
-text {Activation cche cachee} -width 117
vTcl:DefineAlias "$top.mes48" "Message1" vTcl:WidgetProc
"Toplevel1" 1
radiobutton $top.rad49 \
-text Sigmoide -value S -variable "$top\::selectedButton"
vTcl:DefineAlias "$top.rad49" "Radiobutton1" vTcl:WidgetProc
"Toplevel1" 1
radiobutton $top.rad50 \
-text {Tangente Hyperbolique} -value T \
-variable "$top\::selectedButton"
vTcl:DefineAlias "$top.rad50" "Radiobutton2" vTcl:WidgetProc
"Toplevel1" 1
radiobutton $top.rad51 \
-text Gaussienne -value G -variable "$top\::selectedButton"
vTcl:DefineAlias "$top.rad51" "Radiobutton3" vTcl:WidgetProc
"Toplevel1" 1
message $top.mes52 \
-text {Activation cche sortie} -width 106
vTcl:DefineAlias "$top.mes52" "Message2" vTcl:WidgetProc
"Toplevel1" 1
radiobutton $top.rad55 \
-text Sigmoide -value S -variable "$top\::selectedButton2"
vTcl:DefineAlias "$top.rad55" "Radiobutton6" vTcl:WidgetProc
"Toplevel1" 1
radiobutton $top.rad56 \
-text {Tangente Hyperbolique} -value T \
-variable "$top\::selectedButton2"
vTcl:DefineAlias "$top.rad56" "Radiobutton7" vTcl:WidgetProc
"Toplevel1" 1
radiobutton $top.rad57 \
-text Gaussienne -value G -variable "$top\::selectedButton2"
vTcl:DefineAlias "$top.rad57" "Radiobutton8" vTcl:WidgetProc
"Toplevel1" 1
radiobutton $top.rad58 \
-text Identite -value I -variable "$top\::selectedButton2"
vTcl:DefineAlias "$top.rad58" "Radiobutton9" vTcl:WidgetProc
"Toplevel1" 1
message $top.mes59 \
-text {Numero de entrees} -width 91
vTcl:DefineAlias "$top.mes59" "Message3" vTcl:WidgetProc
"Toplevel1" 1
entry $top.ent60 \
-background white -textvariable "$top\::ent60"
vTcl:DefineAlias "$top.ent60" "Entry1" vTcl:WidgetProc "Toplevel1"
1
message $top.mes61 \
-text {Numero de neurons cachees} -width 141
vTcl:DefineAlias "$top.mes61" "Message4" vTcl:WidgetProc
"Toplevel1" 1
entry $top.ent62 \
-background white -textvariable "$top\::ent62"
vTcl:DefineAlias "$top.ent62" "Entry2" vTcl:WidgetProc "Toplevel1"
1
message $top.mes63 \
-text {Numero de neurons sorties} -width 126
vTcl:DefineAlias "$top.mes63" "Message5" vTcl:WidgetProc
"Toplevel1" 1
entry $top.ent64 \
-background white -textvariable "$top\::ent64"
vTcl:DefineAlias "$top.ent64" "Entry3" vTcl:WidgetProc "Toplevel1"
1
message $top.mes65 \
-text {Numero max de passages} -width 74
vTcl:DefineAlias "$top.mes65" "Message6" vTcl:WidgetProc
"Toplevel1" 1
message $top.mes66 \
-text {gain (Epsilon)} -width 66
vTcl:DefineAlias "$top.mes66" "Message7" vTcl:WidgetProc
"Toplevel1" 1
entry $top.ent67 \
-background white -textvariable "$top\::ent67"
vTcl:DefineAlias "$top.ent67" "Entry4" vTcl:WidgetProc "Toplevel1"
1
entry $top.ent68 \
-background white -textvariable "$top\::ent68"
vTcl:DefineAlias "$top.ent68" "Entry5" vTcl:WidgetProc "Toplevel1"
1
message $top.mes69 \
-text {moment (Alpha)} -width 76
vTcl:DefineAlias "$top.mes69" "Message8" vTcl:WidgetProc
"Toplevel1" 1
entry $top.ent70 \
-background white -textvariable "$top\::ent70"
vTcl:DefineAlias "$top.ent70" "Entry6" vTcl:WidgetProc "Toplevel1"
1
message $top.mes71 \
-text {Nom de fichier de apprentissage} -width 156
vTcl:DefineAlias "$top.mes71" "Message9" vTcl:WidgetProc
"Toplevel1" 1
entry $top.ent72 \
-background white -textvariable "$top\::ent72"
vTcl:DefineAlias "$top.ent72" "Entry7" vTcl:WidgetProc "Toplevel1"
1
message $top.mes73 \
-text {Nom de fichier de test} -width 106
vTcl:DefineAlias "$top.mes73" "Message10" vTcl:WidgetProc
"Toplevel1" 1
entry $top.ent74 \
-background white -textvariable "$top\::ent74"
vTcl:DefineAlias "$top.ent74" "Entry8" vTcl:WidgetProc "Toplevel1"
1
button $top.but75 \
-command writefile -pady 0 -text {Save Config File}
vTcl:DefineAlias "$top.but75" "Button1" vTcl:WidgetProc
"Toplevel1" 1
###################
# SETTING GEOMETRY
###################
place $top.mes48 \
-x 15 -y 20 -width 117 -height 24 -anchor nw -bordermode
ignore
place $top.rad49 \
-x 160 -y 20 -anchor nw -bordermode ignore
place $top.rad50 \
-x 260 -y 20 -anchor nw -bordermode ignore
place $top.rad51 \
-x 435 -y 20 -anchor nw -bordermode ignore
place $top.mes52 \
-x 15 -y 55 -width 106 -height 19 -anchor nw -bordermode
ignore
place $top.rad55 \
-x 160 -y 55 -anchor nw -bordermode ignore
place $top.rad56 \
-x 260 -y 55 -anchor nw -bordermode ignore
place $top.rad57 \
-x 415 -y 55 -anchor nw -bordermode ignore
place $top.rad58 \
-x 510 -y 55 -anchor nw -bordermode ignore
place $top.mes59 \
-x 15 -y 90 -width 91 -height 21 -anchor nw -bordermode ignore
place $top.ent60 \
-x 120 -y 90 -width 41 -height 19 -anchor nw -bordermode
ignore
place $top.mes61 \
-x 170 -y 90 -width 141 -height 21 -anchor nw -bordermode
ignore
place $top.ent62 \
-x 325 -y 90 -width 41 -height 19 -anchor nw -bordermode
ignore
place $top.mes63 \
-x 385 -y 90 -width 126 -height 22 -anchor nw -bordermode
ignore
place $top.ent64 \
-x 530 -y 90 -width 41 -height 19 -anchor nw -bordermode
ignore
place $top.mes65 \
-x 15 -y 125 -width 74 -height 34 -anchor nw -bordermode
ignore
place $top.mes66 \
-x 170 -y 135 -width 66 -height 21 -anchor nw -bordermode
ignore
place $top.ent67 \
-x 120 -y 135 -width 41 -height 19 -anchor nw -bordermode
ignore
place $top.ent68 \
-x 325 -y 135 -width 41 -height 19 -anchor nw -bordermode
ignore
place $top.mes69 \
-x 385 -y 135 -width 76 -height 21 -anchor nw -bordermode
ignore
place $top.ent70 \
-x 530 -y 135 -width 41 -height 19 -anchor nw -bordermode
ignore
place $top.mes71 \
-x 15 -y 175 -width 156 -height 21 -anchor nw -bordermode
ignore
place $top.ent72 \
-x 205 -y 175 -width 366 -height 19 -anchor nw -bordermode
ignore
place $top.mes73 \
-x 15 -y 205 -width 106 -height 21 -anchor nw -bordermode
ignore
place $top.ent74 \
-x 205 -y 210 -width 366 -height 19 -anchor nw -bordermode
ignore
place $top.but75 \
-x 255 -y 355 -width 114 -height 36 -anchor nw -bordermode
ignore

vTcl:FireEvent $base <<Ready>>
}

########################################
#####################################
## Binding tag: _TopLevel

bind "_TopLevel" <<Create>> {
if {![info exists _topcount]} {set _topcount 0}; incr _topcount
}
bind "_TopLevel" <<DeleteWindow>> {
if {[set ::%W::_modal]} {
vTcl:Toplevel:WidgetProc %W endmodal
} else {
destroy %W; if {$_topcount == 0} {exit}
}
}
bind "_TopLevel" <Destroy> {
if {[winfo toplevel %W] == "%W"} {incr _topcount -1}
}

Window show .
Window show .top47

main $argc $argv

Reinhard Pagitsch

2004-08-09, 9:03 am

Hello Herman,

Herman wrote:

> Hi everyone, I have to create a TCL/TK UI for a project at university,
> and it consists of a small window with input data for several
> variables, all of which are to be written to a file. However, I have
> to add another toplevel window that collects two variables, and
> appends them to the same file, and I would have to open this window
> repeatedly, in a for loop that depends on a number entered in the main
> toplevel window. The reason for this is that I have to collect a set
> of data repeatedly, the number of times is dependent on a number
> entered in the prior window.
>
> Any ideas for a script (or a better way) for doing this? I am using
> Visual TCL to make all these windows, and my current code is appended
> to this message.
>
> Also, if anyone here is familiar with interfacing TCL code to the
> "SciLab" application, or can point me to a good resource, please let
> me know!
>

I am not expirenced with TCL/Tk and never used Visual TCL,
but some suggestions:
+ Use a global counter which will be incremented each time the window
will be called.
+ Use a callback for the window which increments the counter and call
the window if the counter less than the number entered.
If you use the call of the window in this call back than you are sure it
will only be called if you klick the OK button in the window. It is like
rekursive, I think.
Or you can let the window stay open until the counter reaches the number
entered in the target window. And every klick on a button collects the
variables (callback) and increment the counter.

mit freundlichen Grüßen,
with my best regards,
Reinhard

--
QA
ISIS Information Systems
Austria tel: (+43) 2236 27551 150 Fax: 2236 21081
Visit our web site http://www.isis-papyrus.com

Sponsored Links