freeBasic Dream Interpreter

[ron77]

hi hello

here is a Dreams Interpretation App according to Symbols from the Bible

this app was done ONLY as an exercise in freebasic / window9 programming...

I do not take any responsibility for the database interpretation as they are not mine!...

and some (non-religious) might not like the interpretations!

please use common sense and don't take it too seriously!!!

the database was not changed from the original religious site...


https://github.com/lonelyStar211/fb_dream_interpreter

[ron77]

hello here is the console version of the fb_dream_interpreter...

here is the main code:

const database = "database/dream-database.txt"

type dreams
	topicName as STRING
	redim description(any) as STRING
	redim positive(any) as STRING
	redim negavite(any) as STRING
	verse as STRING
End Type	

redim shared dictionary(any) as dreams

function Split(Text As String, Delim As String = " ", Count As Long = (1 shl 31)-1, Ret() As string) as long
	if Count<0 then Count = (1 shl 31)-1 'max possible
	if Count=0 then erase ret: return 0
	
	dim as long iStart = 1
	for N as long = 0 to Count-1
		redim preserve Ret(N) as string
		var iFound = instr( iStart , Text , Delim )
		if iFound=0 then Ret(N) = mid(Text,iStart): return N+1
		Ret(N) = mid(Text,iStart,(iFound-iStart))
		if iFound=iStart then N -= 1
		iStart = iFound+len(Delim)
	next N 
	return Count
End function

sub loadArrays(filename as string)
	var f = freefile()
	dim as string fline
	dim as string sName
	
	open filename for input as #f
	Dim As Integer IsNewTopic=0,iTopicNum=-1
	while not eof(f)
		line input #f, fline
		Var iPosi = InStr(fline,":")
		Var sText = TRIM(MID(fline, iPosi+1))
		If iPosi = 2 Then 'check for 1 chracter entries
			Select Case fline[0]
				Case asc("t")
					
					if sName <> sText then
						
						iTopicNum +=1
						redim preserve dictionary(iTopicNum)
					end if
					dictionary(iTopicNum).topicName = sText
					sName = dictionary(iTopicNum).topicName
					'if sname <> sText then isNewTopic = 0
				case asc("d")
					Split(sText, , ,dictionary(iTopicNum).description())
				case asc("p")
					split(sText,,,dictionary(iTopicNum).positive())
				case asc("n")
					split(sText,,,dictionary(iTopicNum).negavite())
				case asc("v")
					dictionary(iTopicNum).verse = sText
			End Select
		EndIf
	Wend
End Sub


loadarrays(database)

'print dictionary(0).topicName
'for i as integer = 0 to 6
'print dictionary(0).description(i)+" ";
'print dictionary(0).positive(i) +" ";
'print dictionary(0).negavite(3)+" ";
'Next
'print dictionary(0).verse
'
FUNCTION processInput(Array() AS dreams, inpt AS STRING) AS dreams
	dim as integer index
	index = -1 
	var words = 0
	var wordCount = 0
	var result = 0
	'dim as boolean Found = false
	for i as integer =  0 to ubound(Array)
		'wordCount = 0
		for d as integer = 0 to ubound(array(i).description)
			result = Instr(inpt, Array(i).description(d))
			
			if result <> 0 then
				'found = true
				wordCount +=1
			end if
		Next
		
		for p as integer = 0 to ubound(array(i).positive)
			result = Instr(inpt, Array(i).positive(p))
			
			if result <> 0 then
				'found = true
				wordCount +=1
			end if
			
		Next
		
		for n as integer = 0 to ubound(array(i).negavite)
			result = Instr(inpt, Array(i).negavite(n))
			
			if result <> 0 then
				'found = true
				wordCount +=1
			end if
			
		Next
		
		if words < wordCount then
			index = i
			words += wordCount
		EndIf
		'print "words: " & words & "wordCount: " & wordcount
	next i
	if index <> -1 then
		return array(index)
	else 
		dim empty as DREAMS
		return empty
	End If
END Function


dim inpt as STRING
dim i as INTEGER
dim dream as dreams
do
	
	input "enter your dream: ", inpt
	
	dim dream as dreams 
	dream = processInput(dictionary(),inpt)
	
	print "dream topic-interpretation is:"
	
	print dream.topicName
	print
	for i = 0 to ubound(dream.description)
		print dream.description(i)+" ";
	Next
	print
	for i = 0 to ubound(dream.positive)
		print dream.positive(i)+" ";
	Next
	print
	for i = 0 to ubound(dream.negavite)
		print dream.negavite(i)+" ";
	Next
	print
	print dream.verse
	
loop until inpt = "quit"

sleep

before you can get started you first need the "dream-database.txt" file and to put it in a folder called "database" so I'm attaching that as well...

You cannot view this attachment.

[ron77]

Hi hello, all here is a better algorithm for the dream interpreter - this one does a bit of word checking...

const database = "database/dream-database.txt"

type dreams
	topicName as STRING
	redim description(any) as STRING
	redim positive(any) as STRING
	redim negative(any) as STRING
	verse as STRING
End Type	

redim shared dictionary(any) as dreams

function Split(Text As String, Delim As String = " ", Count As Long = (1 shl 31)-1, Ret() As string) as long
	if Count<0 then Count = (1 shl 31)-1 'max possible
	if Count=0 then erase ret: return 0
	
	dim as long iStart = 1
	for N as long = 0 to Count-1
		redim preserve Ret(N) as string
		var iFound = instr( iStart , Text , Delim )
		if iFound=0 then Ret(N) = mid(Text,iStart): return N+1
		Ret(N) = mid(Text,iStart,(iFound-iStart))
		if iFound=iStart then N -= 1
		iStart = iFound+len(Delim)
	next N 
	return Count
End function

sub loadArrays(filename as string)
	var f = freefile()
	dim as string fline
	dim as string sName
	'
	open filename for input as #f
	Dim As Integer IsNewTopic=0,iTopicNum=-1
	while not eof(f)
		line input #f, fline
		Var iPosi = InStr(fline,":")
		Var sText = TRIM(MID(fline, iPosi+1))
		If iPosi = 2 Then 'check for 1 chracter entries
			Select Case fline[0]
				Case asc("t")
					
					if sName <> sText then
						
						iTopicNum +=1
						redim preserve dictionary(iTopicNum)
					end if
					dictionary(iTopicNum).topicName = sText
					sName = dictionary(iTopicNum).topicName
					'if sname <> sText then isNewTopic = 0
				case asc("d")
					Split(sText, , ,dictionary(iTopicNum).description())
				case asc("p")
					split(sText,,,dictionary(iTopicNum).positive())
				case asc("n")
					split(sText,,,dictionary(iTopicNum).negative())
				case asc("v")
					dictionary(iTopicNum).verse = sText
			End  Select
		End If
	Wend
End Sub


loadarrays(database)

'print dictionary(0).topicName
'for i as integer = 0 to 6
'print dictionary(0).description(i)+" ";
'print dictionary(0).positive(i) +" ";
'print dictionary(0).negative(3)+" ";
'Next
'print dictionary(0).verse
'
const MinimumWordSize = 3

'so i was in forest and there was water but i couldnt see the sky i dont know if it was dark or if i was blind but i could hear things and later i only could see a rainbow

function stringComparsion( inptArray() as string, word as string) as long
	var score = 0 , lenword = len(word)
	dim as byte uChar(255)
	for n as integer = 0 to lenword-1 : uChar( word[n] ) = 1 : Next
	
	for i as integer = 0 to ubound(inptArray)
		var inptWord = inptArray(i) , leninptWord = len(inptWord)		
		'1 point for each matchin letter
		for n as integer = 0 to leninptWord-1 
			 if uChar( inptWord[n] ) then score += 1
		Next
		for n as integer = 0 to iif( leninptWord < lenword , leninptWord , lenword )-1
			if inptWord[n] = word[n] then score += 2
		Next
		for n as integer = 2 to len(inptWord)
			for m as integer = 1 to Len(inptWord)-n
				if uChar( inptWord[m-1] ) then
					if instr(" "+word+" ",mid(inptWord,m,n)) then score += (n*n)
				EndIf
			Next
		Next
	Next
	return score
End Function


FUNCTION processInput(Array() AS dreams, inpt AS STRING) AS dreams
	dim as integer index = -1	
	redim wordList(any) as string 	
	var topscore = 0 , result = 0 , inptL = lcase(inpt)	
	split(inptL,,,wordList()) 
	inptL = " "+inptL+" "
	
	print "<"+inptL+">"
	for i as integer =  0 to ubound(Array)
		
		var score = 0
		
		#macro CheckArray( _name )
			for n as integer = 0 to ubound(array(i)._name)			
				if len(Array(i)._name(n)) >= MinimumWordSize then
					score += stringComparsion( wordList() , lcase(Array(i)._name(n)) )
				EndIf
			Next
		#EndMacro
		score += stringComparsion( wordList() , lcase(Array(i).topicName))*2
		'CheckArray( description )
		'CheckArray( negative )
		'CheckArray( positive )
		if instr( inptL , lcase(Array(i).topicName) ) then score *= 2
		
		'if wordcount then print "match words: " & wordcount & "(prev=" & topwords & ")"
		if score > topscore then 
			print "topscore: "+array(i).topicName+" (" & score & ")"
			index = i  : topscore = score		
		EndIf
		
	next i
	if index <> -1 then
		return array(index)
	else 
		dim empty as DREAMS
		return empty
	End If
END Function


dim inpt as STRING
dim i as INTEGER
dim dream as dreams
do
	
	input "enter your dream: ", inpt
	
	dim dream as dreams 
	dream = processInput(dictionary(),inpt)
	
	print "dream topic-interpretation is:"
	
	print dream.topicName
	print
	for i = 0 to ubound(dream.description)
		print dream.description(i)+" ";
	Next
	print
	for i = 0 to ubound(dream.positive)
		print dream.positive(i)+" ";
	Next
	print
	for i = 0 to ubound(dream.negative)
		print dream.negative(i)+" ";
	Next
	print
	print dream.verse
	
loop until inpt = "quit"

sleep