;;; madlibs.scm ;;; Freely add appropriate items to these lists (define person '("he" "she" "it" "Maria" "Mr. Rogers" "President Bush" "Madonna" "Professor Snapp" "Bono" "God" "Dr. Scheme" "Man" "William Shakespeare" "George Washington" "Tom Jones" "Alice" "Bob" "Dante" "Bart Simpson" "Superman" "Santa Claus" "Barbie" "Peter Pan" "Alan Turing")) (define action-verb '("runs" "plays" "eats" "drinks" "hits" "kicks" "jumps" "speaks" "flies" "drives" "kisses" "burps" "writes" "adopts" "teaches" "learns" "paints" "sings" "composes" "performs" "solves" "enters" "prepares" "instructs" "leads" "leaves" "reads" "sleeps" "follows" "crawls" "tires" "angers" "leans" "falls" "swims" "sneezes" "laughs" "shocks" "pinches" "eyes" "rolls" "stumbles" "waddles" "faces")) (define noun '("banana" "baseball" "computer" "calendar" "dormatory" "book" "television" "tray" "mouse" "cat" "face" "dog" "zebra" "car" "train" "truck" "storm" "snow" "waterfall" "stone" "snake" "universe" "computer program" "caterpillar" "ant" "anteater" "bumblebee" "wasp" "spider" "lizard" "music" "piano" "puzzle" "card" "problem" "equation" "bed" "noon" "evening" "morning" "ray" "darkness" "classroom" "university" "holiday" "shark" "puck" "eye" "nose" "Vermonter" "conductor" "cup" "plate" "spoon" "violin" "elephant" "poison" "mountain" "ocean" "valley" "mansion" "lake" "fly" "robin" "bullet" "wall" "chessboard")) (define adjective '("red" "hot" "boring" "sleepy" "hungry" "ferocious" "stupid" "smart" "orange" "yellow" "purple" "green" "cold" "high" "low" "good" "right" "wrong" "special" "fast" "slow" "striped" "tinted" "solid" "vacuous" "empty" "full" "white" "black" "first" "sacred" "last" "crooked" "pink" "gray")) (define adjective-modifier '("very" "moderately" "barely" "nearly" "almost" "exceedingly" "deeply" "unusually" "permanently" "uniquely" "lovely" "deliciously")) (define adverb '("well" "quickly" "slowly" "rightly" "wrongly" "hopefully" "deliberately" "thoroughly" "lightly" "thoughtfully" "overtly" "passionately" "forgetfully" "early" "never" "secretly" "regretfully" "sincerely" "clearly")) (define preposition '("with" "over" "under" "through" "above" "below" "across" "on" "off" "to" "from" "in" "without" "up" "down" "by" "past" "before" "after" "about")) (define stop '("." "." "." "." "." "!")) (define article '("the" "this" "one" "each" "every" "that")) (define conjunction '("while" "however" "as" "when" "if" "whereas" "since" "because")) ;; (define query '("why" "what" "when" "how")) ;;; Don't modify anything below this line unless you really know what you are doing. ;;; Syntactic sugar: (define (get-adjective) (get-random-item adjective)) (define (get-adjective-modifier) (get-random-item adjective-modifier)) (define (get-adverb) (get-random-item adverb)) (define (get-article) (get-random-item article)) (define (get-conjunction) (get-random-item conjunction)) (define (get-preposition) (get-random-item preposition)) (define (get-stop) (get-random-item stop)) (define (get-verb) (get-random-item action-verb)) (define (get-noun) (get-random-item noun)) (define (get-person) (get-random-item person)) (define (get-query) (get-random-item query)) ;;; capitalize-string accepts a single string argument, and converts the first character to upper-case. (define (capitalize-string s) (string-append (make-string 1 (char-upcase (string-ref s 0))) (substring s 1 (string-length s)))) ;;; Constructs a subject of a sentence at random. (define (get-subject) (cond ((zero? (random 4)) (get-person)) ((zero? (random 3)) (string-append (get-article) " " (get-noun))) ((zero? (random 2)) (string-append (get-article) " " (get-adjective) " " (get-noun))) (else (string-append (get-article) " " (get-adjective-modifier) " " (get-adjective) " " (get-noun))))) ;;; Constructs the predicate of a sentence, at random. (define (get-predicate) (cond ((zero? (random 5)) (string-append (get-adverb) " " (get-verb))) ((zero? (random 4)) (string-append (get-verb))) ((zero? (random 3)) (string-append (get-verb) " " (get-adverb))) ((zero? (random 2)) (string-append (get-verb) " " (get-preposition) " " (get-article) " " (get-noun))) (else (string-append (get-verb) " " (get-adverb) " " (get-preposition) " " (get-article) " " (get-adjective-modifier) " " (get-adjective) " " (get-noun))))) (define (get-sentence) (cond ((zero? (random 20)) (string-append (get-conjunction) " " (get-subject) " " (get-predicate) ", " (get-subject) " " (get-predicate) (get-stop))) ((zero? (random 19)) (string-append (get-subject) " " (get-predicate) ", " (get-conjunction) " " (get-subject) " " (get-predicate) (get-stop))) ; ((zero? (random 10)) (string-append (get-query) " " (get-subject) " " (get-predicate) "?")) ((zero? (random 9)) (string-append "Who " (get-predicate) "?")) (else (string-append (get-subject) " " (get-predicate) (get-stop))))) (define (get-finished-sentence) (capitalize-string (get-sentence))) ;;; get-random-item selects one item at random from the first argument, which ;;; must be a list. (define (get-random-item lst) (list-ref lst (random (length lst)))) ;;; madlibs generates n random sentences. (define (madlibs n) (do ((i 0 (+ i 1))) ((= i n)) (display (get-finished-sentence)) (newline))) (madlibs 100)