'
' Small HAIKU program, based on the FORTH version from Kent Peterson.
'
' Translated to BaCon by PvE in February 2011 - GPL.
'
'-------------------------------------------------------------------------------------------------------------------------------------

' Define runtime check for size of array
DEF FN bound(x) = SIZEOF(x)/SIZEOF(STRING)

DECLARE adj$[] = { "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" }

DECLARE noun$[] = { "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" }

DECLARE verb$[] = { "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" }

DECLARE prep$[] = { "on", "beside", "in", "beneath", "of", "above", "under", "by", "over", "against", "near" }

SUB Style_One

    PRINT NL$, " ", adj$[RANDOM(bound(adj$))], " ", noun$[RANDOM(bound(noun$))]
    PRINT " ", noun$[RANDOM(bound(noun$))], " ", verb$[RANDOM(bound(verb$))], " ", prep$[RANDOM(bound(prep$))], " ", noun$[RANDOM(bound(noun$))]
    PRINT " ", adj$[RANDOM(bound(adj$))], " ", adj$[RANDOM(bound(adj$))], " ", noun$[RANDOM(bound(noun$))]

END SUB

SUB Style_Two

    PRINT NL$, " ", adj$[RANDOM(bound(adj$))], " ", noun$[RANDOM(bound(noun$))], " ", verb$[RANDOM(bound(verb$))]
    PRINT " ", adj$[RANDOM(bound(adj$))], " ", adj$[RANDOM(bound(adj$))], " ", noun$[RANDOM(bound(noun$))]
    PRINT " ", verb$[RANDOM(bound(verb$))], " ", adj$[RANDOM(bound(adj$))], " ", noun$[RANDOM(bound(noun$))]

END SUB

SUB Style_Three

    PRINT NL$, " ", adj$[RANDOM(bound(adj$))], " ", adj$[RANDOM(bound(adj$))], " ", noun$[RANDOM(bound(noun$))]
    PRINT " ", prep$[RANDOM(bound(prep$))], " ", adj$[RANDOM(bound(adj$))], " ", noun$[RANDOM(bound(noun$))]
    PRINT " ", noun$[RANDOM(bound(noun$))], " ", verb$[RANDOM(bound(verb$))]

END SUB

SUB Style_Four

    PRINT NL$, " ", noun$[RANDOM(bound(noun$))], " ", prep$[RANDOM(bound(prep$))], " ", noun$[RANDOM(bound(noun$))]
    PRINT " ", adj$[RANDOM(bound(adj$))], " ", noun$[RANDOM(bound(noun$))], " ", prep$[RANDOM(bound(prep$))], " ", noun$[RANDOM(bound(noun$))]
    PRINT " ", adj$[RANDOM(bound(adj$))], " ", noun$[RANDOM(bound(noun$))]

END SUB

which = RANDOM(4)

SELECT which
    CASE 0
        Style_One
    CASE 1
        Style_Two
    CASE 2
        Style_Three
    CASE 3
        Style_Four
END SELECT

PRINT NL$, "Haiku generated in the style of Matsuo Basho, the Japanese poet of the 17th century."
PRINT "This haiku program originally written in pygmy FORTH by Kent Peterson.", NL$