Noch ein Namengenerator

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
DarkSoul
Beiträge: 689
Registriert: 19.10.2006 12:51

Noch ein Namengenerator

Beitrag von DarkSoul »

Mein Namengenerator ist gut für Spiele verwendbar, da er in einer Prozedur ist. Die länge sollte 4-8 betragen, das ist sowieso nicht so genau. Der längenparameter ist sowieso ein schätzeisen :D

Code: Alles auswählen

Procedure.s CreateFantasyName(CFN_Length.b)    
  Repeat
    A$ = Chr$(Random(25)+65)
  Until A$<> "X" And A$ <>"Q" And A$<> "J" And A$<> "Y"
  If A$ = "A" Or A$ = "E" Or A$ = "I" Or A$ = "O" Or A$ = "U" 
    flip=1   
  Else
    flip=0  
  EndIf
  Length=CFN_Length-1   ;
  For a = 1 To Length
    If flip           
      Repeat
        forbid=0    
        Repeat 
          B$ = Chr$(Random(25)+97)
        Until B$ <> "a" And B$ <> "e" And B$ <> "i" And B$ <> "o" And B$ <> "u" And B$ <> "y"  And B$ <> "j" 
        Select B$
          Case "h" 
            If a= Length    
              forbid=1
            EndIf
          Case "c" 
            If a= Length    
              forbid=1
            Else 
              Select Random(2)
                Case 0
                  B$+"h"
                  flip =Random( 1)
                Case 1
                  B$+"k"
              EndSelect
              Length-1
            EndIf
          Case "k"
            forbid=1
          Case "q"
            If a >= Length    -1
              forbid=1
            Else
              B$+"u"
              Length-1
            EndIf
          Case "r"
            If Random(1) And a <> Length    
              B$+"r"
              Length-1
            EndIf
          Case "s" 
            If Random(1) And a <> Length    
              B$+"s"
              Length-1
            EndIf
          Case "t" 
            If Random(1) And a <> Length    
              B$+"t"
              Length-1
            EndIf
          Case "f" 
            If Random(1) And a <> Length    
              B$+"f"
              Length-1
            EndIf
          Case "m" 
            If Random(1) And a <> Length    
              B$+"m"
              Length-1
            EndIf
          Case "x" 
            If FindString(A$,"x",1)
              forbid=1
            EndIf
        EndSelect
      Until forbid=0
      A$+B$
    Else
      Repeat 
        forbid=0 
        Select Random(4) 
          Case 1
            A$+"a"
          Case 2
            A$+"e"
          Case 3
            A$+"i"
          Case 4
            A$+"o"
          Case 0
            If B$ <> "qu"
              A$+"u"
            Else
              forbid=1
            EndIf
        EndSelect
      Until forbid=0
    EndIf
    flip ! 1 
  Next a  
  ProcedureReturn A$ 
EndProcedure
For a = 0 To 100
  Debug CreateFantasyName(6)
Next a
das ding hab ich schon in viele spiele eingebaut.
Zuletzt geändert von DarkSoul am 21.12.2006 16:27, insgesamt 1-mal geändert.
Bild
Jilocasin
Beiträge: 665
Registriert: 13.05.2006 16:04
Kontaktdaten:

Beitrag von Jilocasin »

:mrgreen:
Das gibt auf jeden Fall den nächsten PureContest <)

Cool, dass dein Prog nicht einfach "zufällige" Buchstaben hintereinander setzt 8)
Bild
Benutzeravatar
DarkSoul
Beiträge: 689
Registriert: 19.10.2006 12:51

Beitrag von DarkSoul »

das wäre auch schlimm, wenn unaussprechbare namen wie qayixa rauskämen. ich bastle im momen noch einen, der noch realere namen ausspuckt (männlich, weiblich, arabisch, alien)
Bild
Kaeru Gaman
Beiträge: 17389
Registriert: 10.11.2004 03:22

Beitrag von Kaeru Gaman »

"qayixa" ist doch nicht unaussprechlich...

und btw. ist das eine mögliche ausgabe meiner alten routine...
Der Narr denkt er sei ein weiser Mann.
Der Weise weiß, dass er ein Narr ist.
Benutzeravatar
DarkSoul
Beiträge: 689
Registriert: 19.10.2006 12:51

Beitrag von DarkSoul »

nee, aber der name ist anfänglich aus meinem namengenerator gekommen. aber trotzen ist der name uncool, das klingt nach gay und hexe. da kamen nur solche namen, bis ich endlich den letzten bug unterkellert habe.
Bild
Antworten