[Source](http://eliterature.org/images/microtalespin.txt "Permalink to ")
;***************************************************************** ; MICRO-TALESPIN: A STORY GENERATOR ; ; A reconstruction, in Common Lisp, of James Meehan's program in ; _Inside_Computer_Understanding:_Five_Programs_Plus_Miniatures_ ; Roger Schank and Christopher Riesbeck (eds.) ; ; Warren Sack ; MIT Media Lab ; 20 Ames Street, E15-320F ; Cambridge MA 02139 ; wsack@media.mit.edu ; ; October 1992 ; ; I translated Micro-Talespin into Common Lisp as a ; "literature review exercise": I wanted to see and play ; with storyteller systems that had been written in the past. ; I was working on creating storyteller systems which ; produce not only text (as Micro-Talespin does) but also ; audio and video. If you are working on a similar project ; I'd love to hear from you. I can be reached at the ; above address. ; ;***************************************************************** ; Usage: Start up Common Lisp and load in this file. Then, at the Lisp ; prompt "?" type (micro-talespin-demo *story1*) in order to see Talespin ; generate a story using story kernel 1. ; Standard definition of put. (defmacro put (x y z) `(setf (get ,x ,y) ,z)) ; Definitions necessary for pattern variables. (defstruct (pcvar (:print-function print-pcvar)) id) (defun print-pcvar (var stream depth) (declare (ignore depth)) (format stream "?~s" (pcvar-id var))) (set-macro-character #? #'(lambda (stream char) (declare (ignore char)) (make-pcvar :id (read stream t nil t))) t) ; Definition of Globals (defvar *personae*) (defvar *goals*) (defvar *all-locations*) (defvar *all-objects*) ; This is the initial data base. It can be extended before ; running a story. (defvar *init-facts*) ; Initial Facts ; The world thinks that Joe is in the cave. ; Joe thinks that he is in the cave. ; The world thinks that Irving is in the oak tree. ; Irving thinks that he is in the oak tree. ; Joe thinks that Irving is in the oak tree. ; The world thinks that there is water in the river. ; Joe thinks that there is water in the river. ; The world thinks that there is honey in the elm tree. ; Irving thinks that there is honey in the elm tree. ; The world thinks that there is a worm in the ground. ; Joe thinks that there is a worm in the ground. ; Irving thinks that Joe is in the cave. ; The world thinks that there are fish in the river. ; Irving thinks that there are fish in the river. (defun init-facts () (setf *init-facts* '((world (loc (actor joe) (val cave))) (joe (loc (actor joe) (val cave))) (world (loc (actor irving) (val oak-tree))) (irving (loc (actor irving) (val oak-tree))) (joe (loc (actor irving) (val oak-tree))) (world (loc (actor water) (val river))) (joe (loc (actor water) (val river))) (world (loc (actor honey) (val elm-tree))) (irving (loc (actor honey) (val elm-tree))) (world (loc (actor worm) (val ground))) (joe (loc (actor worm) (val ground))) (irving (loc (actor joe) (val cave))) (world (loc (actor fish) (val river))) (irving (loc (actor fish) (val river)))))) ; init-world sets up a bunch of facts such as Joe is a bear, birds ; eat worms, and so on. The variable *init-facts* contains location ; and relationship facts, along with which character knows them. ; ; More Initial Facts ; Joe is a bear. ; Joes home is the cave. ; Irving is a bird. ; Irvings home is a tree. ; Bears eat honey, berries, and fish. ; Birds eat worms. ; Joe and Irving are personae (in the theatrical sense). ; Hunger and thirst are possible goals. ; The cave, the oak tree, the elm tree, the ground, and the river are ; all locations. ; All locations are also objects. ; Honey, berries, fish, worms, and water are also objects. (defun init-world () (put 'joe 'is-a 'bear) (put 'joe 'home 'cave) (put 'irving 'is-a 'bird) (put 'irving 'home 'tree) (put 'bear 'food '(honey berries fish)) (put 'bird 'food '(worm)) (setf *personae* '(joe irving)) (setf *goals* '(hungry thirsty)) (setf *all-locations* '(cave oak-tree elm-tree ground river)) (setf *all-objects* (append *all-locations* '(honey berries fish worm water))) (mapc #'(lambda (persona) (put persona 'facts nil) (put persona 'goals nil) (put perso
