; newLISP CGI code to generate a random Haiku
; in the style of Matsuo Basho, Japanese poet of the 17th century.
; fashioned after an old FORTH program
; in the style of Matsuo Basho, Japanese poet of the 17th century.
; fashioned after an old FORTH program
#!/usr/bin/newlisp (print "Content-type: text/html\n\n") (print "<html><head><title>Random Haiku</title>") (print "</HEAD>") (print "<BODY>") (print "<br><br><br><br><br><table border=0 cellpadding=0 cellspacing=0 width=600><tr><td><br>") (println {<font face='verdana' size="2">}) (print "<blockquote><p><p>RANDOM HAIKU<p></p><p></p>") (seed (time-of-day)) (set 'adjs '( "autumn" "hidden" "bitter" "misty" "silent" "empty" "dry" "dark" "summer" "icy" "delicate" "quiet" "white" "cool" "spring" "winter" "patient" "twilight" "dawn" "crimson" "wispy" "weathered" "blue" "billowing" "broken" "cold" "damp" "falling" "frosty" "green" "long" "late" "lingering" "bold" "little" "morning" "muddy" "old" "red" "rough" "still" "small" "sparkling" "throbbing" "shy" "wandering" "withered" "wild" "black" "young" "holy" "solitary" "fragrant" "aged" "snowy" "proud" "floral" "restless" "divine" "polished" "ancient" "purple" "lively" "nameless" )) (set 'nouns '( "waterfall" "river" "breeze" "moon" "rain" "wind" "sea" "morning" "snow" "lake" "sunset" "pine" "shadow" "leaf" "dawn" "glitter" "forest" "hill" "cloud" "meadow" "sun" "glade" "bird" "brook" "butterfly" "bush" "dew" "dust" "field" "fire" "flower" "firefly" "feather" "grass" "haze" "mountain" "night" "pond" "darkness" "snowflake" "silence" "sound" "sky" "shape" "surf" "thunder" "violet" "water" "wildflower" "wave" "water" "resonance" "sun" "wood" "dream" "cherry" "tree" "fog" "frost" "voice" "paper" "frog" "smoke" "star")) (set 'verbs '( "shakes" "drifts" "has stopped" "struggles" "hears" "has passed" "sleeps" "creeps" "flutters" "fades" "is falling" "trickles" "murmurs" "warms" "hides" "jumps" "is dreaming" "sleeps" "falls" "wanders" "waits" "has risen" "stands" "dying" "is drawing" "singing" "rises" "paints" "capturing" "flying" "lies" "picked up" "gathers in" "invites" "separates" "eats" "plants" "digs into" "has fallen" "weeping" "facing" "mourns" "tastes" "breaking" "shaking" "walks" "builds" "reveals" "piercing" "craves" "departing" "opens" "falling" "confronts" "keeps" "breaking" "is floating" "settles" "reaches" "illuminates" "closes" "leaves" "explodes" "drawing")) (set 'preps '( "on" "beside" "in" "beneath" "of" "above" "under" "by" "over" "against" "near" )) (define (get-word word-list) (set 'word-list-size (length word-list)) (set 'word-list-index (rand word-list-size)) (set 'selected-word (nth word-list-index word-list)) (print " " selected-word " " )) (define (get-adjective) (get-word adjs)) (define (get-noun) (get-word nouns)) (define (get-verb) (get-word verbs)) (define (get-prep) (get-word preps)) (define (style-one) (get-adjective) (get-noun) (print "<br>\n") (get-noun) (get-verb) (get-prep) (get-noun) (print "<br>\n") (get-adjective) (get-adjective) (get-noun) (print "<br>\n")) (define (style-two) (get-adjective) (get-noun) (get-verb) (print "<br>\n") (get-adjective) (get-adjective) (get-noun) (print "<br>\n") (get-verb) (get-adjective) (get-noun) (print "<br>\n")) (define (style-three) (get-adjective) (get-adjective) (get-noun) (print "<br>\n") (get-prep) (get-adjective) (get-noun) (print "<br>\n") (get-noun) (get-verb) (print "<br>\n")) (define (style-four) (get-noun) (get-prep) (get-noun) (print "<br>\n") (get-adjective) (get-noun) (get-prep) (get-noun) (print "<br>\n") (get-adjective) (get-noun) (print "<br>\n")) (define (print-haiku) (set 'which (rand 4)) (if (= which 0) (style-one)) (if (= which 1) (style-two)) (if (= which 2) (style-three)) (if (= which 3) (style-four))) (print-haiku) (print "<p></p>") (print "<font size=1>") (println {<p>You can click <a href="haiku.cgi">HERE</a> to see a new poem.}) (print "<p> Haiku generated in the style of Matsuo Basho, the Japanese poet of the 17th century.<br> This haiku program originally written in pygmy <b>FORTH</b> by Kent Peterson.<br>Translated into <b>lisp</b>.") (print "</blockquote> </table> </font> </body>\n</html>\n") (exit)
