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
|
# Wrappers around interaction primitives that take a potentially fake object
# and are thus easier to test.
exclusive-container event [
text:char
keycode:num # keys on keyboard without a unicode representation
touch:touch-event # mouse, track ball, etc.
resize:resize-event
# update the assume-console handler if you add more variants
]
container touch-event [
type:num
row:num
column:num
]
container resize-event [
width:num
height:num
]
container console [
current-event-index:num
events:&:@:event
]
def new-fake-console events:&:@:event -> result:&:console [
local-scope
load-inputs
result:&:console <- new console:type
*result <- put *result, events:offset, events
]
def read-event console:&:console -> result:event, found?:bool, quit?:bool, console:&:console [
local-scope
load-inputs
{
break-unless console
current-event-index:num <- get *console, current-event-index:offset
buf:&:@:event <- get *console, events:offset
{
max:num <- length *buf
done?:bool <- greater-or-equal current-event-index, max
break-unless done?
dummy:&:event <- new event:type
return *dummy, true/found, true/quit
}
result <- index *buf, current-event-index
current-event-index <- add current-event-index, 1
*console <- put *console, current-event-index:offset, current-event-index
return result, true/found, false/quit
}
switch # real event source is infrequent; avoid polling it too much
result:event, found?:bool <- check-for-interaction
return result, found?, false/quit
]
# variant of read-event for just keyboard events. Discards everything that
# isn't unicode, so no arrow keys, page-up/page-down, etc. But you still get
# newlines, tabs, ctrl-d..
def read-key console:&:console -> result:char, found?:bool, quit?:bool, console:&:console [
local-scope
load-inputs
x:event, found?:bool, quit?:bool, console <- read-event console
return-if quit?, 0, found?, quit?
return-unless found?, 0, found?, quit?
c:char, converted?:bool <- maybe-convert x, text:variant
return-unless converted?, 0, false/found, false/quit
return c, true/found, false/quit
]
def send-keys-to-channel console:&:console, chan:&:sink:char, screen:&:screen -> console:&:console, chan:&:sink:char, screen:&:screen [
local-scope
load-inputs
{
c:char, found?:bool, quit?:bool, console <- read-key console
loop-unless found?
break-if quit?
assert c, [invalid event, expected text]
screen <- print screen, c
chan <- write chan, c
loop
}
chan <- close chan
]
def wait-for-event console:&:console -> console:&:console [
local-scope
load-inputs
{
_, found?:bool <- read-event console
break-if found?
switch
loop
}
]
def has-more-events? console:&:console -> result:bool [
local-scope
load-inputs
return-if console, false # fake events are processed as soon as they arrive
result <- interactions-left?
]
|