summaryrefslogtreecommitdiff
path: root/src/story/story.fnl
diff options
context:
space:
mode:
Diffstat (limited to 'src/story/story.fnl')
-rw-r--r--src/story/story.fnl58
1 files changed, 58 insertions, 0 deletions
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
+ }