diff options
Diffstat (limited to 'src/story/story.fnl')
-rw-r--r-- | src/story/story.fnl | 58 |
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 + } |