\ terminal.fs \ \ Simple terminal emulator for gforth (ported from kForth) \ \ Written by David P. Wallace and Krishna Myneni \ Provided under the terms of the GNU General Public License \ \ Requires: \ \ strings.fs \ ansi.fs \ syscalls386.fs \ serial.fs \ \ Revisions: \ 2004-03-13 Avoid response lag to input due to key? in terminal; \ added Send File function KM \ 2004-09-17 Ported to gforth from kForth; use WRITE-FILE instead \ of "write" to store data in capture file KM include strings.fs include ansi.fs include syscalls386.fs include serial.fs \ ============= defs from kForth files.4th base @ hex A constant EOL 40 constant O_CREAT 80 constant O_EXCL 200 constant O_TRUNC 400 constant O_APPEND 0 constant SEEK_SET 1 constant SEEK_CUR 2 constant SEEK_END base ! create EOL_BUF 4 allot EOL EOL_BUF c! 0 EOL_BUF 1+ c! : file-exists ( ^filename -- flag | return true if file exists ) count R/O open-file if drop false else close-file drop true then ; \ ============= : ms@ ( -- u ) utime 1 1000 m*/ d>s ; : >UPC 95 AND ; : EKEY ( -- u | return extended key as concatenated byte sequence ) BEGIN key? UNTIL 0 BEGIN key? WHILE 8 LSHIFT key or REPEAT ; variable com create buf 64 allot \ examples of using terminal: \ \ COM2 B9600 c" 8N1" terminal ( terminal on com2 at 9600 baud, 8N1 ) \ COM1 B57600 c" E71" terminal ( terminal on com1 at 57.6 Kbaud, 7E1 ) HEX 0D CONSTANT 1B CONSTANT ESC 1B4F50 CONSTANT F1 1B4F51 CONSTANT F2 1B4F52 CONSTANT F3 DECIMAL 0 CONSTANT HELP_ROW BLUE CONSTANT HELP_EKEY_COLOR BLACK CONSTANT HELP_TEXT_COLOR WHITE CONSTANT HELP_BACK_COLOR BLACK CONSTANT TERM_BACK_COLOR WHITE CONSTANT TERM_TEXT_COLOR : clear-line ( row background -- ) background dup 0 SWAP AT-XY 80 spaces 0 SWAP AT-XY ; : set-terminal-colors ( -- ) TERM_TEXT_COLOR foreground TERM_BACK_COLOR background ; : terminal-help ( -- | show the help line ) save_cursor HELP_ROW HELP_BACK_COLOR clear-line HELP_EKEY_COLOR foreground ." Esc " HELP_TEXT_COLOR foreground ." Exit " HELP_EKEY_COLOR foreground ." F1 " HELP_TEXT_COLOR foreground ." Show Key Help " HELP_EKEY_COLOR foreground ." F2 " HELP_TEXT_COLOR foreground ." Capture On/Off " HELP_EKEY_COLOR foreground ." F3 " HELP_TEXT_COLOR foreground ." Send Text File " restore_cursor ; variable fid FALSE VALUE ?capture create filename 256 allot create capture-filename 256 allot : close-capture-file ( -- ) fid @ close drop FALSE to ?capture ; : capture-file ( -- ) ?capture IF close-capture-file HELP_ROW HELP_BACK_COLOR clear-line HELP_TEXT_COLOR foreground ." Capture file closed!" ELSE HELP_ROW HELP_BACK_COLOR clear-line HELP_TEXT_COLOR foreground ." Capture to file named: " filename 254 accept filename swap strpck capture-filename strcpy capture-filename file-exists IF HELP_ROW HELP_BACK_COLOR clear-line ." File " capture-filename count type ." already exists! Overwrite (Y/N)? " key >upc [char] Y = IF capture-filename count W/O O_TRUNC or open-file 0= IF fid ! TRUE to ?capture ELSE HELP_ROW HELP_BACK_COLOR clear-line ." Unable to open output file!" EXIT THEN ELSE HELP_ROW HELP_BACK_COLOR clear-line ." Capture cancelled!" EXIT THEN ELSE capture-filename count W/O create-file 0= IF fid ! TRUE to ?capture ELSE HELP_ROW HELP_BACK_COLOR clear-line ." Unable to open output file!" EXIT THEN THEN THEN ; create send-filename 256 allot create send-line-buffer 256 allot variable txfid variable last-send-time 10 VALUE LINE-DELAY \ delay in ms between sending each line of text 1 VALUE CHAR-DELAY \ to send data to *slow* terminals FALSE VALUE ?sending : send-file ( -- ) HELP_ROW HELP_BACK_COLOR clear-line HELP_TEXT_COLOR foreground ." Text File to Send: " filename 254 accept filename swap strpck send-filename strcpy send-filename file-exists 0= IF HELP_ROW HELP_BACK_COLOR clear-line ." Input file does not exist!" EXIT THEN send-filename count R/O open-file 0= IF txfid ! HELP_ROW HELP_BACK_COLOR clear-line ." Sending file " send-filename count type ." ..." TRUE to ?sending ELSE HELP_ROW HELP_BACK_COLOR clear-line ." Unable to open input file!" EXIT THEN ms@ last-send-time ! ; : terminal-status? ( -- flag | TRUE equals ok to exit terminal ) ?sending IF HELP_ROW HELP_BACK_COLOR clear-line HELP_TEXT_COLOR foreground ." File Send in Progress! Halt Sending and Exit (Y/N)? " KEY >UPC [CHAR] Y = IF txfid @ close-file drop FALSE TO ?sending ELSE 0 EXIT THEN THEN ?capture IF close-capture-file THEN TRUE ; : terminal ( port baud ^str_param -- | terminal emulator ) TERM_BACK_COLOR background page terminal-help set-terminal-colors 0 HELP_ROW 1+ AT-XY rot serial_open com ! com @ swap serial_setparams com @ swap serial_setbaud BEGIN ?sending ms@ last-send-time @ - LINE-DELAY >= AND IF ms@ last-send-time ! send-line-buffer 256 txfid @ read-line nip 0= IF com @ swap send-line-buffer swap serial_write drop ELSE txfid @ close-file drop FALSE to ?sending save_cursor HELP_ROW HELP_BACK_COLOR clear-line HELP_TEXT_COLOR foreground ." <>" restore_cursor set-terminal-colors THEN THEN BEGIN com @ serial_lenrx WHILE com @ buf 1 serial_read drop buf c@ dup = IF CR ELSE emit THEN ?capture IF buf c@ = IF EOL_BUF dup strlen ELSE buf 1 THEN fid @ write-file drop THEN REPEAT key? IF EKEY CASE ESC OF terminal-status? IF com @ serial_close drop text_normal \ restore normal colors and attributes PAGE EXIT \ clear the screen and exit THEN ENDOF F1 OF terminal-help set-terminal-colors ENDOF F2 OF save_cursor capture-file restore_cursor set-terminal-colors ENDOF F3 OF save_cursor send-file restore_cursor set-terminal-colors ENDOF dup dup emit buf c! com @ buf 1 serial_write drop ENDCASE THEN AGAIN ; : term ( -- | start the default terminal ) COM1 B9600 c" 8N1" terminal ( terminal on com1 at 9600 baud, 8N1 ) ; CR CR .( Type 'term' to start a 9600 baud terminal on COM1 configured with 8N1.) CR CR