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

    1: \ terminal.fs
    2: \
    3: \ Simple terminal emulator for gforth (ported from kForth)
    4: \
    5: \ Written by David P. Wallace and Krishna Myneni
    6: \ Provided under the terms of the GNU General Public License
    7: \
    8: \ Requires:
    9: \
   10: \	strings.fs
   11: \	ansi.fs
   12: \	syscalls386.fs
   13: \	serial.fs
   14: \
   15: \ Revisions:
   16: \	2004-03-13  Avoid response lag to input due to key? in terminal;
   17: \	              added Send File function  KM
   18: \       2004-09-17  Ported to gforth from kForth; use WRITE-FILE instead
   19: \                     of "write" to store data in capture file  KM
   20: \       2005-09-28  Fixed problem associated with read-line  KM
   21: \
   22: include strings.fs
   23: include ansi.fs
   24: include syscalls386.fs
   25: include serial.fs
   26: 
   27: \ ============= defs from kForth files.4th 
   28: base @
   29: hex
   30:  A  constant EOL
   31: 40  constant O_CREAT
   32: 80  constant O_EXCL
   33: 200 constant O_TRUNC
   34: 400 constant O_APPEND
   35:  0  constant SEEK_SET
   36:  1  constant SEEK_CUR
   37:  2  constant SEEK_END
   38: base !
   39: create EOL_BUF 4 allot
   40: EOL EOL_BUF c!
   41: 0 EOL_BUF 1+ c!
   42: 
   43: : file-exists ( ^filename  -- flag | return true if file exists )
   44:         count R/O open-file
   45:         if drop false else close-file drop true then ;
   46: \ =============
   47: 
   48: : ms@ ( -- u )  utime 1 1000 m*/ d>s ; 
   49: 
   50: 
   51: : >UPC 95 AND ;
   52: : EKEY ( -- u | return extended key as concatenated byte sequence )
   53:        BEGIN key? UNTIL
   54:        0 BEGIN  key?  WHILE  8 LSHIFT key or  REPEAT ;
   55: 
   56: 
   57: variable com			
   58: create buf 64 allot
   59: 
   60: \ examples of using terminal:
   61: \
   62: \   COM2 B9600  c" 8N1" terminal 	( terminal on com2 at 9600 baud, 8N1 )
   63: \   COM1 B57600 c" E71" terminal 	( terminal on com1 at 57.6 Kbaud, 7E1 )
   64: 
   65: HEX
   66: 0D     CONSTANT  <CR>
   67: 1B     CONSTANT  ESC
   68: 1B4F50 CONSTANT  F1
   69: 1B4F51 CONSTANT  F2
   70: 1B4F52 CONSTANT  F3
   71: DECIMAL
   72: 
   73: 0      CONSTANT  HELP_ROW
   74: BLUE   CONSTANT  HELP_EKEY_COLOR
   75: BLACK  CONSTANT  HELP_TEXT_COLOR
   76: WHITE  CONSTANT  HELP_BACK_COLOR
   77: BLACK  CONSTANT  TERM_BACK_COLOR
   78: WHITE  CONSTANT  TERM_TEXT_COLOR
   79: 
   80: : clear-line ( row background -- ) background dup 0 SWAP AT-XY 
   81:        80 spaces 0 SWAP AT-XY ;
   82: 
   83: : set-terminal-colors ( -- )
   84: 	TERM_TEXT_COLOR foreground
   85: 	TERM_BACK_COLOR background ;
   86:   
   87: : terminal-help ( -- | show the help line )
   88:         save_cursor
   89: 	HELP_ROW HELP_BACK_COLOR clear-line
   90: 	HELP_EKEY_COLOR foreground   ." Esc "
   91: 	HELP_TEXT_COLOR foreground   ." Exit  "
   92: 	HELP_EKEY_COLOR foreground   ." F1 "
   93: 	HELP_TEXT_COLOR foreground   ." Show Key Help   "
   94: 	HELP_EKEY_COLOR foreground   ." F2 "
   95: 	HELP_TEXT_COLOR foreground   ." Capture On/Off  "
   96: 	HELP_EKEY_COLOR foreground   ." F3 "
   97: 	HELP_TEXT_COLOR foreground   ." Send Text File  "
   98: 	restore_cursor
   99: ;
  100: 
  101: 
  102: variable fid
  103: FALSE VALUE ?capture
  104: create filename 256 allot
  105: create capture-filename 256 allot
  106: 
  107: : close-capture-file ( -- )  fid @ close drop FALSE to ?capture ;
  108: 
  109: : capture-file ( -- )
  110:      ?capture IF close-capture-file
  111:                  HELP_ROW HELP_BACK_COLOR clear-line
  112: 		 HELP_TEXT_COLOR foreground
  113: 		 ." Capture file closed!"
  114:               ELSE
  115: 		HELP_ROW HELP_BACK_COLOR clear-line
  116: 		HELP_TEXT_COLOR foreground
  117: 		." Capture to file named: "
  118: 		filename 254 accept
  119: 		filename swap strpck capture-filename strcpy
  120: 		capture-filename file-exists IF
  121: 		  HELP_ROW HELP_BACK_COLOR clear-line
  122: 		  ." File " capture-filename count type 
  123: 		  ."  already exists! Overwrite (Y/N)? "
  124: 		  key >upc [char] Y = IF
  125: 		    capture-filename count W/O O_TRUNC or open-file
  126: 		    0= IF fid ! TRUE to ?capture
  127: 		       ELSE HELP_ROW HELP_BACK_COLOR clear-line
  128: 		         ." Unable to open output file!"
  129: 		         EXIT
  130: 		       THEN
  131: 		  ELSE
  132: 		    HELP_ROW HELP_BACK_COLOR clear-line
  133: 		    ." Capture cancelled!" EXIT
  134: 		  THEN
  135: 		ELSE
  136: 		  capture-filename count W/O create-file
  137: 		  0= IF fid ! TRUE to ?capture
  138: 		     ELSE HELP_ROW HELP_BACK_COLOR clear-line
  139: 		       ." Unable to open output file!"
  140: 		       EXIT
  141: 		     THEN
  142: 		THEN
  143: 	      THEN ;
  144: 
  145: 
  146: create send-filename 256 allot
  147: create send-line-buffer 256 allot
  148: variable txfid
  149: variable last-send-time
  150: 10    VALUE LINE-DELAY        \ delay in ms between sending each line of text
  151:  1    VALUE CHAR-DELAY        \ to send data to *slow* terminals
  152: FALSE VALUE ?sending
  153: 		
  154: : send-file ( -- )
  155: 	    HELP_ROW HELP_BACK_COLOR clear-line
  156: 	    HELP_TEXT_COLOR foreground
  157: 	    ." Text File to Send: "
  158: 	    filename 254 accept
  159: 	    filename swap strpck send-filename strcpy
  160: 	    send-filename file-exists 0= IF
  161: 	      HELP_ROW HELP_BACK_COLOR clear-line
  162: 	      ." Input file does not exist!"
  163: 	      EXIT
  164: 	    THEN
  165: 	    send-filename count R/O open-file 0= IF
  166: 	      txfid !
  167: 	      HELP_ROW HELP_BACK_COLOR clear-line
  168: 	      ." Sending file " send-filename count type ."  ..."
  169: 	      TRUE to ?sending
  170: 	    ELSE
  171: 	      HELP_ROW HELP_BACK_COLOR clear-line
  172: 	      ." Unable to open input file!"
  173: 	      EXIT
  174: 	    THEN 
  175: 	    ms@ last-send-time ! ;
  176: 
  177: 
  178: : terminal-status? ( -- flag | TRUE equals ok to exit terminal )
  179:         ?sending IF
  180: 	  HELP_ROW HELP_BACK_COLOR clear-line
  181: 	  HELP_TEXT_COLOR foreground
  182: 	  ." File Send in Progress! Halt Sending and Exit (Y/N)? "
  183: 	  KEY >UPC [CHAR] Y = IF
  184: 	    txfid @ close-file drop
  185: 	    FALSE TO ?sending
  186: 	  ELSE
  187: 	    0 EXIT
  188: 	  THEN
  189: 	THEN
  190: 	?capture IF close-capture-file THEN
  191: 	TRUE ;
  192: 	  
  193: : terminal ( port baud ^str_param -- | terminal emulator )
  194: 	TERM_BACK_COLOR background
  195: 	page
  196: 	terminal-help
  197: 	set-terminal-colors
  198: 	0 HELP_ROW 1+ AT-XY
  199: 
  200: 	rot
  201: 	serial_open com !
  202: 	com @ swap serial_setparams
  203: 	com @ swap serial_setbaud
  204:    
  205: 	BEGIN
  206: 
  207: 	  ?sending ms@ last-send-time @ - LINE-DELAY >= AND IF
  208: 	    ms@ last-send-time !
  209: 	    send-line-buffer 256 txfid @ read-line IF
  210: 	      \ error reading file
  211: 	      2drop txfid @ close-file drop FALSE to ?sending
  212: 	      save_cursor
  213: 	      HELP_ROW HELP_BACK_COLOR clear-line
  214: 	      HELP_TEXT_COLOR foreground
  215: 	      ." Error reading file!"
  216: 	        restore_cursor set-terminal-colors
  217: 	    ELSE
  218: 	      FALSE = IF
  219: 	        \ reached EOF
  220: 		drop txfid @ close-file drop
  221: 	        FALSE to ?sending
  222: 	        save_cursor
  223: 	        HELP_ROW HELP_BACK_COLOR clear-line
  224: 	        HELP_TEXT_COLOR foreground
  225: 	        ." <<Terminal: Send Completed!>>"
  226: 	        restore_cursor set-terminal-colors
  227: 	      ELSE
  228: 	        com @ swap send-line-buffer swap serial_write drop
  229: 	      THEN
  230: 	    THEN
  231: 	  THEN
  232: 
  233: 	  BEGIN
  234: 	    com @ serial_lenrx
  235: 	  WHILE
  236: 	    com @ buf 1 serial_read drop
  237: 	    buf c@ dup <CR> = IF CR ELSE emit THEN
  238: 	    ?capture IF
  239: 	      buf c@ <CR> = IF EOL_BUF dup strlen ELSE buf 1 THEN   
  240: 	      fid @ write-file drop 
  241: 	    THEN
  242: 	  REPEAT
  243: 
  244: 	  key?
  245: 
  246: 	  IF
  247: 	    EKEY CASE
  248: 	      ESC  OF terminal-status? IF 
  249: 	                com @ serial_close drop
  250: 	                text_normal \ restore normal colors and attributes
  251: 	                PAGE EXIT   \ clear the screen and exit
  252: 		      THEN ENDOF
  253: 	      F1   OF terminal-help set-terminal-colors ENDOF 
  254: 	      F2   OF save_cursor capture-file restore_cursor  
  255: 	              set-terminal-colors ENDOF
  256: 	      F3   OF save_cursor send-file restore_cursor     
  257: 	              set-terminal-colors ENDOF
  258: 	      dup  dup emit buf c! com @ buf 1 serial_write drop
  259: 	    ENDCASE
  260: 	  THEN
  261: 	AGAIN ;
  262: 		
  263: : term ( -- | start the default terminal )
  264:      COM1 B9600  c" 8N1" terminal 	( terminal on com1 at 9600 baud, 8N1 )
  265: ;
  266: 
  267: CR CR
  268: .( Type 'term' to start a 9600 baud terminal on COM1 configured with 8N1.)
  269: CR CR

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