_TITLE "Poem Generator"
'*******************************************************************************
'*** Poem Generator
'*** By George McGinn - May 27, 2021
'***
'***
'*** About the AI system
'***    Since writing poems has specific rules, which can easily break grammar
'***    rules, the AI will impose just the basic grammar syntax, like adding a
'***    "an" when required, and not ending sentences with words such as
'***    "like" which happens now. They will have a special modifier tag as with
'***    the tables in use, one of them can be used to finish the sentence.
'***
'***    However, poems do not follow strict sentence structure either, and like
'***    at the end of a line, since there is no period, it may be a pause where
'***    the first words on the next continues the thought. This will be
'***    built into the modifier tag. It will also check the words ahead of it to
'***    see if they are on the modifier list for the word "like" and others like
'***    it.
'***
'***    So due to the special circumstances on meter and rhyme and even the
'***    structure of the poem, the AI system will rely heavily on rule and word
'***    tables that will provide it the words, apply modifiers, check for any
'***    grammar changes, and will have a way to keep the poem on one theme.
'***
'***    And for this system to work properly, the vocabulary must grow to
'***    proportions where each word has associated tags for use with other words
'***    to help the AI engine to keep the poem on target.
'***
'*******************************************************************************


'SCREEN 12
SCREEN _NEWIMAGE(800, 600, 32)
RANDOMIZE TIMER
OPTION BASE 1
DEFINT A-Z


'***************************************************************
'*** Initialize variables/arrays (comments to prevent confusion)
'***
x = 0 '* Index to poem length (# lines)
i = 0 '* Index to loading Arrays

cr$ = CHR$(10) '* Add a Carriage-Return character

Author$ = "By QB64 Program" '* Name of Programmer running code

DIM article$(35), noun$(60), verb$(46), adjective$(46)
DIM colormodifier$(28), colortable$(8), nounmodifiers$(14)
DIM connectives$(151), conective_extended$(34)


'**************************************************
'*** Load Arrays from Data Statements
'***

GOSUB LoadWordArrays


'**************************************************
'*** Pick a 2- to 3-word title
'***
ta$ = article$(INT(RND * 35) + 1)
b$ = LCASE$(noun$(INT(RND * 60) + 1)) '** Pick a primary noun
b1$ = LCASE$(noun$(INT(RND * 60) + 1)) '** Pick a noun-color modifier
c$ = LCASE$(verb$(INT(RND * 46) + 1)) '** Pick a primary verb
c1$ = LCASE$(verb$(INT(RND * 46) + 1)) '** Pick a verb modifier
d$ = LCASE$(adjective$(INT(RND * 46) + 1)) '** Pick an adjective
bc$ = LCASE$(colormodifier$(INT(RND * 28) + 1)) '** Pick a modifier for a color
color$ = LCASE$(colortable$(INT(RND * 8) + 1)) '** Pick a color as a modifier
nounmod$ = LCASE$(nounmodifiers$(INT(RND * 14) + 1)) '** Pick a non-color noun modifier

IF LEFT$(b$, 1) = "@" OR LEFT$(b1$, 1) = "@" THEN GOSUB CheckForCapitalization
IF RIGHT$(b$, 1) = "*" OR RIGHT$(b$, 1) = "+" THEN GOSUB CheckForModifierAfter
IF LEFT$(b$, 1) = "*" OR LEFT$(b$, 1) = "+" THEN GOSUB CheckForModifierBefore
tb$ = b$

Title$ = ta$ + " " + tb$


'**************************************************
'*** Create the poem, 16 lines in 4 4-line stanzas
'***

PRINT SPACE$(3) + Title$
PRINT SPACE$(3) + Author$
PRINT: PRINT


'*** NOTE: b1 & c1 placeholders for future use as modifiers, or
'***       to initially use b1 & c1 as modifiers themselves.
FOR x = 1 TO 16
    a$ = LCASE$(article$(INT(RND * 35) + 1)) '** Pick an Article
    b$ = LCASE$(noun$(INT(RND * 60) + 1)) '** Pick a primary noun
    b1$ = LCASE$(noun$(INT(RND * 60) + 1)) '** Pick a noun-color modifier
    c$ = LCASE$(verb$(INT(RND * 46) + 1)) '** Pick a primary verb
    c1$ = LCASE$(verb$(INT(RND * 46) + 1)) '** Pick a verb modifier
    d$ = LCASE$(adjective$(INT(RND * 46) + 1)) '** Pick an adjective
    bc$ = LCASE$(colormodifier$(INT(RND * 28) + 1)) '** Pick a modifier for a color
    color$ = LCASE$(colortable$(INT(RND * 8) + 1)) '** Pick a color as a modifier
    nounmod$ = LCASE$(nounmodifiers$(INT(RND * 14) + 1)) '** Pick a non-color noun modifier

    '*** Check for modifiers to nouns
    IF LEFT$(b$, 1) = "@" OR LEFT$(b1$, 1) = "@" OR LEFT$(bc$, 1) = "@" THEN GOSUB CheckForCapitalization
    IF LEFT$(b$, 1) = "*" OR LEFT$(b$, 1) = "+" THEN GOSUB CheckForModifierBefore
    IF RIGHT$(b$, 1) = "*" OR RIGHT$(b$, 1) = "+" THEN GOSUB CheckForModifierAfter

    '*** Capitalize the first word of each sentence or stanza (whether noun or verb)
    r = RND(2) + 1
    IF r = 1 THEN
        z = LEN(a$)
        a$ = UCASE$(LEFT$(a$, 1)) + RIGHT$(a$, z - 1)
        Line$ = a$ + " " + b$ + " " + c$ + " " + d$
    ELSE
        z = LEN(c$)
        c$ = UCASE$(LEFT$(c$, 1)) + RIGHT$(c$, z - 1)
        Line$ = c$ + " " + b$ + " " + d$
    END IF
    IF x MOD 4 = 0 THEN Line$ = Line$ + "." + cr$
    PRINT SPACE$(3) + Line$
NEXT x


endPROG:
'**************************************************
'*** Print Copyright and Date/Time Stamp and END
'***

mnth$ = LEFT$(DATE$, 2): M = VAL(mnth$)
day$ = MID$(DATE$, 4, 2): D = VAL(day$)
day$ = STR$(D) ' eliminate any leading zeros
year$ = RIGHT$(DATE$, 4): Y = VAL(year$)

SELECT CASE M
    CASE 1: Month$ = "January"
    CASE 2: Month$ = "February"
    CASE 3: Month$ = "March"
    CASE 4: Month$ = "April"
    CASE 5: Month$ = "May"
    CASE 6: Month$ = "June"
    CASE 7: Month$ = "July"
    CASE 8: Month$ = "August"
    CASE 9: Month$ = "September"
    CASE 10: Month$ = "October"
    CASE 11: Month$ = "November"
    CASE 12: Month$ = "December"
END SELECT


'*** Copyright Sign (Character, Unicode, UTF-8 Values
'***

PRINT: PRINT: PRINT SPACE$(3) + "(C)2021 " + Author$ + " (if it is good), All Rights Reserved"
PRINT SPACE$(3) + "Created " + WeekDay$(M, D, Y) + ", " + Month$ + day$ + ", " + year$ + " at " + Clock$

END


'***
'*** END OF MAIN PROGRAM
'*******************************************************************


'*******************************************************************
'*** FUNCTIONS/SUB ROUTINES
'***


LoadWordArrays:
'**************************************************
'*** Load Arrays from Data Statements
'***

'*** Load Articles
    FOR i = 1 TO 35: READ article$(i): NEXT i

'*** Load Nouns
    FOR i = 1 TO 60: READ noun$(i): NEXT i

'*** Load Verbs
    FOR i = 1 TO 46: READ verb$(i): NEXT i

'*** Load Adjectives
    FOR i = 1 TO 46: READ adjective$(i): NEXT i

'*** Load Color Modifiers
    FOR i = 1 TO 28: READ colormodifier$(i): NEXT i

'*** Load Color Table
    FOR i = 1 TO 7: READ colortable$(i): NEXT i

'*** Load Noun Modifiers
    FOR i = 1 TO 14: READ nounmodifiers$(i): NEXT i

'*** Load Connectives
    FOR i = 1 TO 151: READ connectives$(i): NEXT i

'*** Load Contective Extended
    FOR i = 1 TO 34: READ conective_extended$(i): NEXT i


RETURN


CheckForCapitalization:
'*** Check for modifiers (@=Capitalize Word)
IF LEFT$(b$, 1) = "@" THEN
    z = LEN(b$)
    b$ = RIGHT$(b$, z - 1)
    b$ = UCASE$(LEFT$(b$, 1)) + RIGHT$(b$, z - 2)
END IF
IF LEFT$(b1$, 1) = "@" THEN
    z = LEN(b1$)
    b1$ = RIGHT$(b1$, z - 1)
    b1$ = UCASE$(LEFT$(b1$, 1)) + RIGHT$(b1$, z - 2)
END IF
IF LEFT$(bc$, 1) = "@" THEN
    z = LEN(bc$)
    bc$ = RIGHT$(bc$, z - 1)
    bc$ = UCASE$(LEFT$(bc$, 1)) + RIGHT$(bc$, z - 2)
END IF

RETURN


CheckForModifierBefore:
'*** Check for modifiers Before

'*** "*" the noun needs a color before it
IF LEFT$(b$, 1) = "*" THEN
    z = LEN(b$)
    b$ = RIGHT$(b$, z - 1)
    b$ = color$ + " " + b$
END IF

'*** "+" the noun needs another noun to follow it (selection from noun modifier)
IF RIGHT$(b$, 1) = "+" THEN
    z = LEN(b$)
    b$ = LEFT$(b$, z - 1)
    b$ = nounmod$ + " " + b$
END IF

RETURN


CheckForModifierAfter:
'*** Check for modifiers after

'*** "*" the noun is a color and only color-friendly nouns considered
IF RIGHT$(b$, 1) = "*" THEN
    z = LEN(b$)
    b$ = LEFT$(b$, z - 1)
    b$ = b$ + " " + bc$
END IF

'*** "+" the noun needs another noun to follow it (selection from noun modifier)
IF RIGHT$(b$, 1) = "+" THEN
    z = LEN(b$)
    b$ = LEFT$(b$, z - 1)
    b$ = b$ + " " + nounmod$
END IF

RETURN



'**************************************************
'*** DATA Statements for Poem Generator
'***

'*** 35 Articles
articles:
DATA "The","All of the","Most of the","Some of the"
DATA "My","Your","His","Her","Their","Our","Everybody's","Almost all of the"
DATA "That","I knew that the","We knew that the","She knew that the","He knew that the","They knew that the","And the coming","Oh, the","A spring of","Beyond the","Within the","And the","Alone, alone,","I fear","I looked upon","A","But where the","Like","A still and","Alone","All alone, a","The moving","It is"


'*** 60 Nouns
nouns:
DATA "darkness","morning","morning+","light","feeling","feeling+","beauty","love","hatred","happiness","sadness","anger","frustration","expression","message","ship","lips","mouth","voice","garment","saint","snake","snakes","water","fire","lead","dreams","air","ghost","sails","sleep","river","cloud","@moon","@sun","waters","life","stars","the stars","lightning","beams","beams+","*beard","fool","white*","black*","green*","blue*","yellow*","red*","light beams","*river","*garment","*ship","*snake","*snakes","*sails","voice+","ship+","ocean blue"


'*** 46 Verbs (lv)
verbs:
DATA "was","had been","will be","could be","might be","should have been","would have been","could have been","drunk","drank","was heavenly","a heavy","blessed","glossy","velvet","flash","kind","coiled","swarm","swarmed","fire","pity","filled","fill","moved","wind","danced","steep","wide","steep and wide","thick","light","roar","loud","more loud","lightning","struck","fell","more horrible","horrible","awful","hit","huge","holds","long","surrounds"


'*** 46 Adjectives/adverbs
adjectives:
DATA "abstract","mysterious","permanent","unfortunate","was unfortunate"
DATA "intricate","confusing","serene","confusing"
DATA "true","false","fake","a lie","burden"
DATA "a stranger","a friend","an enemy"
DATA "terrible","enchanting","is mine","was yours","is his","is hers","was theirs","was ours"
DATA "fortunate","was understood","mine","is mutual","with an artistic flair","was musical"
DATA "golden pond","blessed","moment","unaware","no","yes","sure"
DATA "like","dreams","between","inbetween","alone","than that","interesting","glossy lake"


'*** 28 Color modifiers
colormodifiers:
DATA "morning","light","beauty","love","ship","lips","garment","knight","saint","snake","snakes","water","fire","ghost","sails"
DATA "river","cloud","@moon","@sun","waters","stars","lightning","beams","beard","velvet","flash","grass","book"


'*** 8 Color table entries
colortable:
DATA "red","yellow","blue","green","white","black","orange","purple"


'*** 14 Noun Modifier Table (Nouns, Verbs/Adverbs, Adjectives)
nounmodifier:
DATA "sunshine","light","glow","fog","of peace","of love","blue","great","unloved","sad","happy","loved","of light","of love"

'*** 151 Connectives
connectives:
DATA "I","the","of","and","to","a","in","that","is","was","he","for","it"
DATA "with","as","his","on","be","at","by","i","this","had","not"
DATA "are","but","from","or","have","an","they","which","one","you","were"
DATA "her","all","she","there","would","their","we","him","been","has"
DATA "when","who","will","more","no","if","out","so","said","what","u","its","about"
DATA "into","than","them","can","only","other","new","some","could","time","these"
DATA "two","may","then","do","first","any","my","now","such","like","our"
DATA "over","man","me","even","most","made","after","also","did","many","before","must"
DATA "through","back","years","where","much","your","way","well","down","should"
DATA "because","each","just","those","people","mr","how","too","little"
DATA "state","good","very","make","world","still","own","see","men","work","long"
DATA "get","here","between","both","life","being","under","never","day","same"
DATA "another","know","while","last","might","us","great","old","year","off"
DATA "come","since","against","go","came","right","used","take","three"

'*** 34 Extened Connectives:
connectives_extend:
DATA "whoever","nonetheless","therefore","although","consequently","furthermore"
DATA "whereas","nevertheless","whatever","however","besides","henceforward","yet"
DATA "until","alternatively","meanwhile","notwithstanding","whenever"
DATA "moreover","despite","similarly","firstly","secondly","lastly","eventually"
DATA "gradually","finally","thus","hence","accordingly","otherwise","indeed"
DATA "though","unless"




'*******************************************************************
'*** FUNCTIONS (FORMAT DATE AND TIME FIELDS)
'***


FUNCTION WeekDay$ (M, D, Y)
    IF M < 3 THEN M = M + 12: Y = Y - 1 'add 12 to Jan - Feb month, -1 year
    C = Y \ 100: Y = Y MOD 100 'split century and year number
    S1 = (C \ 4) - (2 * C) - 1 'century leap
    S2 = (5 * Y) \ 4 '4 year leap
    S3 = 26 * (M + 1) \ 10 'days in months
    WkDay = (S1 + S2 + S3 + D) MOD 7 'weekday total remainder
    IF WkDay < 0 THEN WkDay = WkDay + 7 'Adjust negative results to 0 to 6
    SELECT CASE WkDay
        CASE 0: day$ = "Sunday"
        CASE 1: day$ = "Monday"
        CASE 2: day$ = "Tuesday"
        CASE 3: day$ = "Wednesday"
        CASE 4: day$ = "Thursday"
        CASE 5: day$ = "Friday"
        CASE 6: day$ = "Saturday"
    END SELECT
    WeekDay$ = day$
END FUNCTION


FUNCTION Clock$
    hour$ = LEFT$(TIME$, 2): H% = VAL(hour$)
    min$ = MID$(TIME$, 3, 3)
    IF H% >= 12 THEN ampm$ = " pm" ELSE ampm$ = " am"
    IF H% > 12 THEN
        IF H% - 12 < 10 THEN hour$ = STR$(H% - 12) ELSE hour$ = LTRIM$(STR$(H% - 12))
    ELSEIF H% = 0 THEN hour$ = "12" ' midnight hour
    ELSE: IF H% < 10 THEN hour$ = STR$(H%) ' eliminate leading zeros
    END IF
    Clock$ = hour$ + min$ + ampm$
END FUNCTION