From b575f8da0a66aa93c37fe8075af484487b8e80c1 Mon Sep 17 00:00:00 2001
From: Nat Quayle Nelson <natquaylenelson@gmail.com>
Date: Sat, 3 Oct 2020 18:23:12 -0600
Subject: [PATCH] rudimentary choices with stack overflow problems

---
 src/hank/Demo.hx            |  2 +-
 src/hank/Story.hx           |  1 +
 src/hank/hanklib.hiss       | 52 +++++++++++++++++++++++++++++++------
 src/hank/reader-macros.hiss | 37 +++++++++++++++++++++-----
 4 files changed, 76 insertions(+), 16 deletions(-)

diff --git a/src/hank/Demo.hx b/src/hank/Demo.hx
index ed8a3d9..ef22e42 100644
--- a/src/hank/Demo.hx
+++ b/src/hank/Demo.hx
@@ -24,7 +24,7 @@ class Demo implements StoryTeller {
         finished(0);
     }
 
-    public function handleChoices(choices: Array<String>, choose: (Dynamic) -> Void) {
+    public function handleChoices(choices: Array<String>, choose: (Int) -> Void) {
         var idx = 1;
         for (choice in choices) {
             Sys.println('${idx++}. ${choice}');
diff --git a/src/hank/Story.hx b/src/hank/Story.hx
index 60319fa..f07be61 100644
--- a/src/hank/Story.hx
+++ b/src/hank/Story.hx
@@ -4,6 +4,7 @@ import hiss.HTypes;
 import hiss.CCInterp;
 import hiss.StaticFiles;
 import hiss.HissReader;
+import hiss.HStream;
 using hiss.HissTools;
 
 class Story {
diff --git a/src/hank/hanklib.hiss b/src/hank/hanklib.hiss
index c4aec7f..3af47b4 100644
--- a/src/hank/hanklib.hiss
+++ b/src/hank/hanklib.hiss
@@ -1,16 +1,30 @@
-(defun output (&rest parts)
-    (call/cc 
-        (lambda (cc) 
-            (*handle-output*
+(defun output (direct &rest parts)
+    "Evaluate the text of this output, and either send it directly
+    to the StoryTeller's callback, or return the result"
+    (let (text 
                 (apply + 
-                    (map parts eval-output-part))
-                cc))))
+                    (map parts eval-output-part)))
+        (if direct
+                (call/cc 
+                    (lambda (cc) 
+                        (*handle-output*
+                            text
+                            cc)))
+            text)))
 
+// TODO eval-output-part needs to access direct, and if direct, choose what comes after the bracket part. Else choose the bracket part
 (defun eval-output-part (part)
     (cond
         ((string? part) part)))
 
-(defstruct choice once-only depth label condition output chosen-count on-chosen)
+(defstruct choice
+    once-only
+    depth
+    label
+    condition
+    output
+    chosen-count
+    on-chosen)
 (defvar *choices* [])
 (defvar *labeled-choices* (dict))
 (defmacro defchoice (&rest args)
@@ -23,4 +37,26 @@
         (when label (dict-set! *labeled-choices* label c))
         id))
 
-(defvar *choice-points* [])
\ No newline at end of file
+(defun get-player-choice-index (choice-texts)
+    (call/cc
+        (lambda (cc)
+                (*handle-choices* choice-texts cc))))
+
+(defun choice-point (choice-ids on-gather)
+    (let (choices // not to be confused with the global list
+                (map choice-ids (bind nth *choices*))
+            // TODO filter by conditions and chosen counts
+            choice-outputs 
+                (map choices choice-output)
+            choice-texts
+                (for o choice-outputs (eval o)))
+
+        (enable-continuations)
+        (begin
+            (setlocal player-choice-index (print (get-player-choice-index choice-texts)))
+            (disable-continuations)
+            (let (player-choice
+                        (nth choices player-choice-index))
+                (choice-set-chosen-count! player-choice (+ 1 (choice-chosen-count player-choice)))
+                (eval `(output t ,@(slice (choice-output player-choice) 2)))
+                (eval (choice-on-chosen player-choice))))))
\ No newline at end of file
diff --git a/src/hank/reader-macros.hiss b/src/hank/reader-macros.hiss
index d994fac..a18034d 100644
--- a/src/hank/reader-macros.hiss
+++ b/src/hank/reader-macros.hiss
@@ -41,22 +41,45 @@
                         (hiss-read "" (HStream:from-string (trim (substring (first (HStream:take-until stream ["}"])) 1)))))
                     (default t))
             output
-                (read-output "" stream)
+                (read-output "" stream t)
             on-chosen
                 `(begin 
-                    ,@(read-all (first (HStream:take-until stream [(* depth "*") (* depth "+") (+ (* depth "-") " ")] nil nil t)))))
+                    ,@(read-all 
+                        (first 
+                            (HStream:take-until 
+                                stream 
+                                (cons "=" // stop reading choice point at knot or stitch 
+                                    (for delim 
+                                        [
+                                            (* depth "*") 
+                                            (* depth "+")
+                                            (* depth "-")
+                                        ] 
+                                        (+ delim " ")))
+                                nil nil t))))) // don't drop the terminator
         (defchoice once-only depth label condition output 0 on-chosen)))
 
 
 (defun read-choice-point (start stream)
-    // TODO
-    (read-choice start stream))
-            
+    (let (first-choice
+                    (read-choice start stream)
+            choices
+                [first-choice])
+        (while (contains ["*" "+"] (HStream:peek stream 1))
+            (push! choices (read-choice nil stream)))
+        `(choice-point 
+            ',choices
+            ,(case (HStream:peek stream 1)
+                ("-" nil))))) // TODO decide how much to include in the on-gather */
 
 (set-macro-string "*" read-choice-point)
 (set-macro-string "+" read-choice-point)
 
-(defun read-output (start stream)
-    `(output ,(HStream:take-line stream "rl")))
+(defun read-output (start stream &optional choice)
+    `(output ,(not choice) ,(HStream:take-line stream "rl")))
+    // TODO read the conditional part of choices, 
+    // TODO expression insertions, 
+    // TODO inline diverts
+    // TODO sequences/shuffles
 
 (set-default-read-function read-output)
\ No newline at end of file