1 # Wrappers around interaction primitives that take a potentially fake object
  2 # and are thus easier to test.
  3 
  4 exclusive-container event [
  5   text:char
  6   keycode:num  # keys on keyboard without a unicode representation
  7   touch:touch-event  # mouse, track ball, etc.
  8   resize:resize-event
  9   # update the assume-console handler if you add more variants
 10 ]
 11 
 12 container touch-event [
 13   type:num
 14   row:num
 15   column:num
 16 ]
 17 
 18 container resize-event [
 19   width:num
 20   height:num
 21 ]
 22 
 23 container console [
 24   current-event-index:num
 25   events:&:@:event
 26 ]
 27 
 28 def new-fake-console events:&:@:event -> result:&:console [
 29   local-scope
 30   load-inputs
 31   result:&:console <- new console:type
 32   *result <- put *result, events:offset, events
 33 ]
 34 
 35 def read-event console:&:console -> result:event, found?:bool, quit?:bool, console:&:console [
 36   local-scope
 37   load-inputs
 38   {
 39     break-unless console
 40     current-event-index:num <- get *console, current-event-index:offset
 41     buf:&:@:event <- get *console, events:offset
 42     {
 43       max:num <- length *buf
 44       done?:bool <- greater-or-equal current-event-index, max
 45       break-unless done?
 46       dummy:&:event <- new event:type
 47       return *dummy, true/found, true/quit
 48     }
 49     result <- index *buf, current-event-index
 50     current-event-index <- add current-event-index, 1
 51     *console <- put *console, current-event-index:offset, current-event-index
 52     return result, true/found, false/quit
 53   }
 54   switch  # real event source is infrequent; avoid polling it too much
 55   result:event, found?:bool <- check-for-interaction
 56   return result, found?, false/quit
 57 ]
 58 
 59 # variant of read-event for just keyboard events. Discards everything that
 60 # isn't unicode, so no arrow keys, page-up/page-down, etc. But you still get
 61 # newlines, tabs, ctrl-d..
 62 def read-key console:&:console -> result:char, found?:bool, quit?:bool, console:&:console [
 63   local-scope
 64   load-inputs
 65   x:event, found?:bool, quit?:bool, console <- read-event console
 66   return-if quit?, 0, found?, quit?
 67   return-unless found?, 0, found?, quit?
 68   c:char, converted?:bool <- maybe-convert x, text:variant
 69   return-unless converted?, 0, false/found, false/quit
 70   return c, true/found, false/quit
 71 ]
 72 
 73 def send-keys-to-channel console:&:console, chan:&:sink:char, screen:&:screen -> console:&:console, chan:&:sink:char, screen:&:screen [
 74   local-scope
 75   load-inputs
 76   {
 77     c:char, found?:bool, quit?:bool, console <- read-key console
 78     loop-unless found?
 79     break-if quit?
 80     assert c, [invalid event, expected text]
 81     screen <- print screen, c
 82     chan <- write chan, c
 83     loop
 84   }
 85   chan <- close chan
 86 ]
 87 
 88 def wait-for-event console:&:console -> console:&:console [
 89   local-scope
 90   load-inputs
 91   {
 92     _, found?:bool <- read-event console
 93     break-if found?
 94     switch
 95     loop
 96   }
 97 ]
 98 
 99 def has-more-events? console:&:console -> result:bool [
100   local-scope
101   load-inputs
102   return-if console, false  # fake events are processed as soon as they arrive
103   result <- interactions-left?
104 ]