terminal -- create such a beefed-up (down?) text widget terminal:clear -- clear "screen" printat -- at row-col, print text, tags tprint -- print text, tags (continue at last position) tputs -- print text, tags, newline (scroll if needed)As the task is so traditional, I didn't bother to wrap it in an OO interface. Usage examples are at the end. Enjoy ;-)
proc terminal {w args} {
array set opt [concat {
-foreground green -background black -font Fixedsys -height 24 -width 80
} $args]
eval text $w [array get opt] -wrap none -cursor {{}}
$w tag configure reverse -foreground [$w cget -background]\
-background [$w cget -foreground]
$w tag configure underlined -underline 1
$w tag configure [text:blink $w blink]
terminal:clear $w
set w
}
proc terminal:clear w {
$w config -state normal
$w delete 1.0 end
for {set i 0} {$i<[$w cget -height]} {incr i} {
if {$i} {$w insert end \n}
$w insert end [format %[$w cget -width]s ""]
}
$w mark set twain 1.0
$w config -state disabled
}
proc text:blink {w tag {t 250}} {
$w tag configure $tag ;# just to have it at first time
set bfg [$w tag cget $tag -foreground]
set fg [$w cget -foreground]
if {$bfg == $fg} {
$w tag configure $tag -foreground [$w cget -background]
} else {
$w tag configure $tag -foreground $fg
}
after $t [list text:blink $w $tag $t]
update
set tag
}
proc printat {w pos text {tags {}}} {
set t [split $pos ,]
$w mark set twain [lindex $t 0].[expr [lindex $t 1]-1]
if [string length $text] {tprint $w $text $tags}
}
proc tprint {w text {tags {}}} { $w $text $tags}
set l [string length $text]
$w config -state normal
$w delete twain twain+${l}c
$w insert twain $text $tags
$w config -state disabled
}
proc tputs {w text {tags {}}} {
tprint $w $text $tags
if {[set row [expr int([$w index twain])]]<[$w cget -height]} {
$w mark set twain [expr $row+1].0
} else {
$w config -state normal
$w delete 1.0 1.end+1c
$w delete $row.0 $row.end
$w insert $row.0 [format \n%[$w cget -width]s ""]
$w config -state disabled
$w mark set twain $row.0
}
}
############################ usage examples, little tests
pack [terminal .t]
tprint .t "Hello!"
printat .t 2,1 "Boldly I say: " bold
tprint .t "blinking " {blink bold}
tprint .t "has to be underlined" underlined
tprint .t " in this reverse world" reverse
printat .t 4,3 "This should be @4,3"
printat .t 24,1 "BOTTOM LINE " reverse
printat .t 24,78 <E>
printat .t 1,2 a ;# overwriting a single letter, turn Hello to Hallo
printat .t 5,5 "Welcome"
printat .t 7,5 "to the"
tprint .t " MACHINE " {reverse underlined}
tputs .t ""
tputs .t **********************************
tputs .t ""
update
#after 5000
for {set i 0} {$i<30} {incr i} {
tputs .t $i:[clock format [clock seconds]]
update
after 100
}
tprint .t "More soon -- stay with us --" {blink reverse}
printat .t 1,1 "----------- scrolled, but still overwriting -----"
after 10000 {
terminal:clear .t
tputs .t "A new page in history" {underlined blink}
printat .t 3,1 "(intentionally left blank)"
printat .t 24,1 "BOTTOM LINE " reverse
printat .t 24,78 <E>
.t tag configure red -foreground red
printat .t 5,1 "And yes, this is not monochrome!" red
}For matching software, have a look at Basic in Tcl...GPS: I like what you have done a lot. I would be interested to see what kind of amazing things you could do to improve Expect's tkterm example. --- ZLM : That is sweet. And it's also the first Pink Floyd album that really sucks.
