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

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
        !            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>