scripts/hexterm

   1 #!/usr/bin/tclsh8.4
   2 set comment {
   3 #
   4 Use of the screen:
   5 0         1         2         3         4         5         6         7
   6 xxxE hh hh hh hh  hh hh hh hh  hh hh hh hh  hh hh hh hh_| abcd e_.. .... ...._|
   7 }
   8 # Display:
   9 #       | is a vertical delimiter
  10 #       E is either | to mean echo is on or ' to mean it is off
  11 #       hh are hex digits of output:
  12 #               00-ff   actual hex data (bold for stuff we entered)
  13 #               0-f     under cursor: one digit entered, need the next
  14 #       abcde_.... are ASCII output:
  15 #               .       things we can't print including SPC and _
  16 #       in both, we may see
  17 #                       space we haven't yet filled
  18 #               _       cursor when in other tab
  19 #       xxx     number of bytes read/written so far
  20 # Keystrokes:
  21 #       TAB     switch between hex and literal mode
  22 #       ^C, ^D  quit
  23 #       ^Z      suspend
  24 # Keystrokes in hex mode only:
  25 #       RET     move to a new line; if already at start of line,
  26 #                set count to 0
  27 #       DEL     clear any entered hex digit
  28 #       SPC     send 00
  29 #       '       toggle echo
  30 # nyi:
  31 #       G-Z     record last bytes we transmitted and store in memory
  32 #                if we were halfway through a hex byte, first digit
  33 #                is length of string to record
  34 #       g-z     play back memory
  35
  36
  37 # Copyright 2005 Ian Jackson <ian@chiark.greenend.org.uk>
  38 #
  39 # This script and its documentation (if any) are free software; you
  40 # can redistribute it and/or modify them under the terms of the GNU
  41 # General Public License as published by the Free Software Foundation;
  42 # either version 3, or (at your option) any later version.
  43 #
  44 # chiark-named-conf and its manpage are distributed in the hope that
  45 # it will be useful, but WITHOUT ANY WARRANTY; without even the
  46 # implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
  47 # PURPOSE.  See the GNU General Public License for more details.
  48 #
  49 # You should have received a copy of the GNU General Public License along
  50 # with this program; if not, consult the Free Software Foundation's
  51 # website at www.fsf.org, or the GNU Project website at www.gnu.org.
  52
  53
  54 if {[llength $argv] != 1} { error "need serial port arg" }
  55
  56 set port [lindex $argv 0]
  57
  58 set count 0
  59 set lit 0 ;# 1 means literal (ASCII) entry mode
  60 set echo 1
  61
  62 proc p {s} {
  63     puts -nonewline $s
  64 }
  65
  66 proc tput {args} {
  67     global tput
  68     if {[catch { set s $tput($args) }]} {
  69         set s [eval exec tput $args]
  70         set tput($args) $s
  71     }
  72     p $s
  73 }
  74
  75 proc csr_pos {lit bytenum} {
  76     set x [expr {
  77         (!$lit ? (3*$bytenum) : 53+$bytenum)
  78         + ($bytenum>>2) - (2-$lit)*($bytenum==16)
  79         + 5
  80     }]
  81     tput hpa $x
  82 }
  83
  84 proc csr_this {} { global lit x; csr_pos $lit $x }
  85 proc csr_other {} { global lit x; csr_pos [expr {!$lit}] $x }
  86 proc csrs_erase {} { csr_this; p " "; csr_other; p " " }
  87 proc csr_this_show {} {
  88     global h1
  89     csr_this; if {[info exists h1]} { p $h1; p "\b" }
  90 }
  91 proc csrs_show {} {
  92     csr_other; p _
  93     csr_this_show
  94 }
  95
  96 proc echop {} {
  97     global echo
  98     return [expr {$echo ? "|" : "'"}]
  99 }
 100
 101 proc newline {} {
 102     global x echo count
 103     if {[info exists x]} { csrs_erase; p "\r\n" }
 104     set x 0
 105     p [format "%3x%s%*s|%*s|" $count [echop] 52 "" 21 ""]
 106     csrs_show
 107 }
 108
 109 proc p_ch_spaces {} {
 110     global x lit
 111     if {$x==15} return
 112     if {$lit} { p " " }
 113     if {($x & 3) != 3} return
 114     p " "
 115 }
 116
 117 proc p_rmso {smso} {
 118     if {[string length $smso]} { tput sgr0 }
 119 }
 120
 121 proc ch {d smso} {
 122     global lit x count
 123     if {$x == 16} newline
 124     if {[string length $smso]} { tput $smso }
 125     set h [format %02x [expr {$d & 0xff}]]
 126     set c [format %c [expr {($d > 33 && $d < 127 && $d != 95) ? $d : 46}]]
 127     if {$lit} {
 128         p $c; csr_other; p $h
 129         p_ch_spaces
 130         p_rmso $smso
 131         p _
 132     } else {
 133         p $h; csr_other; p $c
 134         p_ch_spaces
 135         p_rmso $smso
 136         p _
 137     }
 138     incr x
 139     set count [expr {($count+1) & 0xfff}]
 140     csr_this_show
 141 }
 142
 143 proc onreadp {} {
 144     global p
 145     while 1 {
 146         set c [read $p 1]
 147         binary scan $c c* d
 148         if {![llength $d]} {
 149             if {[eof $p]} { error "eof on device" }
 150             return
 151         }
 152         ch $d {}
 153     }
 154 }
 155
 156 proc transmit {d} {
 157     global p echo
 158     puts -nonewline $p [format %c $d]
 159     if {$echo} { ch $d bold }
 160 }
 161
 162 proc k_echo {} {
 163     global echo
 164     set echo [expr {!$echo}]
 165     tput hpa 3
 166     p [echop]
 167     csr_this
 168 }
 169
 170 proc k_newline {} {
 171     global count x
 172     if {$x} {
 173         newline
 174     } else {
 175         set count 0
 176         p "\r"
 177         p [format %3x $count]
 178         csr_this
 179     }
 180 }
 181
 182 proc k_switch {} {
 183     global lit h1
 184     csrs_erase
 185     catch { unset h1 }
 186     set lit [expr {!$lit}]
 187     csrs_show
 188 }
 189
 190 proc k_stop {} {
 191     restore
 192     exit 0
 193 }
 194
 195 proc k_suspend {} {
 196     restore
 197     exec kill -TSTP [info pid]
 198     setup
 199 }
 200
 201 proc k_noparthex {} {
 202     global h1
 203     csrs_erase
 204     catch { unset h1 }
 205     csrs_show
 206 }
 207
 208 proc k_hexdigit {c} {
 209     global h1 echo
 210     if {![info exists h1]} { set h1 $c; p $c; p "\b"; return }
 211     set d [expr 0x${h1}${c}]
 212     unset h1
 213     transmit $d
 214     if {!$echo} { p " \b" }
 215 }
 216
 217 proc onreadk {} {
 218     global lit
 219     while 1 {
 220         set c [read stdin 1]
 221         binary scan $c c* d
 222         if {![llength $d]} {
 223             if {[eof stdin]} { error "eof on stdin" }
 224             return
 225         }
 226         switch -exact $d {
 227             9 { k_switch; continue }
 228             3 - 4 { k_stop; continue }
 229             26 { k_suspend; continue }
 230         }
 231         if {$lit} { transmit $d; continue }
 232         switch -exact $d {
 233             13 { k_newline; continue }
 234             32 { transmit 0; continue }
 235             39 { k_echo; continue }
 236             127 { k_noparthex; continue }
 237         }
 238         if {$d >= 48 && $d <= 57} { k_hexdigit $c; continue }
 239         set kl [expr {$d | 32}]
 240         if {$d >= 97 && $d <= 102} { k_hexdigit $c; continue }
 241         p "\a"
 242     }
 243 }
 244
 245 proc try {script} {
 246     if {[catch { uplevel 1 $script } emsg]} {
 247         catch { puts stderr "(warning: $emsg)" }
 248     }
 249 }
 250
 251 proc tryv {variable script} {
 252     upvar #0 $variable var
 253     if {![info exists var]} return
 254     uplevel 1 "
 255         global $variable
 256         $script
 257     "
 258     unset var
 259 }
 260
 261 proc restore {} {
 262     tryv x { puts "\r\n" }
 263     try { fconfigure stdin -blocking true }
 264     try { fconfigure stdout -blocking true }
 265     tryv term_stty { exec stty $term_stty }
 266     tryv p { close $p }
 267 }
 268
 269 proc setup {} {
 270     global term_stty port p
 271
 272     set term_stty [exec stty -g]
 273
 274     set p [open $port {RDWR NONBLOCK} 0]
 275
 276     exec stty          min 1 time 0 -istrip -ocrnl -onlcr -onocr -opost \
 277                        -ctlecho -echo -echoe -echok -echonl -iexten -isig \
 278                        -icanon -icrnl
 279     exec stty -F $port min 1 time 0 -istrip -ocrnl -onlcr -onocr -opost \
 280                        -ctlecho -echo -echoe -echok -echonl -iexten -isig \
 281                        -icanon -icrnl \
 282             9600 clocal cread -crtscts -hup -parenb cs8 -cstopb \
 283             -ixoff bs0 cr0 ff0 nl0 -ofill -olcuc
 284
 285     fconfigure $p -blocking false -buffering none -encoding binary \
 286             -translation binary
 287
 288     fconfigure stdin -blocking false -buffering none -translation binary
 289     fconfigure stdout -blocking false -buffering none -translation binary
 290
 291     newline
 292
 293     fileevent stdin readable onreadk
 294     fileevent $p readable onreadp
 295 }
 296
 297 proc bgerror {m} {
 298     try {
 299         restore
 300         global errorInfo errorCode
 301         puts stderr "$m\n$errorCode\n$errorInfo"
 302     }
 303     exit 127
 304 }
 305
 306 if {[catch setup emsg]} {
 307     restore
 308     error $emsg $errorInfo $errorCode
 309 }
 310
 311 vwait quit