PureBasic

Code : Tout sélectionner

Structure populate
  currentDate.i
  ageMin.l
  ageMax.l
EndStructure


Structure person
  mother.i
  father.i
  origine.s
  birthday.i
  deathday.i
  sex.b
  firstname.s
  name.s
  birthName.s
  married.i
  weddingday.i
  nbChildren.l
EndStructure


Global Dim person.person(0)
InitNetwork()

Procedure newName(z,firstnameOnly=#False)
  url$="http://www.behindthename.com/random/random.php?number=2"
  If person(z)\sex=0
    url$=url$+"&gender=m"
  Else
    url$=url$+"&gender=m"
  EndIf
  url$=url$+"&surname=&all=no"
  Select LCase(person(z)\origine)
    Case "English"
      url$=url$+"&usage_eng=1"
    Case  "African"
      url$=url$+"&usage_afr=1"
    Case "French"
      url$=url$+"usage_fre=1"
    Case "Chinese"
      url$=url$+"usage_chi=1"
    Default 
      url$=url$+"&usage_afr=1"
  EndSelect
  FileName$=GetTemporaryDirectory()+"tmp.txt"
  ReceiveHTTPFile(url$, FileName$)
  
  code$=""
  If ReadFile(0, GetTemporaryDirectory()+"tmp.txt")  
    While Eof(0) = 0           ; Boucle tant que la fin du fichier n'est pas atteinte. (Eof = 'End Of File') 
      code$=code$+ReadString(0)      ; Affiche ligne par ligne le contenu du fichier
    Wend
    CloseFile(0)
  EndIf
  
  s.l=FindString(code$,"Your random name is:",0)
  s.l=FindString(code$,"<a href=",s)
  Repeat
    s=s+1
  Until Mid(code$,s,1)=">"
  e=s
  Repeat
    e=e+1
  Until Mid(code$,e,1)="<"
  person(z)\firstname=Mid(code$,s+1,e-s-1)
  If firstnameOnly=#False
    s=e
    s.l=FindString(code$,"<a href=",s)
    Repeat
      s=s+1
    Until Mid(code$,s,1)=">"
    e=s
    Repeat
      e=e+1
    Until Mid(code$,e,1)="<"
    person(z)\name=Mid(code$,s+1,e-s-1)
  EndIf
EndProcedure

Procedure addperson(birthday.i,deathday.i,father.i=-1,mother.i=-1)
  ;We add a new person in array
  size=ArraySize(person())+1
  ReDim person.person(size)
  n=size-1
  person(n)\father=father
  person(n)\mother=mother
  If mother=-1
    person(n)\birthday=birthday
  Else
    person(n)\birthday=person(mother)\weddingday
  EndIf
  person(n)\deathday=deathday
  person(n)\sex=Random(1) ; 0 = Male and 1 = Femmel 
  person(n)\married=-1
  If mother>-1
    NewName(n,#True)
    If father>-1
      person(n)\name=person(father)\name
    Else
      person(n)\name=person(mother)\name
    EndIf
  Else
    NewName(n,#False)
    
  EndIf
  Debug Str(n)+" "+person(n)\firstname+" "+person(n)\name
EndProcedure

Procedure Live(number.l,*populate.populate)
  fromPerson=ArraySize(person())
  toPerson=fromperson+number
  For z=0 To toPerson
    age.l=Random(*populate\ageMax,*populate\ageMin)
    birthday.i=*populate\currentDate-age
    deathday.i=birthday+Random(70,age)
    addperson(birthday,deathday)
    
  Next
  
  For z=0 To toPerson
    sex.b=person(z)\sex
    If person(z)\married=-1 And person(z)\sex=0
      For w=0 To toPerson
        If person(w)\married=-1 And person(w)\sex=1 And                                                          ;If a man and not married
           person(w)\birthday>=person(z)\birthday-5 And person(w)\birthday<=person(z)\birthday And              ;if man and woman have the same age (5 year)
           ((person(w)\mother<>person(z)\mother And person(w)\father<>person(z)\father) Or person(z)\mother=-1) ;must 
          
          weddingday=person(w)\birthday+Random(45,16)
          If person(w)\deathday>weddingday And person(z)\deathday>weddingday
            person(n)\weddingday=weddingday
            person(z)\married=w
            person(w)\married=z
            Debug Str(person(z)\married)+" with "+Str(person(w)\married)
            person(w)\birthName=person(w)\name
            person(w)\name=person(z)\name
            nbChildren=Random(5,0)
            year=0
            Debug "child from "+person(z)\firstname+" "+person(z)\name+" and "+person(w)\firstname+" "+person(w)\name
            For child=1 To nbChildren
              year=year+1
              birthday=person(w)\weddingday+year
              addperson(birthday,birthday+Random(80),z,w)
            Next
          EndIf
          Break
        EndIf
      Next
    EndIf
   Next
EndProcedure

;Une première arrivée de personne
populate.populate
populate\currentDate=1750
populate\ageMin=13
populate\ageMax=50

live(20,@populate)

Code : Tout sélectionner

#CPLBATOR = #BADF00D
#GOD      = #CPLBATOR

Structure person
  *mother.person
  *father.person
  List *brother.person()
  List *sister.person()
  
  ; ...
EndStructure


FirstMale.person
FirstFemale.person

FirstMale\mother = #GOD
FirstMale\father = #GOD

FirstFemale\mother = #GOD
FirstFemale\father = #GOD