diff --git a/configure.ac b/configure.ac index f97f924..b8beeed 100644 --- a/configure.ac +++ b/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" diff --git a/guix.scm b/guix.scm index 6f76d86..1ef33e9 100644 --- a/guix.scm +++ b/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.") diff --git a/scripts/examples/select-list.in b/scripts/examples/select-list.in index 505f65a..7351f77 100644 --- a/scripts/examples/select-list.in +++ b/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 - (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 - (($ (or 'ctrl-c 'q)) - (<-np parent 'quit)) - (($ (or 'up 'k)) - (<-np m (set-model-cursor m (- cursor 1)))) - (($ (or 'down 'j)) - (<-np m (set-model-cursor m (1+ cursor)))) - (($ (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?))