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

@@ -7,64 +7,119 @@
 (use-modules
  (srfi srfi-1)
  (ice-9 match)
- (srfi srfi-9 gnu)
+ (rnrs io ports)
+ (termios)
  (goblins)
- (goblins actor-lib cell))
+ (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-immutable-record-type <model>
-  (make-model choices cursor selections)
-  model?
-  (choices model-choices set-model-choices)
-  (cursor model-cursor set-model-cursor)
-  ;; a list of indices that are selected
-  (selections model-selections set-model-selections))
+(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 initial-state
-  (make-model '("Buy carrots" "Buy celery" "Buy kohlrabi") 0 '()))
+(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"))))
 
 
-;; Init function currently does nothing
-(define (init m) #f)
+(define halted? (make-condition))
+(define inited? (make-condition))
 
-;; Update function for updating model and returning commands
-(define (update parent m msg)
-  (let ((cursor (model-cursor m)))
-    (match msg
-      (($ <key-message> (or 'ctrl-c 'q))
-       (<-np parent 'quit))
-      (($ <key-message> (or 'up 'k))
-       (<-np m (set-model-cursor m (- cursor 1))))
-      (($ <key-message> (or 'down 'j))
-       (<-np m (set-model-cursor m (1+ cursor))))
-      (($ <key-message> (or 'enter 'space))
-       (<-np m
-          (let ((selections (model-selections m))
-                (cursor-selected? (memq cursor selections)))
-            (set-model-selections
-             m
-             (if cursor-selected?
-                 (delq cursor selections)
-                 (cons cursor selections)))))))))
+(define stdout (current-output-port))
 
-(define (view m)
-  (format #t "What should we buy at the market?\n\n")
-
-  (for-each
-   (λ (choice i)
-     (let* ((selections (model-selections m))
-            (cursor
-             (if (= i (model-cursor m)) ">" " "))
-            (checked
-             (if (memq cursor selections) "x" " ")))
-       (format #t "~a [~a] ~a\n" cursor checked choice)))
-   (model-choices m))
-
-  (format #t "\nPress q to quit.\n"))
+;; 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-cell model initial-state)
- (define program (make-cup model))
- ($ program 'run))
+ (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?))