File:  [gforth] / gforth / contrib / terminal.fs
Revision 1.1: download - view: text, annotated - select for diffs
Fri Nov 5 14:27:33 2004 UTC (15 years, 1 month ago) by anton
Branches: MAIN
CVS tags: HEAD
added Krishna Myneni's serial.fs, terminal.fs, and support stuff to contrib

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

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