2015-06-22 06:23:57 +00:00
|
|
|
# Wrappers around interaction primitives that take a potentially fake object
|
|
|
|
# and are thus easier to test.
|
2015-05-04 21:47:14 +00:00
|
|
|
|
2015-06-22 06:23:57 +00:00
|
|
|
exclusive-container event [
|
2016-09-17 07:31:55 +00:00
|
|
|
text:char
|
2016-09-17 17:28:25 +00:00
|
|
|
keycode:num # keys on keyboard without a unicode representation
|
2015-06-23 07:18:40 +00:00
|
|
|
touch:touch-event # mouse, track ball, etc.
|
2015-08-10 01:44:34 +00:00
|
|
|
resize:resize-event
|
2015-06-22 06:23:57 +00:00
|
|
|
# update the assume-console handler if you add more variants
|
|
|
|
]
|
|
|
|
|
2015-06-23 07:18:40 +00:00
|
|
|
container touch-event [
|
2016-09-17 17:28:25 +00:00
|
|
|
type:num
|
|
|
|
row:num
|
|
|
|
column:num
|
2015-06-22 06:23:57 +00:00
|
|
|
]
|
|
|
|
|
2015-08-10 01:44:34 +00:00
|
|
|
container resize-event [
|
2016-09-17 17:28:25 +00:00
|
|
|
width:num
|
|
|
|
height:num
|
2015-08-10 01:44:34 +00:00
|
|
|
]
|
|
|
|
|
2015-06-22 06:23:57 +00:00
|
|
|
container console [
|
2016-09-17 17:28:25 +00:00
|
|
|
current-event-index:num
|
2016-09-17 20:00:39 +00:00
|
|
|
events:&:@:event
|
2015-05-04 21:47:14 +00:00
|
|
|
]
|
|
|
|
|
2016-09-17 20:00:39 +00:00
|
|
|
def new-fake-console events:&:@:event -> result:&:console [
|
2015-07-14 05:43:16 +00:00
|
|
|
local-scope
|
2017-12-04 07:25:40 +00:00
|
|
|
load-inputs
|
2016-09-17 19:55:10 +00:00
|
|
|
result:&:console <- new console:type
|
2016-04-16 22:50:56 +00:00
|
|
|
*result <- put *result, events:offset, events
|
2015-05-04 21:47:14 +00:00
|
|
|
]
|
|
|
|
|
2016-10-23 22:50:27 +00:00
|
|
|
def read-event console:&:console -> result:event, found?:bool, quit?:bool, console:&:console [
|
2015-07-14 05:43:16 +00:00
|
|
|
local-scope
|
2017-12-04 07:25:40 +00:00
|
|
|
load-inputs
|
2015-05-04 21:47:14 +00:00
|
|
|
{
|
2015-11-19 05:36:36 +00:00
|
|
|
break-unless console
|
2016-09-17 17:28:25 +00:00
|
|
|
current-event-index:num <- get *console, current-event-index:offset
|
2016-09-17 20:00:39 +00:00
|
|
|
buf:&:@:event <- get *console, events:offset
|
2015-05-04 21:47:14 +00:00
|
|
|
{
|
2016-09-17 17:28:25 +00:00
|
|
|
max:num <- length *buf
|
2016-09-17 17:32:57 +00:00
|
|
|
done?:bool <- greater-or-equal current-event-index, max
|
2015-07-29 21:37:57 +00:00
|
|
|
break-unless done?
|
2016-09-17 19:55:10 +00:00
|
|
|
dummy:&:event <- new event:type
|
2018-06-17 07:05:38 +00:00
|
|
|
return *dummy, true/found, true/quit
|
2015-05-04 21:47:14 +00:00
|
|
|
}
|
2016-04-16 22:50:56 +00:00
|
|
|
result <- index *buf, current-event-index
|
|
|
|
current-event-index <- add current-event-index, 1
|
|
|
|
*console <- put *console, current-event-index:offset, current-event-index
|
2018-06-17 07:05:38 +00:00
|
|
|
return result, true/found, false/quit
|
2015-05-04 21:47:14 +00:00
|
|
|
}
|
2015-08-20 22:14:59 +00:00
|
|
|
switch # real event source is infrequent; avoid polling it too much
|
2016-09-17 17:32:57 +00:00
|
|
|
result:event, found?:bool <- check-for-interaction
|
2018-06-17 07:05:38 +00:00
|
|
|
return result, found?, false/quit
|
2015-05-04 21:47:14 +00:00
|
|
|
]
|
|
|
|
|
2015-06-23 07:22:41 +00:00
|
|
|
# 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..
|
2016-10-23 22:50:27 +00:00
|
|
|
def read-key console:&:console -> result:char, found?:bool, quit?:bool, console:&:console [
|
2015-07-14 05:43:16 +00:00
|
|
|
local-scope
|
2017-12-04 07:25:40 +00:00
|
|
|
load-inputs
|
2016-10-23 22:50:27 +00:00
|
|
|
x:event, found?:bool, quit?:bool, console <- read-event console
|
|
|
|
return-if quit?, 0, found?, quit?
|
|
|
|
return-unless found?, 0, found?, quit?
|
2016-09-17 17:32:57 +00:00
|
|
|
c:char, converted?:bool <- maybe-convert x, text:variant
|
2018-06-17 07:05:38 +00:00
|
|
|
return-unless converted?, 0, false/found, false/quit
|
|
|
|
return c, true/found, false/quit
|
2015-05-04 21:47:14 +00:00
|
|
|
]
|
2015-05-09 17:56:44 +00:00
|
|
|
|
2016-09-17 19:55:10 +00:00
|
|
|
def send-keys-to-channel console:&:console, chan:&:sink:char, screen:&:screen -> console:&:console, chan:&:sink:char, screen:&:screen [
|
2015-07-14 05:43:16 +00:00
|
|
|
local-scope
|
2017-12-04 07:25:40 +00:00
|
|
|
load-inputs
|
2015-05-09 17:56:44 +00:00
|
|
|
{
|
2016-10-23 22:50:27 +00:00
|
|
|
c:char, found?:bool, quit?:bool, console <- read-key console
|
2015-07-29 21:37:57 +00:00
|
|
|
loop-unless found?
|
|
|
|
break-if quit?
|
|
|
|
assert c, [invalid event, expected text]
|
2015-11-21 18:19:34 +00:00
|
|
|
screen <- print screen, c
|
2015-07-29 21:37:57 +00:00
|
|
|
chan <- write chan, c
|
2015-05-09 17:56:44 +00:00
|
|
|
loop
|
|
|
|
}
|
2016-04-27 07:10:20 +00:00
|
|
|
chan <- close chan
|
2015-05-09 17:56:44 +00:00
|
|
|
]
|
2015-06-22 06:37:49 +00:00
|
|
|
|
2016-09-17 19:55:10 +00:00
|
|
|
def wait-for-event console:&:console -> console:&:console [
|
2015-07-14 05:43:16 +00:00
|
|
|
local-scope
|
2017-12-04 07:25:40 +00:00
|
|
|
load-inputs
|
2015-06-22 06:37:49 +00:00
|
|
|
{
|
2016-10-23 22:50:27 +00:00
|
|
|
_, found?:bool <- read-event console
|
2016-10-24 02:57:26 +00:00
|
|
|
break-if found?
|
|
|
|
switch
|
|
|
|
loop
|
2015-06-22 06:37:49 +00:00
|
|
|
}
|
|
|
|
]
|
2015-07-09 04:03:32 +00:00
|
|
|
|
2016-09-17 19:55:10 +00:00
|
|
|
def has-more-events? console:&:console -> result:bool [
|
2015-07-14 05:43:16 +00:00
|
|
|
local-scope
|
2017-12-04 07:25:40 +00:00
|
|
|
load-inputs
|
2018-06-17 07:05:38 +00:00
|
|
|
return-if console, false # fake events are processed as soon as they arrive
|
2015-11-19 05:36:36 +00:00
|
|
|
result <- interactions-left?
|
2015-07-09 04:03:32 +00:00
|
|
|
]
|