je profite d'être bloqué chez moi pendant une semaine, pour jouer avec la dernière version de Purebasic.
Ce langage est vraiment de mieux en mieux.
J'ai un projet qui traîne depuis quelques années dans mes cartons.
il s'agit de créer une simulation de population pour créer des soirées enquêtes.
L'idée est de partir d'un lieu totalement vierge, genre une île. de faire venir a une certaine date un certain nombre de personne... que ces personnes evoluent, se marient, aient des enfants qui eux aussi évoluent, se marient ont des enfants etc... et que de tant a autre je puisse rajouter l'arrivé de nouvelle personne. etc, etc....
L'idée est peu a peu de poussé le vis, que l'algo intègre le choix d'un travaille, des amis, des maladies, des accidents, Des lieu d'habitations, des déménagements etc...
voici un tout debut de code qui ne gère qu'une première génération ... qu'en pensez vous ? si vous avez des suggestions pour organiser mieux le code je suis preneur.
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)
)
(meme MOA ! 
)