[Dzirt]

Накатал генератор имен...может кому пригодится:

; ************************************************************
; * Project Name: Rpg Name Generator
; * Author:  Dzirt (Olexander Ponomariov)
; * Date Started: 29/04/2010
; * Last Updated: 29/04/2010
; * Website: -
; * Email: [email protected]
; * Version: 1.00
; ************************************************************


; Автор не отвечает за все нецензурные выражения которые могут сгенерироватся =)
Graphics3D 800, 600,32,2
SetFont LoadFont("Arial Cyr", 16,0,0,0)

name1$=Rpg_Name_Generator(4,1,2)
name2$=Rpg_Name_Generator(5,1,1)

RenderWorld

Text 10,0,"Здраствуй странник!  "
Text 10,20,"Вот познакомься с хозяевами этого дома.... "
Text 10,40,"..это господин: "+name2
Text 10,60,"..и леди : "+name1
Text 10,140,"(имена сгенирированы.вы также можете выбирать длинну генирируемых имен.) "

Flip
WaitKey() 


;---------------------------------------------------------
;nameWords - Сколько букв будет в имени
;                        (больше шести ставить опасно...ваша психика можэт не выдержать таких слов)

;SeedRndName - Использовить сид для выбора букв или нет.
;                            0. Нет
;                            1.Да
;                            >=2.Всё что больше единицы будет считатся за сид. Тоисть если вы хотите фиксированый
;                            сид но дефолтный ( 0 ) сид вам не подходит...вы можете  назнчить его самому использовав
;                            нужное число.
;                            (думаю тут всем понятно что если врубить сид, то имена при
;                                каждом запуске проги будут разные. Если жэ нет, то имена будут фиксироваными.)

;ManOrWoman - Для какого пола генерируется имя.
;                            1. Мужик 
;                            2. Женщина 
;---------------------------------------------------------
Function Rpg_Name_Generator$(nameWords,SeedRndName,ManOrWoman)

    
    If SeedRndName=1
        SeedRnd (MilliSecs()*Rnd(17,MilliSecs))
    ElseIf  SeedRndName>1
        SeedRnd SeedRndName
    EndIf
    
    If ManOrWoman=0 ManOrWoman=1
    var=Abs(nameWords)
    If var=0 var=1

    For i=1 To var
        If i>1
                If temp_var=1    
                    char=mYRnd(16,20,var_for_rnd)
                Else
                    char=mYRnd(1,15,var_for_rnd)
                EndIf
        Else
            char=mYRnd(1,20,var_for_rnd)
        EndIf
        
        If ManOrWoman=1 And i=var char=mYRnd(1,15,var_for_rnd)
        If ManOrWoman=1 And i=var-1 char=mYRnd(16,20,var_for_rnd)
        
        If char<=15
            temp_var=1
            Select char
                Case 1
                    leter$="б"
                Case 2
                    leter$="в"
                Case 3
                    leter$="г"
                Case 4
                    leter$="д"
                Case 5
                    leter$="к"
                Case 6
                    leter$="л"
                Case 7
                    leter$="м"
                Case 8
                    leter$="н"
                Case 9
                    leter$="п"
                Case 10
                    leter$="р"
                Case 11
                    leter$="с"
                Case 12
                    leter$="т"
                Case 13
                    leter$="х"
                Case 14
                    leter$="ч"
                Case 15
                    leter$="ш"
                End Select
        Else        
            temp_var=2
            Select char
                Case 16
                    leter$="а"
                Case 17
                    leter$="е"
                Case 18
                    leter$="о"
                Case 19
                    leter$="у"
                Case 20
                    leter$="э"
            End Select
        EndIf
                var_for_rnd=char
                If i=1 leter$=UpperCyr(leter$)
            
                If ManOrWoman=2
                    If i=var And temp_var=1 leter$="я"
                    If i=var And temp_var=2 leter$="а"    
                EndIf
                name$=name$+leter$
    Next
            
    Return name$
End Function


 Function UpperCyr$(StringCyr$)
Length=Len(StringCyr$):If Length<1 Then Return ""
UpperStringCyr$=""
For i=1 To Length:Symbol=Asc(Upper$(Mid$(StringCyr$,i,1)))
If Symbol>$DF Then Symbol=Symbol-$20:Goto EndXLAT
Select Symbol
Case $A2
Symbol=$A1
Case $B4
Symbol=$A5
Case $B8
Symbol=$A8
Case $BA
Symbol=$AA
Case $BF
Symbol=$AF
End Select
.EndXLAT
UpperStringCyr$=UpperStringCyr$+Chr$(Symbol)
Next
Return UpperStringCyr$
End Function

Function mYRnd% (num1,num2,varRnd)

final=Rand(num1,num2)

While final=varRnd
    SeedRnd MilliSecs()
    final=Rand(num1,num2)
Wend

Return final
End Function