First commit: working functional menus

1 files changed, 57 insertions, 0 deletions

diff --git a/depre/main.scm b/depre/main.scm
new file mode 100644
index 0000000..37a3b35
--- /dev/null
+++ b/depre/main.scm
@@ -0,0 +1,57 @@
+; https://xn--rpa.cc/irl/term.html
+(define-module (depre main))
+
+(define %depression 50)
+(define %tiredness  50)
+
+(define (nth n lst)
+  (if (> n (length lst))
+    (error "Chosen element longer than provided list")
+    (let loop ((lst lst)
+               (n n))
+    (if (= 1 n)
+      (car lst)
+      (loop (cdr lst) (- n 1))))))
+
+(define (combine . functions)
+  "Calls given functions in given order."
+  (lambda ()
+    (let loop ((fs functions))
+      (when (not (null? fs))
+        ((car fs))
+        (loop (cdr fs))))))
+
+(define (answer message)
+  (lambda ()
+    (display message)
+    (newline)))
+
+(define (state heading menu)
+  (lambda ()
+    (newline)
+    (display heading)
+    (newline)
+    (map (lambda (opt num)
+           (display (string-append "  " (number->string num) "- " (car opt)))
+           (newline))
+         menu (iota (length menu) 1))
+    (display "You choose >  ")
+    (let loop ((chosen (read)))
+      (if (and (number? chosen) (<= chosen (length menu)))
+        ((cdr (nth chosen menu)))
+        (begin
+          (display "Wrong answer. Try again >  ")
+          (loop (read)))))))
+
+(define start
+  (state "Hi, game starts"
+         (list (cons "Start game"
+                     (combine
+                       (answer "Let's start, then.")
+                       (state "heading"
+                              (list (cons "hola"  (lambda () (display "HOLA")))
+                                    (cons "adios" (lambda () (display "adios")))))))
+               (cons "Quit game"
+                     (answer "Good bye!")))))
+
+(start)