PureBoard

Code: Alles auswählen

; Flags:
; 0 = kann von bel. 2. gefolgt werden
; 1 = kann von bel. 2. ausser selbst gefolgt werden
; 2 = kann von bel. 2. ausser Special gefolgt werden
; 4 = ist special
;
; z.B.: 6 = ist Special und kann nur nicht-special gefolgt werden
;
; Diese Flags sind ziemlich willkürlich gesetzt, kann man noch überarbeiten...
; wer mehr als 3-Bit für flags benötigt, kann Grossbuchstaben als flags verwenden,
; asc() statt val(), und Bit 64 einfach ignorieren

Dim Char$(2)
Dim ChFl$(2)

Char$(0) = "aeiouy"
ChFl$(0) = "002015"
Char$(1) = "bcdfghjklmnpqrstvwxz"
ChFl$(1) = "04000111000030400020"

Procedure.s Create_Name(Lang.l)

  n.l
  Nummer.l
  NumFlg.l
  DopFlg.l = 0
  Out$ = ""
  Wrk$ = ""
  Typ.l = Random(1) ; Vokal oder Konsonant als erstes...
  
  For n = 1 To Lang
  
    Repeat
  
      Nummer = 1+Random(5+Typ*14) ; 6 Vokale, 20 Konsonanten....
      NumFlg = Val( Mid( ChFl$(Typ), Nummer, 1) )
      Weiter = 1
      
      If DopFl = 1

        If (LastFlg & 1)= 1 And Nummer = LastNum : Weiter=0 : EndIf
        ; Flag & 1 darf nicht selbst folgen
      
        If (LastFlg & 2)= 2 And (NumFlg & 4)= 4 : Weiter=0 : EndIf
        ; special darf nicht Flag & 2 folgen

      EndIf
      
    Until Weiter = 1
    
    Wrk$ + Mid(Char$(Typ), Nummer , 1)
    
    If Random(3) = 0 And DopFl = 0 And n>1 And n<Lang-1
    ; nächster Buchst. gleicher Typ ?
      DopFl = 1
      LastNum = Nummer
      LastFlg = NumFlg
    Else
      Typ = 1-Typ ; Typwechsel
      DopFl = 0
    EndIf
    
  Next

  Out$ = UCase(Left(Wrk$,1))+Mid(Wrk$,2,Lang)
  ; ich schenke mir das -1, weil wird eh abgeschnitten...
  
  ProcedureReturn Out$

EndProcedure

For x = 0 To 50
  LO = 3+Random(6)
  Debug Create_Name(LO)
Next