chiark / gitweb /
hexbin-term seems to work ish
authorian <ian>
Fri, 9 Dec 2005 22:51:45 +0000 (22:51 +0000)
committerian <ian>
Fri, 9 Dec 2005 22:51:45 +0000 (22:51 +0000)
scripts/hexterm

index 249da3d..5189848 100755 (executable)
 #!/usr/bin/tclsh8.4
+set comment {
+#
+Use of the screen:
+0         1         2         3         4         5         6         7
+xxx| hh hh hh hh  hh hh hh hh  hh hh hh hh  hh hh hh hh_| abcd e_.. .... ...._|
+}
+# Display:
+#      | is a vertical delimiter
+#      hh are hex digits of output:
+#              00-ff   actual hex data (bold for stuff we entered)
+#              0-f     under cursor: one digit entered, need the next
+#      abcde_.... are ASCII output:
+#              .       things we can't print including SPC and _
+#      in both, we may see
+#                      space we haven't yet filled
+#              _       cursor when in other tab
+#       xxx     number of bytes read/written so far
+# Keystrokes:
+#      TAB     switch between hex and literal mode
+#      ^C, ^D  quit
+#      ^Z      suspend
+# Keystrokes in hex mode only:
+#      RET     move to a new line; if already at start of line,
+#                set count to 0
+#      DEL     clear any entered hex digit
+#      SPC     send 00
+# nyi:
+#      G-Z     record last bytes we transmitted and store in memory
+#               if we were halfway through a hex byte, first digit
+#               is length of string to record
+#      g-z     play back memory
 
 if {[llength $argv] != 1} { error "need serial port arg" }
 
 set port [lindex $argv 0]
 
-set port_stty [exec stty -F $port -g]
-set term_stty [exec stty -g]
+set count 0
+set lit 0 ;# 1 means literal (ASCII) entry mode
+
+proc p {s} {
+    puts -nonewline $s
+}
+
+proc tput {args} {
+    global tput
+    if {[catch { set s $tput($args) }]} {
+       set s [eval exec tput $args]
+       set tput($args) $s
+    }
+    p $s
+}
+
+proc csr_pos {lit bytenum} {
+    set x [expr {
+       (!$lit ? (3*$bytenum) : 53+$bytenum)
+       + ($bytenum>>2) - (2-$lit)*($bytenum==16)
+       + 5
+    }]
+    tput hpa $x
+}
+
+proc csr_this {} { global lit x; csr_pos $lit $x }
+proc csr_other {} { global lit x; csr_pos [expr {!$lit}] $x }
+proc csrs_erase {} { csr_this; p " "; csr_other; p " " }
+proc csr_this_show {} {
+    global h1
+    csr_this; if {[info exists h1]} { p $h1; p "\b" }
+}
+proc csrs_show {} {
+    csr_other; p _
+    csr_this_show
+}
+
+proc newline {} {
+    global x count
+    if {[info exists x]} { csrs_erase; p "\r\n" }
+    set x 0
+    p [format "%3x|%*s|%*s|" $count 52 "" 21 ""]
+    csrs_show
+}
+
+proc p_ch_spaces {} {
+    global x lit
+    if {$x==15} return
+    if {$lit} { p " " }
+    if {($x & 3) != 3} return
+    p " "
+}
+
+proc p_rmso {smso} {
+    if {[string length $smso]} { tput sgr0 }
+}
+
+proc ch {d smso} {
+    global lit x count
+    if {$x == 16} newline
+    if {[string length $smso]} { tput $smso }
+    set h [format %02x [expr {$d & 0xff}]]
+    set c [format %c [expr {($d > 33 && $d < 127 && $d != 95) ? $d : 46}]]
+    if {$lit} {
+       p $c; csr_other; p $h
+       p_ch_spaces
+       p_rmso $smso
+       p _
+    } else {
+       p $h; csr_other; p $c
+       p_ch_spaces
+       p_rmso $smso
+       p _
+    }
+    incr x
+    set count [expr {($count+1) & 0xfff}]
+    csr_this_show
+}
 
 proc onreadp {} {
     global p
     while 1 {
        set c [read $p 1]
-       
+       binary scan $c c* d
+       if {![llength $d]} {
+           if {[eof $p]} { error "eof on device" }
+           return
+       }
+       ch $d {}
+    }
+}
+
+proc transmit {d} {
+    global p
+    puts -nonewline $p [format %c $d]
+    ch $d bold
+}
+
+proc k_newline {} {
+    global count x
+    if {$x} {
+       newline
+    } else {
+       set count 0
+       p "\r"
+       p [format %3x $count]
+       csr_this
+    }
+}
+
+proc k_switch {} {
+    global lit h1
+    csrs_erase
+    catch { unset h1 }
+    set lit [expr {!$lit}]
+    csrs_show
+}
+
+proc k_stop {} {
+    restore
+    exit 0
+}
+
+proc k_suspend {} {
+    restore
+    exec kill -TSTP [info pid]
+    setup
+}
+
+proc k_noparthex {} {
+    global h1
+    csrs_erase
+    catch { unset h1 }
+    csrs_show
+}
+
+proc k_hexdigit {c} {
+    global h1
+    if {![info exists h1]} { set h1 $c; p $c; p "\b"; return }
+    set d [expr 0x${h1}${c}]
+    unset h1
+    transmit $d
 }
 
 proc onreadk {} {
+    global lit
+    while 1 {
+       set c [read stdin 1]
+       binary scan $c c* d
+       if {![llength $d]} {
+           if {[eof stdin]} { error "eof on stdin" }
+           return
+       }
+       switch -exact $d {
+           9 { k_switch; continue }
+           3 - 4 { k_stop; continue }
+           26 { k_suspend; continue }
+       }
+       if {$lit} { transmit $d; continue }
+       switch -exact $d {
+           13 { k_newline; continue }
+           127 { k_noparthex; continue }
+           32 { transmit 0; continue }
+       }
+       if {$d >= 48 && $d <= 57} { k_hexdigit $c; continue }
+       set kl [expr {$d | 32}]
+       if {$d >= 97 && $d <= 102} { k_hexdigit $c; continue }
+       p "\a"
+    }
+}
+
+proc try {script} {
+    if {[catch { uplevel 1 $script } emsg]} {
+       catch { puts stderr "(warning: $emsg)" }
+    }
 }
 
-set e [catch {
-    exec stty          min 0 time 0 -istrip -ocrnl -onlcr -onocr -opost \
-                      -ctlecho -echo -echoe -echok -echonl -iexten -isig
-    exec stty -F $port min 0 time 0 -istrip -ocrnl -onlcr -onocr -opost \
+proc tryv {variable script} {
+    upvar #0 $variable var
+    if {![info exists var]} return
+    uplevel 1 "
+        global $variable
+        $script
+    "
+    unset var
+}
+
+proc restore {} {
+    tryv x { puts "\r\n" }
+    try { fconfigure stdin -blocking true }
+    try { fconfigure stdout -blocking true }
+    tryv term_stty { exec stty $term_stty }
+    tryv p { close $p }
+}
+
+proc setup {} {
+    global term_stty port p
+
+    set term_stty [exec stty -g]
+
+    set p [open $port {RDWR NONBLOCK} 0]
+    
+    exec stty          min 1 time 0 -istrip -ocrnl -onlcr -onocr -opost \
                       -ctlecho -echo -echoe -echok -echonl -iexten -isig \
+                      -icanon -icrnl
+    exec stty -F $port min 1 time 0 -istrip -ocrnl -onlcr -onocr -opost \
+                      -ctlecho -echo -echoe -echok -echonl -iexten -isig \
+                      -icanon -icrnl \
            9600 clocal cread -crtscts -hup -parenb cs8 -cstopb \
-           -ixoff bs0 cr0 ff0 nl0 -ofill -olcuc -onlcr
-    set p [open $port {RDWR|NONBLOCK} 0]
-    fconfigure $p -blocking false -buffering none
-    fconfigure stdin -blocking false -buffering none
+           -ixoff bs0 cr0 ff0 nl0 -ofill -olcuc
+
+    fconfigure $p -blocking false -buffering none -encoding binary \
+           -translation binary
+
+    fconfigure stdin -blocking false -buffering none -translation binary
+    fconfigure stdout -blocking false -buffering none -translation binary
+
+    newline
 
     fileevent stdin readable onreadk
     fileevent $p readable onreadp
-}]
+}
+
+proc bgerror {m} {
+    try {
+       restore
+       global errorInfo errorCode
+       puts stderr "$m\n$errorCode\n$errorInfo"
+    }
+    exit 127
+}
+
+if {[catch setup emsg]} {
+    restore
+    error $emsg $errorInfo $errorCode
+}
 
-fconfigure stdin -blocking true
-exec stty $term_stty
-exec stty -F $port $port_stty
+vwait quit