Annotation of gforth/contrib/terminal.fs, revision 1.2

1.1       anton       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
1.2     ! anton      20: \       2005-09-28  Fixed problem associated with read-line  KM
        !            21: \
1.1       anton      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 !
1.2     ! anton     209:            send-line-buffer 256 txfid @ read-line IF
        !           210:              \ error reading file
        !           211:              2drop txfid @ close-file drop FALSE to ?sending
1.1       anton     212:              save_cursor
                    213:              HELP_ROW HELP_BACK_COLOR clear-line
                    214:              HELP_TEXT_COLOR foreground
1.2     ! anton     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
1.1       anton     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>