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>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to terminal.fs CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [gforth] / gforth / contrib