From 55aa48a0137694efcf11ed66070690589596d2aa Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Fri, 21 Sep 2018 22:01:34 +0200 Subject: add shell --- forth/ff-shell.tcl | 345 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 345 insertions(+) create mode 100755 forth/ff-shell.tcl (limited to 'forth') diff --git a/forth/ff-shell.tcl b/forth/ff-shell.tcl new file mode 100755 index 0000000..4fd1ae3 --- /dev/null +++ b/forth/ff-shell.tcl @@ -0,0 +1,345 @@ +#!/usr/bin/env wish +# ff-shell.tcl +# The Manual +# ---------- +# This simple shell is built around the Tcl/Tk text widget. +# Using a custom binding, key presses sent to the widget +# are redirected to the serial port and the FlashForth micro +# attached to that port. Incoming characters from the micro +# are received from the serial port and are inserted into the +# widget at the end of the text. An update to the GUI is +# triggered at the end of every line. +# +# A file is sent to the serial port, one line at a time. +# To allow the GUI to update smoothly in this single-threaded +# program, the lines to send are accumulated into a list and a +# procedure to send the first line is scheduled. +# For each line to be sent, the procedure checks if it is +# still waiting for a carriage-return from the microcontroller. +# If it is, the work of sending the line is rescheduled for +# a later time. If it is not waiting, the line is sent +# one character at a time. Incoming characters are inserted +# at the end of the text widget as they arrive. +# +# Copy-and-Paste insertions to the text widget are intercepted +# by the <> binding and handled in a similar manner +# as sending lines from a file. +# +# At any point in time, the text from the widget may be saved +# to a file. This might be good a way to save a session or +# collect large amounts of output from the microcontroller. +# +# You will need to run with sufficient privilege to access +# the serial port. +# On Ubuntu, this can be done by starting the program like so: +# $ sudo ./ff-shell.tcl +# +# Author +# ------ +# P.A.Jacobs +# School of Engineering, Uni of Qld. +# +# Version +# ------- +# 2015-04-03 +# Initial code cobbled together from a few examples, especially +# Rolf Schroedter's simple terminal at http://wiki.tcl.tk/3642 +# and Mikael Nordman's ff-shell.py. +# 2015-04-25, 26 +# Added status line and selection of speed, etc, from the GUI. +# +# Licence +# ------- +# GPL, as per the rest of FlashForth. +# +# -------------------------------------------------------------- +# Configuration +# Set defaults that suit your environment. + +set ::baudRate 9600; # 38400 +set ::parity "n"; # n=none e=even o=odd m=mark s=space +set ::dataBits 8; # 7 8 +set ::stopBits 1; # 1 2 +set ::parityAndBits "$::parity,$::dataBits,$::stopBits" +set ::handShake xonxoff; # none xonxoff rtscts +if { [string equal $::tcl_platform(platform) windows] } { + console show + set ::serialPortName {\\.\com5} +} else { + set ::serialPortName "/dev/ttyACM0" +}; # end if +set ::portState closed + +set ::textWidth 80 +set ::textHeight 24 +set ::textFont Courier + +set ::afterLineMilliseconds 20 + +# -------------------------------------------------------------- +# Sending and receiving characters, one at a time. + +set ::waitingForCR false + +proc serialIn { channel } { + if { [chan eof $channel] } { + puts "Oops serial channel read: eof" + closeSerialPort + return + } + if { [catch {chan read $channel 1} character] } { + puts "Oops serial channel read: $character" + return + } + if { [string length $character] == 0 } { + return + } + switch -regexp -- $character { + \x07 { bell } + \x08 { deleteLastChar } + \x09 { addToLogText $character } + \x0a { } + \x0d { addToLogText "\n"; set ::waitingForCR false; showLogTail; update } + \x11 { puts -nonewline Xon } + \x13 { puts -nonewline Xoff } + [\x20-\x7e] { addToLogText $character } + }; # end switch +}; # end serialIn + +proc serialOut { channel character } { + # puts -nonewline $channel $character; flush $channel + # send CR and BS through but not LF + switch -regexp -- $character { + \x0a {} + \x08 - + \x09 - + \x0d - + \x0f - + [\x20-\x7e] { puts -nonewline $channel $character; flush $channel } + }; # end switch +}; # end serialOut + +proc openSerialPort {} { + if { [catch {open $::serialPortName r+} result] } { + puts "openSerialPort: $result" + set ::portState closed + } else { + set ::tty $result + puts "Serial channel is open as $::tty" + # We allow a short timeout period to prevent the read function + # from stalling for too long. + chan configure $::tty -mode $::baudRate,$::parityAndBits -timeout 10 \ + -encoding binary -translation binary -handshake $::handShake \ + -buffering none -buffersize 8192 -blocking false + if { [string equal $::tcl_platform(platform) windows] } { + chan configure $::tty -sysbuffer 8192 + } + chan event $::tty readable [list serialIn $::tty] + set ::portState open + } +}; # end openSerialPort + +proc closeSerialPort {} { + if { [catch {close $::tty} err] } { + puts "Close serial port failed: $err" + } + set ::portState closed +}; # end closeSerialPort + +# -------------------------------------------------------------- +# GUI elements +wm title . "FlashForth Shell" +# Main menu allow us a convenient way to exit. +menu .mb +. configure -menu .mb +menu .mb.file -tearoff 0 +.mb.file add command -label "Send..." -command { sendFile } +.mb.file add command -label "Exit" -command { displayExitDialog } +.mb add cascade -label File -menu .mb.file +menu .mb.log -tearoff 0 +.mb.log add command -label "Clear" -command { clearLogText } +.mb.log add command -label "Save..." -command { saveLogText } +.mb add cascade -label Log -menu .mb.log +menu .mb.micro -tearoff 0 +.mb.micro add command -label "Warm restart" -command { warmRestart } +.mb add cascade -label Micro -menu .mb.micro +menu .mb.help -tearoff 0 +.mb.help add command -label "About..." -command { displayAboutMessage } +.mb.help add command -label "Hints" -command { displayHints } +.mb add cascade -label Help -menu .mb.help + +proc displayExitDialog {} { + if [tk_messageBox -type yesno -icon question -message "Really exit?"] { + closeSerialPort + exit + } +} + +proc displayAboutMessage {} { + tk_messageBox -type ok -icon info -parent . \ + -message "ff-shell in Tcl\nA simple shell for FlashForth.\n2015-05-01" +} + +proc displayHints {} { + set message { + "\n----------------------------------------------------------" + "\nType directly into the text window. Characters will go to" + "\nthe microcontroller, one at a time. Incoming characters" + "\nfrom the microcontroller will appear in the text window." + "\n" + "\nSending a file: For every line of the file, characters go" + "\none at a time to the microcontroller, but the shell will" + "\nwait for a carriage-return from the microcontroller before" + "\nsending the next line." + "\n" + "\nPasting a selection of text works in a similar way to" + "\nsending a file. You should be able to paste large sections" + "\nof text without overruns." + "\n" + "\nKeyboard short-cuts:" + "\nControl-Shift-v send selection to micro" + "\nControl-Shift-s save log" + "\nControl-Shift-x exit" + "\nControl-Shift-o warm restart of micro" + "\n----------------------------------------------------------" + "\n" + } + foreach line $message { addToLogText $line } +} + +# A scrolling text window to log messages +set textFrame [ttk::frame .tf] +set ::logText [text .tf.t -height $::textHeight -width $::textWidth \ + -font $::textFont -wrap char \ + -yscrollcommand [list $textFrame.vsb set] ] +set textScrollBar [ttk::scrollbar .tf.vsb -orient vertical \ + -command {$::logText yview} ] +pack $::logText -side left -expand 1 -fill both +pack $textScrollBar -side left -fill y +pack $textFrame -fill both -expand 1 + +# A status line +set statusFrame [ttk::labelframe .sf -text "Serial Port"] +set lab1 [ttk::label .sf.lab1 -text "Device:"] +set deviceEntry [ttk::entry .sf.entr1 -width 15 -textvariable ::serialPortName] +pack $lab1 $deviceEntry -side left +set lab2 [ttk::label .sf.lab2 -text "Speed:"] +set speedEntry [ttk::entry .sf.entr2 -width 8 -textvariable ::baudRate] +pack $lab2 $speedEntry -side left +set lab3 [ttk::label .sf.lab3 -text "ParityAndBits:"] +set entr3 [ttk::entry .sf.entr3 -width 6 -textvariable ::parityAndBits -state readonly] +pack $lab3 $entr3 -side left +set lab4 [ttk::label .sf.lab4 -text "Hand Shake:"] +set entr4 [ttk::entry .sf.entr4 -width 7 -textvariable ::handShake -state readonly] +pack $lab4 $entr4 -side left +set lab5 [ttk::label .sf.lab5 -text "State:"] +set entr5 [ttk::entry .sf.entr5 -width 6 -textvariable ::portState -state readonly] +pack $lab5 $entr5 -side left +pack $statusFrame -fill x -expand 0 + +bind $deviceEntry { closeSerialPort; openSerialPort } +bind $speedEntry { closeSerialPort; openSerialPort } + +proc addToLogText { txt } { + $::logText insert end "$txt" +} + +proc showLogTail {} { + $::logText yview moveto 1.0 +} + +proc deleteLastChar {} { + $::logText delete "end-2c" + $::logText yview moveto 1.0 +} + +proc clearLogText {} { + $::logText delete 1.0 end +} + +set ::saveFileName {} + +proc saveLogText {} { + set ::saveFileName [tk_getSaveFile -initialfile $::saveFileName \ + -title "Save log text to file"] + if {[string length $::saveFileName] > 0} { + set fp [open $::saveFileName "w"] + puts $fp [$::logText get 1.0 end] + close $fp + } +}; # end saveLogText + +proc sendTextChar { character } { + # We use this function in the key-binding for the logText widget. + # The break is to stop the default binding from inserting another + # character into the widget. + serialOut $::tty $character + return -code break +} + +set ::linesToSend {} + +proc sendFirstLine {} { + if {$::waitingForCR} { + # reschedule the current work + after $::afterLineMilliseconds sendFirstLine + return + } + # Pop the first line from the list and send it. + set line [lindex $::linesToSend 0] + set ::linesToSend [lreplace $::linesToSend 0 0] + foreach character [split $line {}] { + serialOut $::tty $character + after 1; # 1ms pause after each character + } + serialOut $::tty "\r" + set ::waitingForCR true + if {[llength $::linesToSend] > 0} { + # there is more work to do + after $::afterLineMilliseconds sendFirstLine + } +}; # end sendLine + +set ::sendFileName {} + +proc sendFile {} { + set ::sendFileName [tk_getOpenFile -initialfile $::sendFileName \ + -title "Open file to send"] + if {[string length $::sendFileName] > 0} { + set fp [open $::sendFileName "r"] + while {[gets $fp line] >= 0} { lappend ::linesToSend $line } + close $fp + sendFirstLine + } +}; # end sendFile + +proc sendSelection { text } { + foreach line [split $text "\n"] { lappend ::linesToSend $line } + sendFirstLine + return -code break +}; # end sendSelection + +# The following binding redirects key presses in the text widget +# to the serial-port. +bind $::logText [list sendTextChar %A] + +# The following virtual event can be triggered with Control-Shift-v +# or with clicking the middle mouse button in X-Windows. +# The selected region of text is sent to the serial port. +event add <> +bind $::logText <> { sendSelection [selection get] } + +# Keyboard short-cuts. +bind $::logText { sendFile } +bind $::logText { saveLogText } +bind $::logText { displayExitDialog } + +proc warmRestart {} { + serialOut $::tty "\x0f"; # Control-O +} + +# -------------------------------------------------------------- +# Initialize streams and hand control over to the event loop. +openSerialPort +update idletasks +focus $::logText -- cgit v1.2.3