Haiku generator in newLISP
; 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
1 2 #!/usr/bin/newlisp 3 4 (print "Content-type: text/html\n\n") 5 6 (print "<html><head><title>Random Haiku</title>") 7 (print "</HEAD>") 8 (print "<BODY>") 9 (print "<br><br><br><br><br><table border=0 cellpadding=0 cellspacing=0 width=600><tr><td><br>") 10 11 (println {<font face='verdana' size="2">}) 12 (print "<blockquote><p><p>RANDOM HAIKU<p></p><p></p>") 13 14 (seed (time-of-day)) 15 16 (set 'adjs '( "autumn" "hidden" "bitter" "misty" "silent" 17 "empty" "dry" "dark" "summer" "icy" 18 "delicate" "quiet" "white" "cool" "spring" 19 "winter" "patient" "twilight" "dawn" "crimson" 20 "wispy" "weathered" "blue" "billowing" "broken" 21 "cold" "damp" "falling" "frosty" "green" 22 "long" "late" "lingering" "bold" "little" 23 "morning" "muddy" "old" "red" "rough" 24 "still" "small" "sparkling" "throbbing" "shy" 25 "wandering" "withered" "wild" "black" "young" 26 "holy" "solitary" "fragrant" "aged" "snowy" 27 "proud" "floral" "restless" "divine" "polished" 28 "ancient" "purple" "lively" "nameless" )) 29 30 (set 'nouns '( "waterfall" "river" "breeze" "moon" "rain" 31 "wind" "sea" "morning" "snow" "lake" 32 "sunset" "pine" "shadow" "leaf" "dawn" 33 "glitter" "forest" "hill" "cloud" "meadow" 34 "sun" "glade" "bird" "brook" "butterfly" 35 "bush" "dew" "dust" "field" "fire" 36 "flower" "firefly" "feather" "grass" "haze" 37 "mountain" "night" "pond" "darkness" "snowflake" 38 "silence" "sound" "sky" "shape" "surf" 39 "thunder" "violet" "water" "wildflower" "wave" 40 "water" "resonance" "sun" "wood" "dream" 41 "cherry" "tree" "fog" "frost" "voice" 42 "paper" "frog" "smoke" "star")) 43 44 (set 'verbs '( "shakes" "drifts" "has stopped" "struggles" "hears" 45 "has passed" "sleeps" "creeps" "flutters" "fades" 46 "is falling" "trickles" "murmurs" "warms" "hides" 47 "jumps" "is dreaming" "sleeps" "falls" "wanders" 48 "waits" "has risen" "stands" "dying" "is drawing" 49 "singing" "rises" "paints" "capturing" "flying" 50 "lies" "picked up" "gathers in" "invites" "separates" 51 "eats" "plants" "digs into" "has fallen" "weeping" 52 "facing" "mourns" "tastes" "breaking" "shaking" 53 "walks" "builds" "reveals" "piercing" "craves" 54 "departing" "opens" "falling" "confronts" "keeps" 55 "breaking" "is floating" "settles" "reaches" "illuminates" 56 "closes" "leaves" "explodes" "drawing")) 57 58 (set 'preps '( "on" "beside" "in" "beneath" "of" "above" "under" "by" 59 "over" "against" "near" )) 60 61 62 (define (get-word word-list) 63 (set 'word-list-size (length word-list)) 64 (set 'word-list-index (rand word-list-size)) 65 (set 'selected-word (nth word-list-index word-list)) 66 (print " " selected-word " " )) 67 68 (define (get-adjective) 69 (get-word adjs)) 70 71 (define (get-noun) 72 (get-word nouns)) 73 74 (define (get-verb) 75 (get-word verbs)) 76 77 (define (get-prep) 78 (get-word preps)) 79 80 (define (style-one) 81 (get-adjective) 82 (get-noun) 83 (print "<br>\n") 84 (get-noun) 85 (get-verb) 86 (get-prep) 87 (get-noun) 88 (print "<br>\n") 89 (get-adjective) 90 (get-adjective) 91 (get-noun) 92 (print "<br>\n")) 93 94 (define (style-two) 95 (get-adjective) 96 (get-noun) 97 (get-verb) 98 (print "<br>\n") 99 (get-adjective) 100 (get-adjective) 101 (get-noun) 102 (print "<br>\n") 103 (get-verb) 104 (get-adjective) 105 (get-noun) 106 (print "<br>\n")) 107 108 (define (style-three) 109 (get-adjective) 110 (get-adjective) 111 (get-noun) 112 (print "<br>\n") 113 (get-prep) 114 (get-adjective) 115 (get-noun) 116 (print "<br>\n") 117 (get-noun) 118 (get-verb) 119 (print "<br>\n")) 120 121 (define (style-four) 122 (get-noun) 123 (get-prep) 124 (get-noun) 125 (print "<br>\n") 126 (get-adjective) 127 (get-noun) 128 (get-prep) 129 (get-noun) 130 (print "<br>\n") 131 (get-adjective) 132 (get-noun) 133 (print "<br>\n")) 134 135 (define (print-haiku) 136 (set 'which (rand 4)) 137 (if (= which 0) 138 (style-one)) 139 (if (= which 1) 140 (style-two)) 141 (if (= which 2) 142 (style-three)) 143 (if (= which 3) 144 (style-four))) 145 146 (print-haiku) 147 148 (print "<p></p>") 149 (print "<font size=1>") 150 (println {<p>You can click <a href="haiku.cgi">HERE</a> to see a new poem.}) 151 (print "<p> Haiku generated in the style of Matsuo Basho, the Japanese poet of the 17th century.<br> 152 This haiku program originally written in pygmy <b>FORTH</b> by Kent Peterson.<br>Translated into <b>lisp</b>.") 153 (print "</blockquote> </table> </font> </body>\n</html>\n") 154 155 (exit) 156 157 158
