![[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 [Qemu by Fabrice Bellard] / qemu / roms / openbios / forth / device|
Return to terminal.fs CVS log | Up to [Qemu by Fabrice Bellard] / qemu / roms / openbios / forth / device |
1.1 ! root 1: \ tag: terminal emulation ! 2: \ ! 3: \ this code implements IEEE 1275-1994 ANNEX B ! 4: \ ! 5: \ Copyright (C) 2003 Stefan Reinauer ! 6: \ ! 7: \ See the file "COPYING" for further information about ! 8: \ the copyright and warranty status of this work. ! 9: \ ! 10: ! 11: 0 value (escseq) ! 12: 10 buffer: (sequence) ! 13: ! 14: : (match-number) ( x y [1|2] [1|2] -- x [z] ) ! 15: 2dup = if \ 1 1 | 2 2 ! 16: drop exit ! 17: then ! 18: 2dup > if ! 19: 2drop drop 1 exit ! 20: then ! 21: 2drop 0 ! 22: ; ! 23: ! 24: : (esc-number) ( maxchar -- ?? ?? num ) ! 25: >r depth >r ( R: depth maxchar ) ! 26: 0 (sequence) 2+ (escseq) 2- ( 0 seq+2 seqlen-2 ) ! 27: \ if numerical, scan until non-numerical ! 28: 0 ?do ! 29: ( 0 seq+2 ) ! 30: dup i + c@ a ! 31: digit if ! 32: ( 0 ptr n ) ! 33: rot a * + ( ptr val ) ! 34: swap ! 35: else ! 36: ( 0 ptr asc ) ! 37: ascii ; = if ! 38: 0 swap ! 39: else ! 40: drop leave ! 41: then ! 42: then ! 43: ! 44: loop ! 45: depth r> - r> ! 46: 0 to (escseq) ! 47: (match-number) ! 48: ; ! 49: ! 50: : (match-seq) ! 51: (escseq) 1- (sequence) + c@ \ get last character in sequence ! 52: \ dup draw-character ! 53: case ! 54: ascii A of \ CUU - cursor up ! 55: 1 (esc-number) ! 56: 0> if ! 57: 1 max ! 58: else ! 59: 1 ! 60: then ! 61: negate line# + ! 62: 0 max to line# ! 63: endof ! 64: ascii B of \ CUD - cursor down ! 65: 1 (esc-number) ! 66: 0> if ! 67: 1 max ! 68: line# + ! 69: #lines 1- min to line# ! 70: then ! 71: endof ! 72: ascii C of \ CUF - cursor forward ! 73: 1 (esc-number) ! 74: 0> if ! 75: 1 max ! 76: column# + ! 77: #columns 1- min to column# ! 78: then ! 79: endof ! 80: ascii D of \ CUB - cursor backward ! 81: 1 (esc-number) ! 82: 0> if ! 83: 1 max ! 84: negate column# + ! 85: 0 max to column# ! 86: then ! 87: endof ! 88: ascii E of \ Cursor next line (CNL) ! 89: \ FIXME - check agains ANSI3.64 ! 90: 1 (esc-number) ! 91: 0> if ! 92: 1 max ! 93: line# + ! 94: #lines 1- min to line# ! 95: then ! 96: 0 to column# ! 97: endof ! 98: ascii f of ! 99: 2 (esc-number) ! 100: 2 = if ! 101: #columns 1- min to column# ! 102: #lines 1- min to line# ! 103: then ! 104: endof ! 105: ascii H of ! 106: 2 (esc-number) ! 107: 2 = if ! 108: #columns 1- min to column# ! 109: #lines 1- min to line# ! 110: then ! 111: endof ! 112: ascii J of ! 113: 0 to (escseq) ! 114: #columns column# - delete-characters ! 115: #lines line# - delete-lines ! 116: endof ! 117: ascii K of ! 118: 0 to (escseq) ! 119: #columns column# - delete-characters ! 120: endof ! 121: ascii L of ! 122: 1 (esc-number) ! 123: 0> if ! 124: 1 max ! 125: insert-lines ! 126: then ! 127: endof ! 128: ascii M of ! 129: 1 (esc-number) ! 130: 1 = if ! 131: 1 max ! 132: delete-lines ! 133: then ! 134: endof ! 135: ascii @ of ! 136: 1 (esc-number) ! 137: 1 = if ! 138: 1 max ! 139: insert-characters ! 140: then ! 141: endof ! 142: ascii P of ! 143: 1 (esc-number) ! 144: 1 = if ! 145: 1 max ! 146: delete-characters ! 147: then ! 148: endof ! 149: ascii m of ! 150: 1 (esc-number) ! 151: 1 = if ! 152: 7 = if ! 153: true to inverse? ! 154: else ! 155: false to inverse? ! 156: then ! 157: then ! 158: endof ! 159: ascii p of \ normal text colors ! 160: 0 to (escseq) ! 161: inverse-screen? if ! 162: false to inverse-screen? ! 163: inverse? 0= to inverse? ! 164: invert-screen ! 165: then ! 166: endof ! 167: ascii q of \ inverse text colors ! 168: 0 to (escseq) ! 169: inverse-screen? not if ! 170: true to inverse-screen? ! 171: inverse? 0= to inverse? ! 172: invert-screen ! 173: then ! 174: endof ! 175: ascii s of ! 176: \ Resets the display device associated with the terminal emulator. ! 177: 0 to (escseq) ! 178: reset-screen ! 179: endof ! 180: endcase ! 181: ; ! 182: ! 183: : (term-emit) ( char -- ) ! 184: toggle-cursor ! 185: ! 186: (escseq) 0> if ! 187: (escseq) 10 = if ! 188: 0 to (escseq) ! 189: ." overflow in esc" cr ! 190: drop ! 191: then ! 192: (escseq) 1 = if ! 193: dup ascii [ = if \ not a [ ! 194: (sequence) 1+ c! ! 195: 2 to (escseq) ! 196: else ! 197: 0 to (escseq) \ break out of ESC sequence ! 198: ." out of ESC" cr ! 199: drop \ don't print breakout character ! 200: then ! 201: toggle-cursor exit ! 202: else ! 203: (sequence) (escseq) + c! ! 204: (escseq) 1+ to (escseq) ! 205: (match-seq) ! 206: toggle-cursor exit ! 207: then ! 208: then ! 209: ! 210: case ! 211: 7 of \ BEL ! 212: blink-screen ! 213: s" /screen" s" ring-bell" ! 214: execute-device-method ! 215: endof ! 216: 8 of \ BS ! 217: column# 0<> if ! 218: column# 1- dup ! 219: to column# ! 220: 20 draw-character ! 221: to column# ! 222: then ! 223: endof ! 224: 9 of \ TAB ! 225: column# dup #columns = if ! 226: drop ! 227: else ! 228: 8 + -8 and ff and to column# ! 229: then ! 230: endof ! 231: a of \ LF ! 232: line# 1+ to line# 0 to column# ! 233: endof ! 234: b of \ VT ! 235: line# 0<> if ! 236: line# 1- to line# ! 237: then ! 238: endof ! 239: c of \ FF ! 240: 0 to column# 0 to line# ! 241: erase-screen ! 242: endof ! 243: d of \ CR ! 244: 0 to column# ! 245: endof ! 246: 1b of \ ESC ! 247: 1b (sequence) c! ! 248: 1 to (escseq) ! 249: endof ! 250: dup draw-character ! 251: endcase ! 252: toggle-cursor ! 253: ; ! 254: ! 255: ['] (term-emit) to fb-emit
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.