From c772cdd43a8cef0f6a8e9e32b86d55df474ec240 Mon Sep 17 00:00:00 2001
From: David Florness <david@florness.com>
Date: Sun, 8 Mar 2020 13:38:09 -0600
Subject: [PATCH] Very primitive ballot TUI

---
 ballot-tui.rkt | 57 ++++++++++++++++++++++++++++++++++++++++++++++++++
 info.rkt       |  3 ++-
 2 files changed, 59 insertions(+), 1 deletion(-)
 create mode 100644 ballot-tui.rkt

diff --git a/ballot-tui.rkt b/ballot-tui.rkt
new file mode 100644
index 0000000..c24256e
--- /dev/null
+++ b/ballot-tui.rkt
@@ -0,0 +1,57 @@
+#lang racket/base
+
+(require charterm)
+
+(define (get-vote candidates)
+  (let ([n (length candidates)]
+        [prefs (make-hash (for/list ([cand candidates])
+                            (cons cand #f)))]
+        [data-line 2])
+    (with-charterm
+      (charterm-clear-screen)
+      (for ([i (in-naturals data-line)]
+            [cand candidates])
+        (charterm-cursor 2 i)
+        (charterm-display "[ ] ")
+        (charterm-display cand))
+      (charterm-cursor 2 (+ 1 n data-line))
+      (charterm-display "[Submit]")
+      (let loop-fast-next-key ([cursor-line 0])
+        (if (>= cursor-line n)
+            (begin
+              (charterm-cursor 2 (+ 1 n data-line))
+              (charterm-display "[")
+              (charterm-inverse)
+              (charterm-display "Submit]")
+              (charterm-normal)
+              (charterm-cursor 2 (+ 1 n data-line)))
+            (charterm-cursor 3 (+ data-line cursor-line)))
+        (let ([keyinfo (charterm-read-keyinfo #:timeout 1)])
+          (if keyinfo
+              (let* ([keycode (charterm-keyinfo-keycode keyinfo)]
+                     [keynum  (if (char? keycode)
+                                  (char->integer keycode)
+                                  #f)])
+                (if (and keynum (<= 49 keynum 57))
+                    (let ([val (- keynum 49)])
+                      (when (< cursor-line n)
+                        (hash-set! prefs (list-ref candidates cursor-line) val)
+                        (charterm-display (bytes keynum)))
+                      (loop-fast-next-key cursor-line))
+                    (case keycode
+                      [(return)
+                       (if (>= cursor-line n)
+                           prefs
+                           (loop-fast-next-key cursor-line))]
+                      [(ctrl-c)
+                       (raise exn:break)]
+                      [(down #\j)
+                       (loop-fast-next-key (min n (add1 cursor-line)))]
+                      [(up #\k)
+                       (when (>= cursor-line n)
+                         (charterm-cursor 2 (+ 1 n data-line))
+                         (charterm-display "[Submit]"))
+                       (loop-fast-next-key (max 0 (sub1 cursor-line)))]
+                      [else
+                       (loop-fast-next-key cursor-line)])))
+              (loop-fast-next-key cursor-line)))))))
diff --git a/info.rkt b/info.rkt
index 7c46fbd..a0e23ba 100644
--- a/info.rkt
+++ b/info.rkt
@@ -1,6 +1,7 @@
 #lang info
 (define collection "tallyard")
-(define deps '("base" "crypto" "sha" "simple-http" "sugar" "get-pass"))
+(define deps '("base" "charterm" "crypto" "get-pass"
+                      "sha" "simple-http" "sugar"))
 (define build-deps '("scribble-lib" "racket-doc" "rackunit-lib"))
 (define scribblings '(("scribblings/tallyard.scrbl" ())))
 (define pkg-desc "Description Here")
-- 
2.38.4