A 'dream' version of the select list project

- Don't try to run this as it doesn't work yet, by design
- Going to slowly build tools to let it work
- And this is going to be a messy scratch pad

scripts/examples/select-list-dream.in

@@ -0,0 +1,136 @@
+#!@GUILE@ --no-auto-compile
+-*- scheme -*-
+!#
+
+;; 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 (expand-view engine tree)
+  (match tree
+    ((? procedure? proc) (proc engine))
+    ((? list? lst) (map (λ (item) (expand-view engine item)) lst))
+    (else tree)))
+
+(define-syntax-rule (define-vprim (name args ...)
+                      exp ...
+                      ((eng content) ...))
+  (define (name args ...)
+    exp ...
+    (lambda (engine)
+      (match engine
+        ;; Problem: Content can contain any number of these functions
+        ;; Need to identify them and resolve them.
+        ('eng (expand-view engine content)) ...))))
+
+(define-vprim (box content)
+  ((html
+    `(div (@ (class "pr-box"))
+          ,content))
+   (term content)))
+
+
+(define-vprim (hbox items)
+  (define items-list (map box items))
+
+  ((html
+    `(div (@ (class "pr-flex pr-hbox"))
+          ,items-list))
+   (term
+    `(happend* ,items-list))))
+
+(define-vprim (vbox items)
+  (define items-list (map box items))
+
+  ((html
+    `(div (@ (class "pr-flex pr-vbox"))
+          ,items-list))
+   (term
+    `(vappend* ,items-list))))
+
+(define* (^list bcom choices #:optional (cursor 0))
+  (methods
+   ((update event)
+    (match event
+      (($ <keypress> (or 'q 'escape))
+       'quit)
+      (($ <keypress> (or 'k 'up))
+       (when (> cursor 0)
+         (bcom (^list bcom choices (- cursor 1)))))
+      (($ <keypress> (or 'k 'down))
+       (when (< cursor (- (length choices) 1))
+         (bcom (^list bcom choices (1+ cursor)))))
+      (($ <keypress> (or 'return 'space))
+       (<- (list-ref choices cursor) 'toggle))
+      (else #f)))
+   ;; View primitives:
+   ;; - h-box  : horizontal flexbox
+   ;; - v-box  : vertical flexbox
+   ;; - append : directly append primitive text
+   ;; - b-list : bulleted list
+   ;; - n-list : numbered list
+   ;; - define-primitive  : Takes an a-list of driver names ('html 'term 'gtk, etc?)
+   ;; to templates for the DOM of said driver.
+   ;;   Example:
+   ;;     (define (h-box . items)
+   ;;         `((html
+   ;;             (div (@ (class "praline-flex"))
+   ;;              ,(map (λ (x)
+   ;;                 `(div (@ (class "praline-h-box")) ,x))
+   ;;                 items)))
+   ;;           (guart
+   ;;             (happend @,items))))
+
+   ((view)
+    (h-box
+     "What should we buy at the market?"
+     (b-list
+      (map
+       (λ (choice)
+         (append
+          (if (= i cursor) ">" " ")
+          choice))
+       choices))
+     "Press q to quit"
+     #:padding 1))))))
+
+(define (make-initial-list)
+  (spawn ^list
+   (list
+    (spawn ^list-item "Buy carrots")
+    (spawn ^list-item "Buy celery")
+    (spawn ^list-item "Buy kohlrabi"))))
+
+(with-vat
+ vat
+ (define cup (make-cup (make-initial-list)))
+ ;; Program spawning:
+ ;; - Converts terminal to raw mode
+ ;; - Creates and hooks up IO actor
+ ;;   - Update loop does an update and render
+ ;; - Creates condition to keep app running
+ ;; - Cleans up on receiving 'quit
+ ($ cup 'run))