DZone Snippets is a public source code repository. Easily build up your personal collection of code snippets, categorize them with tags / keywords, and share them with the world

Snippets has posted 5883 posts at DZone. View Full User Profile

Haiku Generator In NewLISP

09.11.2006
| 2862 views |
  • submit to reddit
        ; 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 

#!/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)