Randomize Timer()
Set Text Size 12
Set Text Font "Arial"
 
sync on
sync rate 0
 
Type GroupSize
   Single as String
   Pair as String
   Trip as String
EndType
Global maxnames as Integer
Global maxsize as Integer
`**************************************Change these variables as desired**************************
maxnames = 50
maxsize=1000
`*************************************************************************************************
Dim Con(maxsize) as GroupSize
Dim Vow(maxsize) as GroupSize
Global avg_len as Float
avg_len = 0
 
Dim Seed(maxnames) as String
Sync
Do
   Do
      Input "'Load' or 'Enter' names? ",ent$
      Sync
      ent$=Lower$(ent$)
      If ent$="load" or ent$="enter" Then Exit
   Loop
   If ent$="enter"
      Print "Please enter 3 to ";maxnames;" names in the style you would like. Enter 'exit' to quit."
      sync
      Print
      For i = 1 to maxnames
         Do
            Input "Enter name ";i;" (or 'exit' to quit): ",Seed(i)
            sync
            i#=i:if i#/20.0 = int(i/20) Then cls
            If Len(Seed(i))>2 then Exit
            Print "Names must be at least 3 letters long."
            sync
         Loop
         Seed(i)=Lower$(Seed(i))
         avg_len=avg_len+len(Seed(i))
         If Seed(i)="exit"
            Seed(i)=""
            If i<4
               Print "Please enter at least 3 names. You have ";i;" so far."
               sync
            Else
               Exit
            Endif
         Endif
      Next i
      If i>maxnames then i = maxnames
      i#=i
      Input "Do you want to save this list?",save$:Sync
      save$=lower$(save$)
      If save$="y" or save$="yes"
         Input "Enter the file name (without extension): ",filename$:Sync
         ov$="y":filename$=filename$+".nmf"
         If File Exist(filename$)
            Input "File already exists. Overwrite? ",ov$:Sync
            ov$=Lower$(ov$)
         Endif
         If  ov$="y" or ov$="yes"
            If File Exist(filename$) Then Delete File filename$
            Save Array filename$,Seed()
         Endif
      Endif
      Exit
   Else
      Input "Enter the file name (without extension): ",filename$:Sync
      filename$=filename$+".nmf"
      If File Exist(filename$)
         Load Array filename$,Seed()
         For i = 1 to maxnames
            if Seed(i)="" Then Exit
            avg_len=avg_len+len(Seed(i))
         Next i
         i=i-1:i#=i
         Exit
      Else
         Print: Print "Error: File not found.":Print:Sync
      Endif
   Endif
Loop
avg_len=avg_len/i#
Generate_Seq(i)
 
Do
   Print
   For j = 1 to 10
      Print j;") ";Generate_Name()
      sync
   Next j
   Wait key
Loop
End
 
Function Generate_Name()
   name$=""
   t=rnd(1)
   name$=name$+Generate_Seg(t,1)
   Do
      l$=Right$(name$,1)
      If l$="q" then name$=name$+"u":l$="u"
      if Is_Cons(l$,1) Then t=1 Else t=0
      name$=name$+Generate_Seg(t,0)
      l=len(name$)-3 + (len(name$)>(avg_len-2))*3
      If rnd(10+avg_len)<l Then Exit
   Loop
   name$=Upper$(Left$(name$,1))+Lower$(Right$(name$,Len(name$)-1))
EndFunction name$
 
Function Generate_Seg(ltype,flag)
   l=rnd(3)+1
   If flag then l=1
   If ltype = 0
      s=rnd(maxsize-1)+1
      If l=1
         seg$=Con(s).Single
      Endif
      If l=2
         seg$=Con(s).Pair
      Endif
      If l>2
         seg$=Con(s).Trip
      Endif
   Else
      s=rnd(maxsize-1)+1
      If l=1
         seg$=Vow(s).Single
      Endif
      If l=2
         seg$=Vow(s).Pair
      Endif
      If l>3
         seg$=Vow(s).Trip
      Endif
   Endif
EndFunction seg$
 
Function Generate_Seq(names)
   For i = 1 to maxsize
      Do
         n=rnd(names-1)+1
         p=Rnd(len(Seed(n))-1)+1
         If Is_Cons(Seed(n),p) Then Exit
      Loop
      Con(i).Single = Mid$(Seed(n),p)
 
      Do
         n=rnd(names-1)+1
         p=Rnd(len(Seed(n))-1)+1
         If Is_Vowel(Seed(n),p) Then Exit
      Loop
      Vow(i).Single = Mid$(Seed(n),p)
 
      Do
         n=rnd(names-1)+1
         p=Rnd(len(Seed(n))-2)+1
         If Is_Cons(Seed(n),p) Then Exit
      Loop
      Con(i).Pair = Mid$(Seed(n),p)+Mid$(Seed(n),p+1)
 
      Do
         n=rnd(names-1)+1
         p=Rnd(len(Seed(n))-2)+1
         If Is_Vowel(Seed(n),p) Then Exit
      Loop
      Vow(i).Pair = Mid$(Seed(n),p)+Mid$(Seed(n),p+1)+Mid$(Seed(n),p+2)
 
      Do
         For j=1 to 20
            n=rnd(names-1)+1
            If Len(Seed(n))>3 Then Exit
            n=0
         Next j
         If n>0
            Do
               p=Rnd(len(Seed(n))-3)+1
               If Is_Cons(Seed(n),p) Then Exit
            Loop
            Con(i).Trip = Mid$(Seed(n),p)+Mid$(Seed(n),p+1)+Mid$(Seed(n),p+2)
            Exit
         Endif
      Loop
 
      Do
         For j=1 to 20
            n=rnd(names-1)+1
            If Len(Seed(n))>3 Then Exit
            n=0
         Next j
         If n>0
            Do
               p=Rnd(len(Seed(n))-3)+1
               If Is_Vowel(Seed(n),p) Then Exit
            Loop
            Vow(i).Trip = Mid$(Seed(n),p)+Mid$(Seed(n),p+1)
            Exit
         Endif
      Loop
   Next i
EndFunction
 
Function Is_Cons(name$,pos)
Restore Consonants
Flag =0
For i= 1 to 21
   read c$
   If lower$(mid$(name$,pos))=c$
      Flag=1:Exit
   Endif
Next i
EndFunction Flag
 
Function Is_Vowel(name$,pos)
Restore Vowels
Flag =0
For i= 1 to 6
   read c$
   If lower$(mid$(name$,pos))=c$
      Flag=1:Exit
   Endif
Next i
EndFunction Flag
 
Consonants:
Data "b","c","d","f","g","h","j","k","l","m","n","p","q","r","s","t","v","w","x","y","z"
 
Vowels:
Data "a","e","i","o","u","y"