Peter
Hannes
Hermann
Franz
Maria
Anna
Gabriela
Thomas
Udo
David
Hubert
Horst
Herbert
Irene
Jasmin
Mario
Philipp
Florina
Felix
Alexander
Alexandra
Laura
Marie
Sophie
Lea
Katherina
Sarah
Julia
Lena
Luca
Lukas
David
Tim

Dim chars$(25)
Main()
End

Function StringToChars$(txt$)
	Local i, result$, char
	
	txt$ = Lower(txt$)
	
	result$ = ""
	
	For i=1 To Len(txt$)
		char = Asc(Mid$(txt$, i, 1))-97
		If (char >= 0) And (char <= 25) Then
			result$ = result$ + Chr$(char+97)
		End If
	Next
	
	Return result$
End Function

Function ProcessName(name$)
	Local char, nextchar, i
	
	name$ = StringToChars$(name$)
	nextchar = Asc(Mid$(name$, 1, 1))-97
	For i = 2 To Len(name$)
		char = nextchar
		nextchar = Asc(Mid$(name$, i, 1))-97
		chars$(char) = chars$(char) + Chr$(nextchar + 97)
	Next
End Function

Function ReadNames(filename$)
	Local ilfe, linie$
	
	ClearChars()
	
	file = ReadFile(filename$)
	If file = 0 Then Return 0
	
	Repeat
		linie$ = ReadLine$(file)
		ProcessName(linie$)
	Until Eof(file)
	
	CloseFile file
	
	Return 1
End Function

Function ClearChars()
	Local i
	
	For i=0 To 25
		chars$(i) = ""
	Next
End Function

Function GetRandomName$(minlength, maxlength)
	Local length, i, j, result$, Nxt
	
	Repeat
		j = Rand(0, 25)
	Until Len(chars$(j)) > 0
	length = Rand(minlength, maxlength)
	result$ = Chr$(j+65)
	
	For i=2 To length
		nxt = Asc(Mid$(chars$(j), Rand(1, Len(chars$(j))), 1))-97
		result$ = result$ + Chr$(nxt+97)
		j = nxt
		If Len(chars$(j)) = 0 Then
			If Len(result$) >= minlength Then
				Return result$
			Else
				Return GetRandomName$(minlength, maxlength)
			End If
		End If
	Next
	
	Return result$
End Function

Function Main()
	Local length, i
	
	If Not ReadNames("names.txt") Then RuntimeError "Konnte Namensdatei nicht finden!"
	
	SeedRnd MilliSecs()
	
	For i = 1 To 20
		length = Rand(4, 8)
		Print GetRandomName$(length, length)
	Next
	
	WaitKey
End Function

Lixa
Vioresth
Iresthe
Domarie
Hidr
Vienn
Hian
Tinnan
Feti
Gath
Dasma
Gavilima
Tethelia
Caher
Eleteri
Jucarida
Masmahe
Eanahuc
Lerile
Flias

; Namenszusammensteller By CGC Decrayer 2004
AppTitle "D&D Namen"
Graphics 800,600,16,1
SetBuffer BackBuffer()
;Start Hauptmenü
bg=LoadImage ("Matsch.bmp");Hintergrundtextur
schalter=LoadImage ("schalter.bmp")
MaskImage schalter,255,0,255
MidHandle schalter
Cursor=LoadImage ("Cursor.bmp")
MaskImage cursor,255,0,255
f1=LoadFont(CurrentDir()+"fonts\king arthur special.ttf",30,False,False,False)
f2=LoadFont(CurrentDir()+"fonts\king arthur special.ttf",50,False,False,False)
Repeat
Cls
TileImage bg

SetFont f1
Color 240,0,0
Text 20,20,"D&D Namen"
DrawImage schalter,400,200
DrawImage schalter,400,280
DrawImage schalter,400,360
SetFont f2
Color 50,50,255
Text 380,180,"M"
Text 380,260,"W"
Text 380,340,"E"
SetFont f1
Color 0,0,0
mx=MouseX()
my=MouseY()
DrawImage cursor,mx,my
If ImagesCollide (schalter,400,200,0,cursor,mx,my,0)
 Text 400,400,"M-Namen"
 If MouseHit(1)
  Anseige$=name$(CurrentDir()+"names\vornamenm.txt",CurrentDir()+"names\nachnamen.txt")
 EndIf
EndIf
If ImagesCollide (schalter,400,280,0,cursor,mx,my,0)
 Text 400,400,"W-Namen"
 If MouseHit(1)
  Anseige$=name$(CurrentDir()+"names\vornamenw.txt",CurrentDir()+"names\nachnamen.txt")
 EndIf
EndIf
If ImagesCollide (schalter,400,360,0,cursor,mx,my,0)
 Text 400,400,"Wech hiä"
 If MouseHit(1) End
EndIf
Color 255,0,0
Text 500,550,anseige
Flip
Until KeyHit(1)
End

Function imagecollide()
End Function

Function name$(vornameverzeichnis$,nachnameverzeichnis$)
SeedRnd MilliSecs()
i2=Rnd(1,zaeler(vornameverzeichnis$))
Datas=OpenFile (vornameverzeichnis$)
For i=1 To i2
VName$=ReadLine (Datas)
Next

i2=Rand(1,zaeler(nachnameverzeichnis$))
Datas=OpenFile (nachnameverzeichnis$)
For i=1 To i2
NName$=ReadLine (Datas)
Next
Return VName$+" "+NName$
End Function

Function zaeler(dn$)
Datas=OpenFile (dn$)
Repeat
Name$=ReadLine (Datas)
z=z+1
Until name="ende"
CloseFile Datas
Return z-1
End Function