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