File:  [gforth] / gforth / contrib / terminal.fs
Revision 1.2: download - view: text, annotated - select for diffs
Thu Nov 3 19:08:47 2005 UTC (18 years, 4 months ago) by anton
Branches: MAIN
CVS tags: v0-7-0, HEAD
contrib/terminal.fs updated (coming from Krishna Myeni)

\ 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
\       2005-09-28  Fixed problem associated with read-line  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  <CR>
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 IF
	      \ error reading file
	      2drop txfid @ close-file drop FALSE to ?sending
	      save_cursor
	      HELP_ROW HELP_BACK_COLOR clear-line
	      HELP_TEXT_COLOR foreground
	      ." Error reading file!"
	        restore_cursor set-terminal-colors
	    ELSE
	      FALSE = IF
	        \ reached EOF
		drop txfid @ close-file drop
	        FALSE to ?sending
	        save_cursor
	        HELP_ROW HELP_BACK_COLOR clear-line
	        HELP_TEXT_COLOR foreground
	        ." <<Terminal: Send Completed!>>"
	        restore_cursor set-terminal-colors
	      ELSE
	        com @ swap send-line-buffer swap serial_write drop
	      THEN
	    THEN
	  THEN

	  BEGIN
	    com @ serial_lenrx
	  WHILE
	    com @ buf 1 serial_read drop
	    buf c@ dup <CR> = IF CR ELSE emit THEN
	    ?capture IF
	      buf c@ <CR> = 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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>