#
# A VERY!!! simple ANSI-like terminal emulator
# runs in a separate window, normally placed directly on top of the main
# transcript window
#
# Dave Clemans, June 1993
#

#
# Clear our terminal emulator "screen"
# (Set the text widget to all spaces)
#
proc tktEmulateClearScreen {w} {
   set wp [winfo toplevel $w]
   set geomx 0
   set geomy 0
   scan [wm geometry $wp] %dx%d geomx geomy
   incr geomx -1
   set line [replicate " " $geomx]
   append line "\n"
   $w delete 0.0 end
   loop i 0 $geomy 1 {
      $w insert end "$line"
   }
   $w mark set $w.ic 1.0
}

#
# Clear (set to spaces) from our current insert position to the end of line
#
proc tktEmulateClearEOL {w} {
   set pos [$w index $w.ic]
   set epos [$w index "$w.ic lineend"]
   set l 0
   set bc 0
   set ec 0
   scan $pos %d.%d l bc
   scan $epos %d.%d l ec
   set l [expr "$ec - $bc"]
   $w delete $pos $epos
   $w insert $pos [replicate " " $l]
   $w mark set $w.ic $pos
}

#
# Clear (set to spaces) from our current insert position to the end of display
#
proc tktEmulateClearEOS {w} {
   tktEmulateClearEOL $w
   set pos [$w index "$w.ic+1l linestart"]
   set nextl 0
   scan $pos %d nextl
   set wp [winfo toplevel $w]
   set geomx 0
   set geomy 0
   scan [wm geometry $wp] %dx%d geomx geomy
   incr geomx -1
   set line [replicate " " $geomx]
   append line "\n"
   $w delete $pos end
   loop i $nextl $geomy 1 {
      $w insert end "$line"
   }
}

#
# Get the next character from either our buffer or our input stream
#
proc tktEmulateGetChar {buffer index length fd} {
   upvar $buffer str
   upvar $index ctr
   upvar $length len
   incr ctr
   if {$ctr >= $len} {
      set str [readpending $fd]
      set len [string length "$str"]
      set ctr 0
   }
   set c [string index "$str" $ctr]
   return $c
}

#
# Handle output coming back from the slave process.
# It is assumed that the output contains interspersed escape sequences.
# For now, we emulate a VT100-like terminal
#
# Note: this routine, especially the initial portion where normal
# characters are detected and handled, is EXTREMELY PERFORMANCE CRITICAL!!!
#
proc tktEmulateTerminal {w chars fd} {
   global tktFindCtypeCmd
   set l [string length "$chars"]
   set c ""
   for {set i 0} {$i < $l} {incr i} {
      set ni $i
      if {$tktFindCtypeCmd == 0} {
         while {$ni < $l} {
            set c [string index "$chars" $ni]
            if {[ctype cntrl "$c"] != 0} {
               set ctrlpos $ni
               break
            }
            incr ni
         }
      } else {
         set pos [findctype cntrl [string range "$chars" $ni end]]
         if {$pos >= 0} {
            incr ni $pos
            set ctrlpos $ni
         } else {
            incr ni $l
         }
      }
      if {$ni != $i} {
         incr ni -1
         set nl [expr "$ni - $i + 1"]
         set epos [$w index "$w.ic lineend"]
         if {[$w compare $w.ic <= $epos]} {
            set nepos [$w index "$w.ic + $nl chars"]
            set nni $ni
            if {[$w compare $nepos > $epos]} {
               set lpos 0
               set cpos 0
               set ecpos 0
               scan $epos %d.%d lpos cpo
               scan $nepos %d.%d lpos ecpos
               set nni [expr "$ni - ($ecpos - $cpos)"]
            }
            $w delete $w.ic $nepos
            $w insert $w.ic [string range "$chars" $i $nni]
         }
         if {$nl > 160} {
            update idletasks
         }
         set i $ni
         continue
      }
      set c [string index "$chars" $i]
      if {"$c" == "\b"} {
         $w mark set $w.ic $w.ic-1c
         continue
      }
      if {"$c" == "\n"} {
         $w mark set $w.ic "$w.ic+1l linestart"
         continue
      }
      if {"$c" == "\r"} {
         $w mark set $w.ic "$w.ic linestart"
         continue;
      }
      if {"$c" == "\033"} {
         set c [tktEmulateGetChar chars i l $fd]
         if {"$c" == "\["} {
            set c [tktEmulateGetChar chars i l $fd]
            set var ""
            while {[ctype alpha "$c"] == 0} {
               append var "$c"
               set c [tktEmulateGetChar chars i l $fd]
            }
            if {"$c" == "A"} {
               $w mark set $w.ic $w.ic-1l
               continue
            }
            if {"$c" == "B"} {
               $w mark set $w.ic $w.ic+1l
               continue
            }
            if {"$c" == "C"} {
               $w mark set $w.ic $w.ic+1c
               continue
            }
            if {"$c" == "D"} {
               $w mark set $w.ic $w.ic-1c
               continue
            }
            if {"$c" == "H"} {
               if {"$var" == "" || "$var" == "\;"} {
                  $w mark set $w.ic 1.0
               } else {
                  set pos [split "$var" "\;"]
                  set row [lindex "$pos" 0]
                  set col [lindex "$pos" 1]
                  incr col -1
                  $w mark set $w.ic $row.$col
               }
               continue
            }
            if {"$c" == "J"} {
               tktEmulateClearEOS $w
               continue
            }
            if {"$c" == "K"} {
               tktEmulateClearEOL $w
               continue
            }
         }
         continue
      }
      if {"$c" == "\036"} {
         set wc 0
         scan $w .tktTerm%d wc
         set pw ".tkt$wc.text"
         removeinput $fd
         addinput $fd "tktShellToWindow $pw %F"
         destroy [winfo toplevel $w]
         set w $pw
         focus $pw
         continue
      }
      if {"$c" == "\0377"} {
         continue
      }
   }
   $w mark set insert $w.ic
   if {$tktFindCtypeCmd != 0} {
      update idletasks
   }
}

#
# Handle output coming back from the slave process to an emulated terminal
#
proc tktShellToEmulator {w fd} {
   set chars ""
   set chars [readpending $fd]
   if {"$chars" == ""} {
      destroy [winfo toplevel $w]
      removeinput $fd
      return
   }
   if {[eof $fd]} {
      destroy [winfo toplevel $w]
      removeinput $fd
      return
   }
   tktEmulateTerminal $w "$chars" $fd
}

#
# Catch a keypress and send it down the given channel to the slave process
#
proc tktKeyToEmulator {fd char} {
   catch {puts -nonewline $fd "$char"}
}

#
# Start a new terminal emulator session
#
proc tktEmulatorSession {w chars fd} {
   global tktMiscWinNumber
   set ctr 0
   scan $w .tkt%d ctr
   set name .tktTerm${ctr}_$tktMiscWinNumber
   incr tktMiscWinNumber

   set wp [winfo toplevel $w]

   #
   # first create a toplevel text widget window
   # it has a scroll bar, but that is only expected to be used if
   # the user resizes the window to something smaller than its actual size
   #
   toplevel $name -class Text
   text $name.text -relief raised -bd 2 -yscrollcommand "$name.scroll set" \
      -setgrid true -wrap none
   scrollbar $name.scroll -relief flat -command "$name.text yview"
   $name.text mark set $name.text.ic 0.0
   bind $name <Any-Enter> "focus $name.text"
   wm protocol $name WM_DELETE_WINDOW "destroy $name;return"
   bind $name.text <Any-KeyPress> "tktKeyToEmulator $fd \"%A\""
   tktMouseBindings $name.text $fd

   #
   # give the window a menubar
   #
   frame $name.menu -relief raised -borderwidth 1
   tktBuildMenuBar $name.text $name.menu $fd

   #
   # layout the pieces of the window
   #
   pack append $name $name.menu {top fillx}
   pack append $name $name.scroll {right filly} $name.text {expand fill}
   wm geometry $name [wm geometry $wp]
   wm group $name $wp
   
   #
   # Display the window so the user thinks we are doing something
   # But give the window a title before we actually display it
   #
   set ptitle [wm title $wp]
   set pindex [string first " @ " "$ptitle"]
   set title "ansiterm"
   wm iconname $name "$title"
   append title [string range "$ptitle" $pindex end]
   wm title $name "$title"
   tktEmulateClearScreen $name.text
   if {"$chars" != ""} {
      tktEmulateTerminal $name.text "$chars" $fd
   } else {
      update idletasks
   }

   focus $name.text
   return $name.text
}
