1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
\ *****************************************************************************
\ * Copyright (c) 2004, 2008 IBM Corporation
\ * All rights reserved.
\ * This program and the accompanying materials
\ * are made available under the terms of the BSD License
\ * which accompanies this distribution, and is available at
\ * http://www.opensource.org/licenses/bsd-license.php
\ *
\ * Contributors:
\ * IBM Corporation - initial implementation
\ ****************************************************************************/
0 VALUE read-xt
0 VALUE write-xt
VARIABLE stdin
VARIABLE stdout
: set-stdin ( ihandle -- )
\ Close old stdin:
stdin @ ?dup IF close-dev THEN
\ Now set the new stdin:
dup stdin !
encode-int s" stdin" set-chosen
;
: set-stdout ( ihandle -- )
\ Close old stdout:
stdout @ ?dup IF close-dev THEN
\ Now set the new stdout:
dup stdout !
encode-int s" stdout" set-chosen
;
: input ( dev-str dev-len -- )
open-dev ?dup IF
\ find new ihandle and xt handle
dup s" read" rot ihandle>phandle find-method
0= IF
drop
cr ." Cannot find the read method for the given input console " cr
EXIT
THEN
to read-xt
set-stdin
THEN
;
: output ( dev-str dev-len -- )
open-dev ?dup IF
\ find new ihandle and xt handle
dup s" write" rot ihandle>phandle find-method
0= IF
drop
cr ." Cannot find the write method for the given output console " cr
EXIT
THEN
to write-xt
set-stdout
THEN
;
: io ( dev-str dev-len -- )
2dup input output
;
1 BUFFER: (term-io-char-buf)
: term-io-emit ( char -- )
write-xt IF
(term-io-char-buf) c!
(term-io-char-buf) 1 write-xt stdout @ call-package
drop
ELSE
serial-emit
THEN
;
' term-io-emit to emit
: term-io-key ( -- char )
read-xt IF
BEGIN
(term-io-char-buf) 1 read-xt stdin @ call-package
0 >
UNTIL
(term-io-char-buf) c@
ELSE
serial-key
THEN
;
' term-io-key to key
\ this word will check what the current chosen input device is:
\ - if it is a serial device, it will use serial-key? to check for available input
\ - if it is a keyboard, it will check if the "key-available?" method is implemented (i.e. for usb-keyboard) and use that
\ - if it's an hv console, use hvterm-key?
\ otherwise it will always return false
: term-io-key? ( -- true|false )
stdin @ ?dup IF
>r \ store ihandle on return stack
s" device_type" r@ ihandle>phandle ( propstr len phandle )
get-property ( true | data dlen false )
IF
\ device_type not found, return false and exit
false
ELSE
1 - \ remove 1 from length to ignore null-termination char
\ device_type found, check wether it is serial or keyboard
2dup s" serial" str= IF
2drop serial-key? r> drop EXIT
THEN \ call serial-key, cleanup return-stack, exit
2dup s" keyboard" str= IF
2drop ( )
\ keyboard found, check for key-available? method, execute it or return false
s" key-available?" r@ ihandle>phandle find-method IF
drop s" key-available?" r@ $call-method
ELSE
false
THEN
r> drop EXIT \ cleanup return-stack, exit
THEN
2drop r> drop false EXIT \ unknown device_type cleanup return-stack, return false
THEN
ELSE
serial-key?
THEN
;
' term-io-key? to key?
|
