Tk GUI Not Responding - tcl

Can someone help me on this situation? I am trying to make a GUI that is used for colors demo of all RGB matrix in the canvas. Unfortornately, the GUI is not responding and it doesn't change colors as expected until the loop is finished. Is there anything wrong? I often encounter this problem if I configure a widget in a loop.
package require Tk
package require math
proc changeColor {rM gM bM} {
for {set r 0} {$r<=$rM} {incr r} {
for {set g 0} {$g<=$gM} {incr g} {
for {set b 0} {$b<=$bM} {incr b} {
set rHex [format %02X $r]
set gHex [format %02X $g]
set bHex [format %02X $b]
set mark #
set color [append mark $rHex $gHex $bHex]
.cv config -bg $color
.lb config -text "[format %03d $r] [format %03d $g] [format %03d $b]"
after 500
}
}
}
}
canvas .cv
ttk::label .lb
ttk::button .bt -text Run -command {changeColor 255 255 255}
grid .cv -row 0 -column 0 -sticky news
grid .lb -row 1 -column 0 -sticky we
grid .bt -row 2 -column 0
Code_Snapshot
GUI_Snapshot

Tk (and Tcl) processes no events at all during a synchronous after 500. It just stops the process for that 500 ms.
You need to instead process events for that time. Replace the after 500 with:
after 500 {set go_on yes}
vwait go_on
Be aware that the go_on there is global, and that this can cause problems with code-reentrancy. You'll want to disable the button that runs the procedure while your code is running.
Or you can use Tcl 8.6 and convert everything to be a coroutine. Then you'll be able to do an asynchronous sleep without danger of filling the stack:
proc changeColor {rM gM bM} {
for {set r 0} {$r<=$rM} {incr r} {
for {set g 0} {$g<=$gM} {incr g} {
for {set b 0} {$b<=$bM} {incr b} {
set rHex [format %02X $r]
set gHex [format %02X $g]
set bHex [format %02X $b]
set mark #
set color [append mark $rHex $gHex $bHex]
.cv config -bg $color
.lb config -text "[format %03d $r] [format %03d $g] [format %03d $b]"
####### Notice these two lines... ########
after 500 [info coroutine]
yield
}
}
}
}
##### Also this one needs to be altered #####
ttk::button .bt -text Run -command {coroutine dochange changeColor 255 255 255}
# Nothing else needs to be altered

Related

"Invalid command name "W"' while runing tcl script

I was making some GUI at TCL in ModelSim, but when i run that it causes some STRANGE error
# invalid command name "W"
# while executing
# "$w nearest $y"
# (procedure "ListSelectEnd" line 2)
It was kinda odd, because almost similar expression was just before that one. That's the code:
global a
proc ScrolledListbox { parent args } {
frame $parent
eval {listbox $parent.list \
-yscrollcommand [list $parent.sy set] \
-xscrollcommand [list $parent.sx set]} $args
scrollbar $parent.sx -orient horizontal \
-command [list $parent.list xview]
scrollbar $parent.sy -orient vertical \
-command [list $parent.list yview]
pack $parent.sx -side bottom -fill x
pack $parent.sy -side right -fill y
pack $parent.list -side left -fill both -expand true
return $parent.list
}
#-------------------------------------------
proc ListSelect { parent choices } {
global a
frame $parent
ScrolledListbox $parent.choices -width 20 -height 5 \
-setgrid true
ScrolledListbox $parent.picked -width 20 -height 5 \
-setgrid true
pack $parent.choices $parent.picked -side left \
-expand true -fill both
bind $parent.choices.list <ButtonPress-1> \
{ListSelectStart %W %y}
bind $parent.choices.list <ButtonRelease-1> \
lappend a [ListSelectEnd %W %y .top.f.picked.list]
eval {$parent.choices.list insert 0} $choices
}
#----------------------------------------
proc ListSelectStart { w y } {
$w select anchor [$w nearest $y]
}
#-----------------------------------------
proc ListSelectEnd { w y list } {
$w select set anchor [$w nearest $y]
foreach i [$w curselection] {
$list insert end [$w get $i]
lappend listin [$w get $i]
}
return $listin
}
#--------------------------------------------
proc tosignal {parent val} {
global a
for {set i 0} {$i<[llength $a]} {incr i} {
force -freeze sim:/chema_tb/m1/[lindex $a $i] $val 0
}
run 1000 ns
destroy $parent
return 1
}
#------------------------------------------------
proc form {} {
global a
toplevel .top
set filename signalfile.txt
set in [open $filename]
while {[gets $in var]>-1} {
lappend spisn [lindex $var 0]
}
ListSelect .top.f $spisn
button .top.okb -text OK -width 20 -height 2 -font {-size 15 -family Times -weight bold} \
-fg blue -anchor center -command {tosignal .top 0 }
pack .top.f .top.okb -expand true
}
I'll be really thankful if you could help me. :)
The problem is with these lines:
bind $parent.choices.list <ButtonRelease-1> \
lappend a [ListSelectEnd %W %y .top.f.picked.list]
That performs immediate execution of what appears to be a callback, and passes very unlikely arguments to bind too. I bet what you want is either this:
bind $parent.choices.list <ButtonRelease-1> \
{ListSelectEnd %W %y .top.f.picked.list}
or this:
bind $parent.choices.list <ButtonRelease-1> {
ListSelectEnd %W %y .top.f.picked.list
}
or this:
bind $parent.choices.list <ButtonRelease-1> \
[list ListSelectEnd %W %y .top.f.picked.list]
In this case, it doesn't matter which you use. (The first two are equivalent except for whitespace. The third one is much more useful when you're binding variables in the script, but you're not doing that in this case.)

tk notebook frame is not resizing properly, when widgets are added

I am using ttk:notebook for creating frames.
Attaching children's to these slaves, but it didn't resize properly, when listbox widget gets created.
I am using following code:
ttk::notebook .top.d -width 880 -height 600 -padding 5
ttk::frame .top.d.f1;
ttk::frame .top.d.f2;
.top.d add .top.d.f2 -text "Memory Characterization" -padding 5
.top.d add .top.d.f1 -text "Standard cells Characterization" -padding 5
When more widgets are added they hide, until i have to manually resize it.
As Jerry said, what did you expect, when giving a width and height?
Maybe your confusion comes from the width resizing when adding notebook tabs, but this is by intention, because otherwise you cannot see all configured tabs. Unfortunately there is no standard code for scrolling tab headers.
The following code shows the effect:
#!/usr/bin/env wish
set conf(width) 200
set conf(height) 100
ttk::button .b1 -command addNewPage -text "Add"
ttk::button .b2 -command toggleSize -text "Toggle Size"
ttk::notebook .d -width 200 -height 100 -padding 5
grid .b1 .b2
grid .d - -sticky eswn
grid columnconfigure . all -weight 1
grid rowconfigure . 2 -weight 1
set numpages 0
set pages [dict create \
.d.f1 "Memory Characterization" \
.d.f2 "Standard cells Characterization" \
.d.f3 "Just another long title" \
.d.f4 "Hope this is long enough"]
proc addNewPage {} {
variable pages
variable numpages
if {$numpages < [dict size $pages]} {
set w [lindex [dict keys $pages] ${numpages}]
ttk::frame $w
set title [dict get $pages $w]
.d add $w -text $title -padding 5
addChildren $w
incr numpages
if {$numpages >= [dict size $pages]} {
.b configure -state disabled
}
}
}
proc addChildren {w} {
for {set i 1} {$i < 9} {incr i} {
for {set j 1} {$j < 9} {incr j} {
grid [ttk::button $w.b$i$j -text "Button $i:$j"] -row $i -column $j -padx 5 -pady 5
}
}
}
proc toggleSize {} {
variable conf
if {[.d cget -width] == $conf(width)} {
set width 0
set height 0
} else {
set width $conf(width)
set height $conf(height)
}
.d configure -width $width -height $height
}
I would recommend to use relative placement of child widgets w.r.t your notebook by using
Place geometry manager

TCL login program doesn't work

I am making a login program in TCL. I have the following code:
package require Tk
set usr [open "$env(HOME)\\AppData\\Roaming\\basicfile\\USR.txt" r]
set pwd [open "$env(HOME)\\AppData\\Roaming\\basicfile\\PWD.txt" r]
set numtries [expr 3.0]
proc log {} {
if {$::numtries > 0.0} {
if {[.e get] == [read $::usr]} {
if {[.e1 get] == [read $::pwd]} {
close $::usr
close $::pwd
pack forget .l
pack forget .e
pack forget .l1
pack forget .e1
pack forget .b
.l configure -text "Login Successful!"
pack .l
} else {
set ::numtries [expr $::numtries - 1.0]
if {$::numtries <= 0.0} {
.b configure -state disabled
}
}
} else {
set ::numtries [expr $::numtries - 1.0]
if {$::numtries <= 0.0} {
.b configure -state disabled
}
}
} else {
.b configure -state disabled
}
if {$::numtries <= 0.0} {
.b configure -state disabled
}
}
ttk::label .l -text "Enter your name:"
ttk::entry .e
ttk::label .l1 -text "Enter your password:"
ttk::entry .e1 -show "*"
ttk::button .b -text "Login" -command log
pack .l
pack .e
pack .l1
pack .e1
pack .b
This program opens a folder, basicfile, located in the AppData folder of Windows. When it runs, the application works fine, except for one thing. The line that seems to be erroneous is set numtries [expr 3.0]. The program is made so that if the username and password are incorrect it subtracts from this variable, and if the variable reaches 0, the button is disabled. However, when I run the program and press the button three times with an incorrect username and password in the input boxes, it goes to the line .l configure -text "Login Successful!" and bypasses the login part. My question is, why does it disregard the login code and still go in? I should also mention the fact that if I change the line set numtries [expr 3.0] to set numtries [expr 2.0], the program works fine. Thanks!
The problem could possibly be this. The read command reads the whole file at once, so the next time you read from the files you get empty strings. If your name and password fields are empty, they will be equal to the empty strings read from your files, and the login will be successful.
Something like this ought to work:
set dir $env(HOME)/AppData/Roaming/basicfile
set uf [open [file join $dir USR.txt]]
set pf [open [file join $dir PWD.txt]]
set usr [read -nonewline $uf]
set pwd [read -nonewline $pf]
close $uf
close $pf
set numtries 3
ttk::label .nl -text "Enter your name:"
ttk::entry .ne
ttk::label .pl -text "Enter your password:"
ttk::entry .pe -show "*"
ttk::button .b -text "Login" -command log
pack {*}[winfo children .]
proc log {} {
global numtries usr pwd
if {[incr numtries -1] > 0} {
if {([.ne get] eq $usr) && ([.pe get] eq $pwd)} {
destroy {*}[winfo children .]
ttk::label .l -text "Login successful"
pack .l
} else {
.ne delete 0 end
.pe delete 0 end
}
} else {
destroy {*}[winfo children .]
ttk::label .l -text "Too many tries"
pack .l
}
}
If you have an older, obsolete version of Tcl, pack {*}[winfo children .] and the eq operator won't work: try eval pack [winfo children .] (likewise with destroy) and == instead. Or better yet, upgrade.
Documentation: close, destroy, file, global, if, incr, open, pack, proc, read, set, ttk::button, ttk::entry, ttk::label, winfo
Your program seems to be incomplete. Anyway, try this (update the path of usr.txt and pwd.txt):
package require Tk
set usr [open "usr.txt" r]
set pwd [open "pwd.txt" r]
set numtries 3
proc log {} {
puts "Attempt # $::numtries"
if {$::numtries <= 0} {
close $::usr
close $::pwd
.l configure -text "Max retries exceeded..."
.b configure -state disabled
pack forget .e
pack forget .e1
return
}
if {([.e get] != [gets $::usr]) || \
([.e1 get] != [gets $::pwd])} {
incr ::numtries -1
return
}
.l configure -text "Login Successful!"
pack forget .e
pack forget .e1
pack forget .b
close $::usr
close $::pwd
}
ttk::label .l -text "Enter your name:"
pack .l
ttk::entry .e
ttk::entry .e1
pack .e
pack .e1
button .b -text submit -command log
.b configure -state active
pack .b

writing to a file using puts and calling proc in puts

I am having a problem in the following code I was trying to write:
set temp [open "check.txt" w+]
puts $temp "hello"
proc print_message {a b} {
puts "$a"
puts "$b"
return 1
}
print_message 3 4
puts "[print_message 5 7]"
puts $temp "[print_message 5 7]"
print_message 8 9
in the puts "[print_message 5 7]" , 5 and 7 are printed on the screen and 1 is printed in the file check.txt. what should i do to print 5 and 7 in the text file and not on the screen.
You can rewrite your proc as follows,
proc print_message {a b { handle stdout } } {
# Using default args in proc. If nothing is passed, then
# 'handle' will have the value of 'stdout'.
puts $handle "$a"
puts $handle "$b"
return 1
}
If any args passed, then it will write into that file handle. Else, it will be on the stdout which is the terminal.
puts "[print_message 5 7 $temp]" ; # This will write into the file
puts "[print_message 5 7]"; # This will write into the stdout
I would write it like puts itself, with the optional channel as the first argument:
proc print_message {args} {
switch [llength $args] {
3 {lassign $args chan a b}
2 {set chan stdout; lassign $args a b}
default {error "wrong # args: should be \"print_message ?channelId? a b\""}
}
puts $chan $a
puts $chan $b
}
print_message 3 4
print_message 5 7
print_message $temp 5 7
print_message 8 9
I'm assuming that you don't actually want to see "1" on stdout.
It's very hard to pin down what you want to do here.
If you want the same printout both on the screen and in the file, you could do it like this:
proc print_message {a b} {
puts $a
puts $b
format %s\n%s\n $a $b
}
puts -nonewline $temp [print_message 5 7]
If you just want to format two values onto one line each, you could do it like this:
proc print_message {a b} {
format %s\n%s\n $a $b
}
puts -nonewline [print_message 5 7] ;# to screen
puts -nonewline $temp [print_message 5 7] ;# to file
Documentation: format, proc, puts

button -command in for loop (no such variable)

I've got this small loop cycle in TCL
for {set i 1} {$i <= $user} {incr i} {
grid [ttk::button .seluser.$i -text "$i" -command { set ::user $i }] -column $i -row 1
}
and I'm getting the message
ERROR can't read "i": no such variable
I think it's because -command works like a new proc and that's why it can not identify the variable i.
I don't know how to do it. Can anybody help me?
Try quotes instead of braces, so that $i is pre-interpolated. For example,
for {set i 1} {$i <= $user} {incr i} {
grid [ttk::button .seluser.$i -text "$i" -command " set ::user $i "] -column $i -row 1
}