simple poem generator program

ron77 · Post by **ron77** » Jul 10, 2020 15:52

hello all...

although not quite a game here is a basic poem generator - a small feature in my game "hikikomori" which i developed to stand on it's own two feet...

here is the code:

Code: Select all

Screen 19

ReDim Shared places(0) As String
ReDim Shared colors(0) As String
ReDim Shared metaphore(0) As String
ReDim Shared objects(0) As String
ReDim Shared good(0) As String
ReDim Shared bad(0) As String
ReDim Shared actions(0) As String

Randomize Timer


Sub sAppend(arr() As String, item As String)
	ReDim preserve arr(LBound(arr) To UBound(arr) +1) As String
	arr(UBound(arr)) = item
End Sub

FUNCTION _
	getKeys(_
	BYREF keysToCatch AS CONST STRING) _
	AS STRING
	
	DIM AS STRING _
	k
	
	DO
        k = > INKEY()
        
        SLEEP(1 , 1)
    LOOP UNTIL (INSTR(keysToCatch , k))
	
	'CLEAR keyboard buffer
	DO WHILE (LEN(INKEY()) > 0)
        SLEEP(1 , 1)
    LOOP
	
	RETURN(k)
END Function


Sub loadArrys(filename As String)
	Dim h As Integer = FreeFile()
	Dim fline As String
	Open filename For Input As #h
	While Not Eof(h)
		Line Input #h, fline
		Select Case Left(fline, 2)
			Case "p:": sAppend places(), Trim(Mid(fline,3))
			Case "c:": sAppend colors(), Trim(Mid(fline,3))
			Case "m:": sAppend metaphore(), Trim(Mid(fline,3))
			Case "o:": sAppend objects(), Trim(Mid(fline,3))
			Case "g:": sAppend good(), Trim(Mid(fline,3))
			Case "b:": sAppend bad(), Trim(Mid(fline,3))
			Case "a:": sAppend actions(), Trim(Mid(fline, 3))
			Case "e:": Exit while	
		End Select
	Wend
	Close #h
End Sub

Sub restart()
	ReDim places(0) As String
	ReDim colors(0) As String
	ReDim metaphore(0) As String
	ReDim objects(0) As String
	ReDim good(0) As String
	ReDim bad(0) As String
	ReDim actions(0) As String
End Sub

Sub cp (row As Integer, s As String)
	Locate row, (100 - Len(s)) / 2: Print s
End Sub

Sub generator()
	restart()
	loadArrys("poemDB.txt")
	
	Cls
	
	cp 1, "POEM..."
	For i As Integer = 0 To 4
	Print
	
	Print places(Int(Rnd*(UBound(places))+1)) & " " & colors(Int(Rnd*(UBound(colors))+1)) & " " & objects(Int(Rnd*(UBound(objects))+1))
	
	Print metaphore(Int(Rnd*(ubound(metaphore))+1)) & " " & colors(Int(Rnd*(UBound(colors))+1)) & " " & objects(Int(Rnd*(UBound(objects))+1))
	
	Print good(Int(Rnd*(UBound(good))+1)) & " " & actions(Int(Rnd*(UBound(actions))+1)) & " " & metaphore(Int(Rnd*(ubound(metaphore))+1))
	
	Print metaphore(Int(Rnd*(ubound(metaphore))+1)) & " " & bad(Int(Rnd*(UBound(bad))+1)) & " " & metaphore(Int(Rnd*(ubound(metaphore))+1))
	
	Print places(Int(Rnd*(UBound(places))+1)) & " " & actions(Int(Rnd*(UBound(actions))+1)) & " " & good(Int(Rnd*(UBound(good))+1))
	
	Print colors(Int(Rnd*(UBound(colors))+1)) & " " & objects(Int(Rnd*(UBound(objects))+1)) & " " & metaphore(Int(Rnd*(ubound(metaphore))+1))
	next
	Sleep
End Sub

Sub main()
	Dim k As String
	Do
	cls
	cp 2, "WELCOME TO THE POEN GENERATOR"
	cp 4, "PRESS KEY 1 TO GENERATE A RANDOM POEM"
	cp 6, "OR PRESS KEY 2 TO EXIT"
	k = getKeys("12")
	If k = "1" Then
		generator()
	ElseIf k  = "2" Then
		End
	EndIf
	
	Loop
	
End Sub

main()

here is the text file database for the generator save as "poemDB.txt" and put in same folder as executible or bas file...

Code: Select all

p:a palace 
p:swampy road
p:on thin ice
p:somewhere over the rainbow
p:Atlantis
p:at the bottom of the heart
p:on thin air
p:a golden cage
p:prison
p:with the people i love
p:at bed
p:at a desert
p:frozen plane
p:home sweet home
p:where my heart desire to be
p:at the poem inside the poem
p:nowhere
p:at no mans land
p:hell
p:heaven
p:a rivers broke
p:where the birds sing
p:where the crickets sing at night
p:inside a tornado
p:at a full moon party
p:at the land of dreams
p:inside a dream
p:with my friends
p:at my family's home
p:at a restaurant
p:inside a club
p:at a swamp
p:where the music never stop
p:valley of the butterfly
p:inside my heart
p:inside my soul



c:blue
c:black
c:blonde
c:white
c:yellow
c:green
c:brown
c:purple
c:off white
c:rainbow
c:golden
c:grey
c:red
c:dark
c:misc


m:ray of light
m:ravens claws
m:bitter-sweet
m:soft as a sonata
m:fog of sorrow
m:clouds of doubts
m:grapes of wraps
m:dray tears
m:wet clouds
m:silent screams
m:howl to the moon
m:falling star
m:sades of love
m:morning world
m:dray rain
m:another universe
m:parallel world
m:wet fire
m:cold heat
m:awaken to a dream
m:sad clown
m:lonely thrown
m:hunger food
m:eyes wide shut
m:the sound of one hand clapping
m:the noise of silence


o:chair
o:table
o:pen
o:flower
o:rose
o:birds
o:room
o:planes
o:fields
o:notebook
o:screen
o:computer
o:vase
o:house
o:window
o:book
o:bed
o:cloths
o:coat
o:crown
o:robe
o:picture
o:walls
o:handbag
o:mask
o:arm chair
o:couch
o:sink
o:bed
o:floor
o:ground
o:road
o:fence
o:coffee table
o:street

g:i am happy
g:so glad to see
g:love them all
g:good day
g:peaceful night
g:grace and glory
g:faith in divinity
g:so it must be
g:the best of all possible worlds
g:peace and quite
g:joyful song
g:dance of life
g:sweet memory
g:i remember with a smile
g:so soft and tender
g:wonderful world
g:glade to be alive
g:the old good times
g:the old good ways
g:tears of joy
g:bright future
g:looking ahead
g:hope and faith


b:depression
b:deep sadness
b:despair
b:anger
b:fear
b:turmoil
b:broken heart
b:broken soul
b:bad times


a:i try to lift myself every day
a:woke up this morning
a:i hold my pen to the sky
a:i went upstairs
a:i talk to the man upstairs
a:pray everyday for tomorrow
a:looking ahead for a brighter day
a:sitting doing nothing
a:i look around me
a:but all i can see is
a:i opened the window of my soul
a:i send a fist of wrath to the sky 
a:with the demons i dance
a:with the angles i sing
a:lost in the sea of life
a:walk the street of the lost city
a:lost among the stars i roll the dices of destiny
a:i swim in the sea of chance
a:i listen to the music of chance
a:the mysteries of my soul are revealed
a:an empty fist of tears

e:

and here is some screen shot of the program...

have fun

ron77