dim words$(50,20)
dim aval(50)
dim pres$(50)
 
if file exist("log.txt") then delete file "log.txt"
open to write 1,"log.txt"
 
gosub somewords
 
global asktype
global an
global findleft
global nword$
global lastword$
 
do
input ">",you$
write string 1,you$
you$=lower$(you$)
while right$(you$,1)="?"
   you$=left$(you$,len(you$)-1)
endwhile
 
 
if left$(you$,1)="."
   response$=learn$(right$(you$,len(you$)-1))
else
   response$=process$(you$)
endif
him$=correct$(response$)
print "Him: ";him$
write string 1,him$
loop
 
close file 1
end
 
function firstactive(i$)
r$=""
ry=-1
num=numwords(i$)
`print num
for x=1 to num
   w$=gt$(i$,x)
   t$=""
   for y=0 to 50
      if words$(y,0)=w$ then t$=pres$(y)
      if t$<>""
         if t$<>"passive" and ry=-1 then ry=y : x=num : lastword$=words$(y,0)
      endif
   next y
   if t$=""
      lastword$=w$
   endif
next x
`print ry
endfunction ry
 
function findwords(re$)
 
for x=0 to 50
   if aval(x)=0
      allowed=1
      if words$(x,0)<>""
         for y=0 to 20
            if words$(x,y)=re$
               allowed=0
               `print words$(x,0)
               inc results
            endif
         next y
      endif
      aval(x)=allowed
   endif
next x
 
endfunction results
 
function getword$()
r$="Error"
for x=0 to 50
   if aval(x)=0 then r$=words$(x,0) : exitfunction r$
next x
endfunction r$
 
function correct$(a$)
a$=upper$(left$(a$,1))+lower$(right$(a$,len(a$)-1))
endfunction a$
 
function process$(a$)
`print "Asktype="; asktype
if asktype>0
   if left$(a$,1)="y"
      if asktype=1 then b$="Oh ok, isn't that "+words$(an,rnd(getamount(an)-1)+1) : asktype=0
      if asktype=2 then b$=dofind$(lastword$,1) : asktype=0
      if asktype=4 then b$="Ok, ill note that." : newword(lastword$,nword$)
   endif
   if left$(a$,1)="n"
      if asktype=2 then b$=dofind$(lastword$,2) : asktype=0
      if asktype=1 then b$="Oh, then what are we talking about?" : asktype=0
   endif
   if asktype=3 then nword$=gt$(a$,numwords(a$)) : b$="So "+lastword$+" is a "+nword$ : asktype=4
endif
if left$(a$,4)="like" then b$=suggest$()
 
if b$=""
   an=firstactive(a$)
`   print "An: "; an
   if an=>0
   `print "Type: ";pres$(an)
      if pres$(an)<>"greet"
         b$="What?, are we talking about "+lastword$+ "?" : asktype=1
      else
         b$=greet()
      endif
   else
      b$="What is a '"+lastword$+"' ?" : asktype=3
   endif
endif
if b$="" then b$="Could we talk about something else?.."
endfunction b$
 
function greet()
 
repeat
for x=0 to 50
   if pres$(x)="greet" and rnd(5)=1 then r$=words$(x,0)
next x
inc t
until r$<>"" or t=5
if t=5 then r$="Hey"
 
endfunction r$
 
function newword(word$,nword$)
asktype=0
   for x=0 to 50
      if words$(x,0)="" then y=x : x=50
   next x
   `print "Added "; word$; " as "; nword$; " on #"; y
   words$(y,0)=word$
   pres$(y)=nword$
endfunction
 
function resetf()
for x=0 to 50
   aval(x)=0
next x
endfunction
 
function learn$(a$)
`print "Learning..."
command$=gt$(a$,1)
word$=gt$(a$,2)
param$=gt$(a$,3)
r$=""
`print "Command:"; command$;"."
`print "Word:";word$;"."
`print "Param:";param$;"."
 
select command$
   case "cls"
      cls
      r$="Cleared it for ya!"
   endcase
   case "rf"
      resetf()
   endcase
 
   case "find"
      r$=dofind$(word$,0)
   endcase
   case "new"
      if word$<>""
         for x=0 to 50
            if words$(x,0)=word$ then error=1 : x=50
            if words$(x,0)="" then y=x : x=50
         next x
         if error=0
            r$= "Adding new word '"+ word$+"' on place "+ str$(y)+ " in the list."
            words$(y,0)=word$
         else
            r$="Error!, word already exists."
         endif
      else
         r$="You should really enter a word when you use this command"
      endif
   endcase
 
   case "add"
      if param$<>""
         y=100
         for x=0 to 50
            found$=words$(x,0)
            if y=100 and found$=word$ then y=x
         next x
         if y<>100
            `print "Found word as #"; y
            for x=1 to 20
               if words$(y,x)="" then z=x : x=21
            next x
 
            if x<21
               r$="Some odd error occured"
            else
               r$="Added '"+ param$+ "' for word '"+ word$+ "' at place #"+str$(z)
               words$(y,z)=param$
            endif
         else
            r$="Error!, word doesn't exists."
         endif
      else
         r$="Consider adding a parameter!"
      endif
   endcase
 
   case default
      r$="I dont know that command!"
   endcase
endselect
 
endfunction r$
 
function gt$(r$,n)
return$=""
r$=r$+" "
`print "Gotta find a space in '"; r$; "', "; n; "th space."
repeat
lx=x
repeat
inc x
if x>len(r$) then exitfunction return$
until mid$(r$,x)=" "
`print "Found a space on x:"; x
inc m
until m=>n
return$=left$(r$,x-1)
`print "r1: -";return$;"-"
return$=right$(return$,len(return$)-lx)
`print "r2: -";return$;"-"
endfunction return$
 
function dofind$(word$,yn)
if word$<>""
   amount=findwords(word$)
else
   amount=findleft
   if yn=1
      dec amount
   else
      if yn=2
         crossword()
         dec amount
      else
      amount=findwords(word$)
      endif
   endif
endif
   if amount=>10 then r$="Theres alot of words with that property, you know."
   if amount>2 and amount<10 then r$="I need some more info about the word you're think of."
   if amount<3 then r$="Is it "+getword$()+"?"
   if amount=1 then r$="I know!, its "+getword$()+"!" : resetf()
   if amount=0 then r$="I really dont know any words that are '"+word$+"'" : resetf()
   `print "Amount: "; amount
   findleft = amount
endfunction r$
 
function crossword()
for x=0 to 50
   if aval(x)=0 then aval(x)=1 : exitfunction
next x
endfunction
 
function suggest$()
r$="Sorry, but i can't do any suggestions."
for x=0 to 50
   if aval(x)=0
      w$=words$(x,rnd(getamount(x)-1)+1)
      r$="Is "+w$+" a property of the word you're thinking of?"
      lastword$=w$
      exitfunction r$
   endif
next x
asktype=2
endfunction r$
 
function numwords(s$)
sp=1
l=len(s$)
for x=1 to l
   if w=0 and mid$(s$,x)=" " then inc sp
   if w=1 and mid$(s$,x)<>" " then w=0
next x
endfunction sp
 
function getamount(n)
for x=1 to 20
   if words$(n,x)="" and y=0 then y=x-1
next x
endfunction y
 
somewords:
 
words$(0,0)="competition" ` This is a new object
pres$(0)="object" ` kind of word
words$(0,1)="people"
words$(0,2)="prizes"
words$(0,3)="chat"
 
words$(1,0)="forum" `new obj
pres$(1)="object" ` kind of word
words$(1,1)="people" `props
words$(1,2)="chat"
words$(1,3)="topics"
words$(1,4)="replies"
 
words$(2,0)="sun" `etc
pres$(2)="object"
words$(2,1)="bright"
words$(2,2)="light"
words$(2,3)="warm"
words$(2,4)="big"
words$(2,5)="huge"
words$(2,6)="star"
 
words$(3,0)="fire"
pres$(3)="object"
words$(3,1)="warm"
words$(3,2)="bright"
words$(3,3)="light"
words$(3,4)="fire"
 
words$(4,0)="lamp"
pres$(4)="object"
words$(4,1)="light"
words$(4,2)="small"
words$(4,3)="electric"
 
words$(5,0)="earth"
pres$(5)="object"
words$(5,1)="planet"
words$(5,2)="humans"
words$(5,3)="people"
 
words$(6,0)="mars"
pres$(6)="object"
words$(6,1)="planet"
words$(6,2)="rock"
 
words$(7,0)="venus"
pres$(7)="object"
words$(7,1)="planet"
words$(7,2)="hot"
 
words$(8,0)="jupiter"
pres$(8)="object"
words$(8,1)="planet"
words$(8,2)="gas"
words$(8,3)="big"
words$(8,4)="huge"
 
return