Powered by ViewCVS 1.0-dev
| 1 : | anton | 1.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 |
|
CVS Admin Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |