Working but messy api-less example that can be cleaned up!

configure.ac

@@ -32,6 +32,7 @@ dnl Hall auto-generated guile-module dependencies
 GUILE_MODULE_REQUIRED([reflow wrap])
 GUILE_MODULE_REQUIRED([termenv])
 GUILE_MODULE_REQUIRED([goblins])
+GUILE_MODULE_REQUIRED([termios])
 
 dnl Installation directories for .scm and .go files.
 guilemoduledir="${datarootdir}/guile/site/$GUILE_EFFECTIVE_VERSION"

guix.scm

@@ -27,17 +27,16 @@
             (uri (git-reference
                   (url "https://gitlab.com/spritely/guile-goblins.git")
                   ;; Need version with IO and Christine's call-with-vat fixes! :D
-                  (commit "0ebfdef75c921b6b125db2e674153ce55b25fd7b")))
+                  (commit "290da71602fc4bf6632f329bee8560b202f25b13")))
             (sha256
              (base32
-              "0ac7mprsaccl8lapb8bbrvybfih6nkpphfbafav5zd26mwg63mgc"))))
+              "1h7h6njlmm3yh3mpb12040ry7rpbzq4s3czkrsvffh62gqql5cbb"))))
    (native-inputs
     `(("autoconf" ,autoconf)
       ("automake" ,automake)
       ("pkg-config" ,pkg-config)
       ,@(package-native-inputs guile-goblins)))))
 
-
 (package
  (name "guile-buttercup")
  (version "0.1")
@@ -56,7 +55,7 @@
  (native-inputs
   (list autoconf automake pkg-config texinfo))
  (inputs (list guile-3.0))
- (propagated-inputs (list guile-reflow guile-termenv guile-goblins-git))
+ (propagated-inputs (list guile-termios guile-reflow guile-termenv guile-goblins-git))
  (synopsis "Guile library for creating terminal applications")
  (description
   "A Guile library, inspired by Go's Bubbletea, for creating beautiful terminal applications using Spritely Goblins.")

scripts/examples/select-list.in

@@ -2,4 +2,124 @@
 -*- scheme -*-
 !#
 
-(use-modules (goblins))
+;; Goal: Make a todo list like the one used for intro to bubbletea
+
+(use-modules
+ (srfi srfi-1)
+ (ice-9 match)
+ (rnrs io ports)
+ (termios)
+ (goblins)
+ (goblins actor-lib methods)
+ (goblins actor-lib joiners)
+ (goblins actor-lib let-on)
+ (goblins actor-lib cell)
+ (goblins actor-lib io)
+ (fibers conditions)
+ (fibers operations)
+ (termenv screen))
+
+(define vat (spawn-vat))
+
+(define* (^list-item bcom label #:optional (selected? #f))
+  (methods
+   ((view) (format #f "[~a] ~a" (if selected? "x" " ") label))
+   ((selected?) selected?)
+   ((toggle)
+    (bcom (^list-item bcom label (not selected?))))))
+
+(define* (^list bcom choices #:optional (cursor 0))
+  (methods
+   ((update event)
+    (match event
+      (#\q
+       'quit)
+      (#\k
+       (when (> cursor 0)
+         (bcom (^list bcom choices (- cursor 1)))))
+      (#\j
+       (when (< cursor (- (length choices) 1))
+         (bcom (^list bcom choices (1+ cursor)))))
+      ((or #\return #\space)
+       (<- (list-ref choices cursor) 'toggle))
+      (else #f)))
+   ((view)
+    (on
+     (all-of*
+      (map
+       (λ (choice) (<- choice 'view))
+       choices))
+     (λ (choices-o)
+       (string-append/shared
+        "What should we buy at the market?\r\n\r\n"
+        (string-join
+         (map
+          (λ (choice-o i)
+            (string-append/shared
+             (if (= i cursor)
+                 ">"
+                 " ")
+             choice-o))
+          choices-o
+          (iota (length choices-o))) "\r\n")
+        "\r\n\r\nPress q to quit\r\n"))
+     #:promise? #t))))
+
+(define (make-initial-list)
+  (spawn ^list
+   (list
+    (spawn ^list-item "Buy carrots")
+    (spawn ^list-item "Buy celery")
+    (spawn ^list-item "Buy kohlrabi"))))
+
+
+(define halted? (make-condition))
+(define inited? (make-condition))
+
+(define stdout (current-output-port))
+
+;; not current-input-port, which is a soft port
+(define stdin (standard-input-port))
+(define ts-old (make-termios-struct))
+(define ts-new (make-termios-struct))
+(tc-get-attr! stdin ts-old)
+(tc-get-attr! stdin ts-new)
+(cf-make-raw! ts-new)
+(tc-set-attr stdin ts-new)
+
+(with-vat
+ vat
+ (define list (make-initial-list))
+
+ (define (render str)
+   (cursor-up 7)
+   (display str stdout))
+
+ (define io (spawn ^io (current-input-port)
+                   #:init
+                   (λ (input)
+                     (with-vat vat
+                      (on (<- list 'view)
+                          (λ (str) (display str stdout)))))
+                   #:cleanup
+                   (λ (input)
+                     (signal-condition! halted?)
+                     (scroll-down 7)
+                     (tc-set-attr stdin ts-old)
+                     )))
+
+ ;; (define program (make-cup model))
+ ;; ($ program 'run list)
+
+ (let loop ()
+   (on (<- io get-char)
+       (λ (ch)
+         (when ch
+           (let-on ((command (<- list 'update ch))
+                    (str (<- list 'view)))
+                   (render str)
+                   (if (eq? 'quit command)
+                       (<-np io 'halt)
+                       (loop))))))))
+
+(perform-operation (wait-operation halted?))