From bf71791fc540a584dd6d88548c91192294d106bc Mon Sep 17 00:00:00 2001
From: dozens
Date: Tue, 25 Jun 2024 21:22:35 -0600
Subject: feat: add story engine

---
 src/story/README.md      | 110 +++++++++++++++++++++++++++++++++++++++++++++++
 src/story/cards.dat      |  46 ++++++++++++++++++++
 src/story/story.dat      |  19 ++++++++
 src/story/story.fnl      |  58 +++++++++++++++++++++++++
 src/story/story.test.dat |  80 ++++++++++++++++++++++++++++++++++
 src/story/story.test.fnl |  16 +++++++
 6 files changed, 329 insertions(+)
 create mode 100644 src/story/README.md
 create mode 100644 src/story/cards.dat
 create mode 100644 src/story/story.dat
 create mode 100644 src/story/story.fnl
 create mode 100644 src/story/story.test.dat
 create mode 100644 src/story/story.test.fnl

(limited to 'src')

diff --git a/src/story/README.md b/src/story/README.md
new file mode 100644
index 0000000..0cb81f4
--- /dev/null
+++ b/src/story/README.md
@@ -0,0 +1,110 @@
+## Format
+
+Here is a list of lists
+representing a slightly augmented
+deck of cards
+(basically the heckadeck):
+
+
+```
+:: suit
+spades
+hearts
+clubs
+diamonds
+acorns
+clouds
+swords
+planets
+
+:: face
+beast
+thief
+jack
+queen
+king
+
+:: number
+zero
+one
+two
+three
+four
+five
+six
+seven
+eight
+nine
+ten
+eleven
+twelve
+
+:: special
+crone
+joker
+watcher
+traveler
+
+:: card
+[[number]]
+[[face]]
+
+:: draw
+[[card]] of [[suit]]
+[[special]]
+```
+
+A list title appears on a line by itself,
+preceded by a double colon (::)
+and at least one space.
+A list title can contain alphabet characters and a dash.
+
+Following the list title are list items,
+each on its own line.
+A list item may be (or contain) a reference
+to a list title in double brackets.
+e.g. [[list-title]]
+
+Blank lines are ignored.
+
+## Usage
+
+Pass the filename of a file of lists formatted in this way
+to `create_corpus`
+and get a "corpus" in return.
+A corpus is just a deserialized fennel table
+of list titles and list items.
+
+Then pass the corpus to `flatten`
+along with a string or a list to serve as the "origin".
+In this case if you pass `corpus.draw`,
+then `flatten` will return a random selection from `:draw`,
+expanding references along the way:
+
+- beast of spades
+- five of hearts
+- jack of acorns
+- watcher
+- three of planets
+- beast of clubs
+ 
+Read and run `story.test.fnl` for an example.
+
+## Inspiration
+
+This is inspired by [tracery][1]
+and [perchance][4]
+and the [List to HTML Generator][5],
+and is similar to [twee][2] format.
+In fact,
+with just a little modification,
+you can use this story file 
+to generate tracery output
+in a twine story
+using [trice][3].
+
+[1]: https://github.com/galaxykate/tracery
+[2]: https://twinery.org/cookbook/terms/terms_twee.html
+[3]: https://github.com/incobalt/Trice
+[4]: https://perchance.org/
+[5]: https://slightadjustments.blogspot.com/p/generator.html
diff --git a/src/story/cards.dat b/src/story/cards.dat
new file mode 100644
index 0000000..12a1a8f
--- /dev/null
+++ b/src/story/cards.dat
@@ -0,0 +1,46 @@
+:: suit
+spades
+hearts
+clubs
+diamonds
+acorns
+clouds
+swords
+planets
+
+:: face
+beast
+thief
+jack
+queen
+king
+
+:: number
+zero
+one
+two
+three
+four
+five
+six
+seven
+eight
+nine
+ten
+eleven
+twelve
+
+:: special
+crone
+joker
+watcher
+traveler
+
+:: card
+[[number]]
+[[face]]
+
+:: draw
+[[card]] of [[suit]]
+[[special]]
+
diff --git a/src/story/story.dat b/src/story/story.dat
new file mode 100644
index 0000000..7c48d1a
--- /dev/null
+++ b/src/story/story.dat
@@ -0,0 +1,19 @@
+:: origin
+[[you]] [[need]] [[go]] [[search]] [[find]] [[take]] [[return]] [[change]]
+
+:: you
+[[beginning]]
+
+:: beginning
+Once upon a time
+I've told you before but I'll tell you again
+Once there was
+One day, a long time ago
+There was and there was not
+East of the sun and west of the moon
+In the beginning
+Back in the day
+I remember when
+On an old day, in the old times
+Back when tigers used to smoke tobacco
+That time then and once again
diff --git a/src/story/story.fnl b/src/story/story.fnl
new file mode 100644
index 0000000..f1ca812
--- /dev/null
+++ b/src/story/story.fnl
@@ -0,0 +1,58 @@
+(fn lines [filename callback]
+  (case (pcall #(with-open [file (io.open filename)] (each [line (file:lines)] (callback line))))
+    (false err) (print (string.format "Error: Could not open file %s\n%s" filename err))))
+
+(fn _create-corpus [lines data]
+  (var current-key nil)
+  (var corpus {})
+  (lines data
+    #(let [key (string.match $1 "^::%s+([%a-]+)")
+           blank (or (= nil $1) (= "" $1))]
+      (when (not blank)
+        (if (not key)
+          (let [list (. corpus current-key)]
+            (table.insert list $1)
+            (tset corpus current-key list))
+          (do
+            (set current-key key)
+            (tset corpus current-key []))))))
+  corpus)
+(local create-corpus (partial _create-corpus lines))
+
+(fn one-of [t]
+  "returns a random element of a sequential or non-sequential table"
+  (let [len (accumulate [l 0 _ _ (pairs t)] (+ l 1)) ;; do it the hard way
+                                                     ;; because nonseq tables
+                                                     ;; have no length?
+        handle (io.popen "echo $RANDOM")
+        output (handle:read "*a")
+        random (output:gsub "[\n\r]" "")
+        seed (math.randomseed random) ;; SIDE EFFECT
+        whatever (handle:close)       ;; SIDE EFFECT
+        idx (math.random len)
+        keys (accumulate [acc [] k v (pairs t)] (do (table.insert acc k) acc))
+        rndkey (. keys idx)
+        it (. t rndkey)]
+    it))
+
+(fn flatten [corpus origin]
+  (let [str (if (= "string" (type origin))
+              origin
+              (if (= "table" (type origin))
+                (one-of origin)
+                (error "Origin must be a table or a string")))
+        template-pattern "%[%[[%a-]+%]%]" ; [[word]]
+        word-pattern "%[%[([%a-]+)%]%]"   ; word
+        (i j) (string.find str template-pattern) ; indices
+        word (string.match str word-pattern)]    ; the actual keyword
+    (if (not i)
+      str
+      (let [next-str (string.format "%s%s%s"
+              (string.sub str 1 (- i 1))
+              (one-of (. corpus word))
+              (string.sub str (+ j 1)))]
+        (flatten corpus next-str j))))) ;; this is a tail call!
+
+{: create-corpus
+ : flatten
+ }
diff --git a/src/story/story.test.dat b/src/story/story.test.dat
new file mode 100644
index 0000000..e28ad44
--- /dev/null
+++ b/src/story/story.test.dat
@@ -0,0 +1,80 @@
+:: start
+To [[do]] in the [[place]] [[preposition]] the [[color]] [[celestial]]
+
+:: do
+[[walk]]
+[[feel]]
+
+:: place
+[[biome]]
+[[weather]] [[biome]]
+[[weather]] [[biome]]
+
+:: feel
+brood
+go to pieces
+wallow
+percolate
+ferment
+pine
+waste away
+ponder
+wonder
+
+:: preposition
+beneath
+amongst
+betwixt
+below
+between
+through
+around
+despite
+
+:: walk
+walk
+stroll
+jaunt
+wander
+meander
+amble
+stalk
+ambulate
+
+:: weather
+blistering
+undulating
+weeping
+mourning
+hidden
+secret
+wistful
+taciturn
+sticky
+
+:: biome
+woods
+dunes
+forest
+plains
+hills
+mountains
+ocean
+bog
+lake
+
+:: color
+chartreuse
+opalescent
+verdant
+vermilion
+aquamarine
+copper
+
+:: celestial
+skies
+moon
+stars
+planets
+clouds
+sun
diff --git a/src/story/story.test.fnl b/src/story/story.test.fnl
new file mode 100644
index 0000000..e4fce4d
--- /dev/null
+++ b/src/story/story.test.fnl
@@ -0,0 +1,16 @@
+(let [{
+  : flatten
+  : create-corpus 
+  } (require :src.story.story)]
+
+  (let [corpus (create-corpus "src/story/story.test.dat")
+        get-story (partial flatten corpus corpus.start)]
+      (print "\n== POEMS ==")
+      (for [_ 1 10] (print (get-story))))
+
+  (let [corpus (create-corpus "src/story/cards.dat")
+        get-story (partial flatten corpus corpus.draw)]
+      (print "\n== CARDS ==")
+      (for [_ 1 10] (print (get-story)))))
+
+
-- 
cgit 1.4.1-2-gfad0