Генератор имен
Накатал генератор имен...может кому пригодится:
Код:
; ************************************************************
; * 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
|
