#!/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)
syntax highlighting with newLISP and syntax.cgi