Richard Suchenwirth -- 2000-08-15 Here's a terribly old-fashioned "terminal emulator" looking like UIs of twenty years ago - monochrome 24x80, fixed pitch, markup by reverse video, underlining, or maybe blinking. Still it might be helpful in porting heritage software where screen layout was controlled by row/col coordinates.
Interface (procedures):
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.