Retrocomputing

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.

WikiDbImage retro.jpg

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.