[DEMO] Contagion v0.3
Publié : mar. 21/avr./2020 13:40

Petite simulation pour montrer la rapidité avec laquelle un virus assez transmissible peut se propager
Il ni a rien de scientifique dans mon code, mais cela donne une image assez parlante de l’intérêt de garder ses distances et de se protéger. Gestes barrières, lavage de main, masque.
Prenez soin de vous !
Carrés blancs : personnes saines
Carrés rouges : personnes malades
Carrés jaunes : porteurs asymptomatique
Carré vert : Personnes guéries /immunisées
Rectangle vert en bas : Zone de confinement.
V0.3
- Les personnes malades passent en confinement, elles ont une chance de rémission et de devenir immunisées ou elles peuvent mourir.
- Les Asympto peuvent tomber plus sérieusement malades et donc se retrouver confinés ou guérir et s'immuniser
- à la fin, lorsque qu'il ni a plus de malade, un bilan apparaît.
Code : Tout sélectionner
;======================================================================================
;
; CONTAGION v0.3
; By Ar-S // PB 5.72 // 21/04/2020
; https://www.purebasic.fr/french/viewtopic.php?f=2&t=18032
;======================================================================================
; Petite simulation pour montrer la rapidité avec laquelle un virus assez transmissible peut se propager
; Il ni a rien de scientifique dans mon code, mais cela donne une image assez parlante de l’intérêt de garder
; ses distances et de se protéger. Gestes barrières, lavage de main, masque.
; Prenez soin de vous !
;
;
; Small simulation To show how fast a fairly communicable virus can spread.
; There's nothing scientific in my code, but it gives a pretty telling picture of the value of keeping one's distance And protecting oneself. Barrier gestures, hand-washing, masks.
; Take care of yourselves.
;======================================================================================
Declare OpenWnd()
Declare TextColorGadget(GadgetID,x,y,l,h,message.s, FrontColor, BackColor, The_font, alignement = #SS_CENTER)
Declare MovePeople()
; DisableDebugger
InitSprite()
Enumeration
#Wnd
#LineTop
#Gadget_LineTop
#LineLeft
#Gadget_LineLeft
#LineRight
#Gadget_LineRight
#LineBottom
#Gadget_LineBottom
#Header
#INFOTEXT
#Frame
#Progressbar
#TextFooter
#Escape
#INFO
EndEnumeration
Enumeration spritesss
#SP_SICK
#SP_CLEANSICK
#SP_CLEAN
#SP_IMU
#ZC
EndEnumeration
Enumeration
#TimerMove
#TimerEvol
EndEnumeration
;Define startup effect
#AW_BLEND = $80000
Global v$ = "0.3"
Global Lwin, Hwin, Lbt, Lworld, Hworld, Hbt, BT_BackCol, BT_TextCol, BT_HoverCol, BT_OutlineCol, StarMIN, StarMAX, MenuFont, Njour = 1
Global.b alive = 99
Global.b S=99, PS=1 , M=0 , dead=0, IM=0
Global Jour$
Global prenom$ = "Charlie,Charlotte,Simone,Flavie,Rosalie,Juliette,Jeanne,Camille,Adele,Maéva,Annabelle,Ophélie,Élodie,Maélie,Océane,Caroline,Sophie,Coralie,Aurélie,Natalie,Justine,Delphine,Mathilde,Magalie"
prenom$+",Isabelle,Gabrielle,Noémie,Margot,Adaline,Amy,Angelique,Arielle,Aubrie,Aubrie,Belle,Claire,Clementine,Clémence,Danielle,Elise,Eloise,Emmy,Estelle,Geneviève,Julie,Louise,Lucille,Marianne,Marie,Valérie,"
prenom$+"Charles,Olivier,Antoine,Nicolas,Loic,Jules,Laurent,Éloi,Léonard,Alexandre,Mathis,Philippe,Damien,Julien,Maxence,Adrien,André,Darrell,Dominique,Guillaume,Maël,Noe,Remy,Travis,Will,Étienne,Ollivier,"
prenom$+"Jerome,Pierre,Stephane,Denis,Diego,Pablo,Sebastien,Kevin,Ursul,Gilles,Malone,Estebane,Thierry,Robin,Tony,Jacques,Jack,Marcel,Marc,Michel,Hector,John,Corantin,"
;Etats
#DEAD = 0
#CLEAN = 1
#CLEANSick = 2
#SICK = 3
#IMU = 4
#LEFT = 0
#RIGHT = 1
#UP = 2
#DOWN = 3
Structure SP
sprite.b
x.i
y.i
confine.b
life.b
etat.b
speed.f
DirX.b
DirY.b
Name.s
EndStructure
Structure INFECTION
x.i
y.i
EndStructure
Global NewList PEOPLE.SP()
Global.b NClean,NSick,NDead,NCleanSick
Global NewList Spot.INFECTION()
; *** MODIFIER LA TAILLE DE LA FENETRE ICI
Lwin = 650
Hwin = 630
Lworld = Lwin
Hworld = hwin-90
; *****************************************
Procedure Bilan()
Protected NC
NC=0
ForEach PEOPLE()
If PEOPLE()\confine = 1
NC+1
EndIf
Next
If NC = dead And PS = 0
Bilan = 1
Else
Bilan = 0
EndIf
ProcedureReturn Bilan
EndProcedure
Procedure TextColorGadget(GadgetID,x,y,l,h,message.s, FrontColor, BackColor, The_font, alignement = #SS_CENTER)
; Ar-S
TextGadget(GadgetID, x, y, l, h, message.s, #SS_CENTERIMAGE|alignement)
SetGadgetColor(GadgetID, #PB_Gadget_FrontColor,FrontColor)
SetGadgetColor(GadgetID, #PB_Gadget_BackColor, BackColor)
SetGadgetFont(GadgetID, FontID(The_font))
EndProcedure
Procedure CreatSprite()
CreateSprite(#SP_SICK,5,5)
CreateSprite(#SP_CLEAN,5,5)
CreateSprite(#SP_CLEANSICK,5,5)
CreateSprite(#SP_IMU,5,5)
CreateSprite(#ZC,Lworld,40)
; Sprites des gens
StartDrawing(SpriteOutput(#SP_sICK))
Box(0,0,5,5,#Red)
StopDrawing()
StartDrawing(SpriteOutput(#SP_CLEANSICK))
Box(0,0,5,5,#Yellow)
StopDrawing()
StartDrawing(SpriteOutput(#SP_CLEAN))
Box(0,0,5,5,$FFFFFF)
StopDrawing()
StartDrawing(SpriteOutput(#SP_IMU))
Box(0,0,5,5,#Green)
StopDrawing()
; Création des zones de confinement
StartDrawing(SpriteOutput(#ZC))
DrawingMode(#PB_2DDrawing_Outlined)
Box(0,0,Lworld,40,#Green)
StopDrawing()
EndProcedure
Procedure InitializePeople()
ClearList( People())
S=99 : M=0 : PS = 1 : IM = 0
; 99 personnes saines
For i = 0 To alive-1
AddElement (PEOPLE())
PEOPLE()\sprite = #SP_CLEAN
PEOPLE()\X = Random(Lworld ,0)
PEOPLE()\Y = Random(Hworld , 50)
PEOPLE()\etat = #CLEAN
PEOPLE()\confine = 0
PEOPLE()\life = 10
PEOPLE()\speed = Random(5,0)
PEOPLE()\DirX = Random(#RIGHT,#LEFT)
PEOPLE()\DirY = Random(#DOWN,#UP)
PEOPLE()\Name = StringField (prenom$,i+1,",")
Next
; Patient 0
AddElement (PEOPLE())
PEOPLE()\Name = StringField (prenom$,100,",")
PEOPLE()\sprite = #SP_CLEANSICK
PEOPLE()\X = Random(Lworld-5,5)
PEOPLE()\Y = Random(Hworld-100,300)
PEOPLE()\etat = #CLEANSick
PEOPLE()\confine = 0
PEOPLE()\life = 7
PEOPLE()\speed = Random(4,1)
PEOPLE()\DirX = Random(#RIGHT,#LEFT)
PEOPLE()\DirY = Random(#DOWN,#UP)
PS = 1
SetGadgetText(#info,UCase( PEOPLE()\name + " est le patient 0 "))
EndProcedure
Procedure MovePeople()
; Les gens bougent
ForEach People()
;Deplacement des gens s'ils ne sont pas confinés
If PEOPLE()\confine = 0
If PEOPLE()\DirX = #LEFT
PEOPLE()\X - PEOPLE()\speed
If PEOPLE()\X <= 0
PEOPLE()\DirX = #RIGHT
EndIf
Else
PEOPLE()\X + PEOPLE()\speed
If PEOPLE()\X >= Lworld-5
PEOPLE()\DirX = #LEFT
EndIf
EndIf
If PEOPLE()\DirY = #UP
PEOPLE()\Y - PEOPLE()\speed
If PEOPLE()\Y <= 0
PEOPLE()\DirY = #DOWN
EndIf
Else
PEOPLE()\Y + PEOPLE()\speed
If PEOPLE()\Y >= Hworld -47
PEOPLE()\DirY = #UP
EndIf
EndIf
EndIf
Next
; Test de contamination
ClearList (spot() )
ForEach People()
; Spot d'infection
If PEOPLE()\etat = #SICK Or PEOPLE()\etat = #CLEANSick
AddElement ( Spot() )
Spot()\X = PEOPLE()\X
Spot()\Y = PEOPLE()\Y
EndIf
Next
ForEach Spot()
ForEach People()
If PEOPLE()\etat = #Clean
; Si une personne saine se trouve sur un spot
If PEOPLE()\X > Spot()\X-5 And PEOPLE()\X < Spot()\X +10 And PEOPLE()\Y > Spot()\Y-5 And PEOPLE()\Y < Spot()\Y +10
Contamination = Random(3,0)
If Contamination = 0
PEOPLE()\etat = #SICK
PEOPLE()\sprite = #SP_SICK
PEOPLE()\life = Random(6,3)
PEOPLE()\Y = Random(Hworld-7,Hworld-39)
; En confinement !
PEOPLE()\confine = 1
SetGadgetColor(#INFO,#PB_Gadget_FrontColor, #Red)
SetGadgetText(#info,UCase (PEOPLE()\name + " tombe malade et est confiné "))
M+1 : S-1
Else
PEOPLE()\etat = #CLEANSICK
PEOPLE()\sprite = #SP_CLEANSICK
PEOPLE()\life = Random(9,6)
SetGadgetColor(#INFO,#PB_Gadget_FrontColor, #Yellow)
SetGadgetText(#info,UCase(PEOPLE()\name + " est devenu porteur asymptomatique "))
PS+1 : S-1
EndIf
EndIf
EndIf
Next
Next
S=100-(M+PS+DEAD+IM)
SetGadgetText(#TextFooter,"Malade(s) : "+Str(M) + " /// Porteur(s) : "+Str(PS) + " /// Non contaminé(s) : "+Str(S) + " /// Mort(s) : "+Str(dead) + " /// Immunisé(s) "+Str(IM))
EndProcedure
Procedure ChangeDir()
ForEach People()
If PEOPLE()\confine = 0; = #CLEAN Or PEOPLE()\etat = #CLEANSick Or PEOPLE()\etat = #IMU
PEOPLE()\DirX = Random(#RIGHT,#LEFT)
PEOPLE()\DirY = Random(#DOWN,#UP)
PEOPLE()\speed = Random(7,0)
EndIf
Next
EndProcedure
Procedure Display()
StartDrawing (ScreenOutput())
DrawText (5,5,Jour$,#Green,$0)
StopDrawing()
DisplaySprite(#ZC, 0, Hworld-40)
ForEach People()
DisplaySprite(PEOPLE()\sprite, PEOPLE()\X, PEOPLE()\Y)
Next
EndProcedure
; MAIN WINDOW
Procedure OpenWnd()
Font1 = LoadFont(#PB_Any, "Segoe UI", 11, #PB_Font_HighQuality)
Font2 = LoadFont(#PB_Any, "Segoe UI", 10, #PB_Font_HighQuality)
Font3 = LoadFont(#PB_Any, "Segoe UI", 9, #PB_Font_HighQuality)
If OpenWindow(#Wnd, Lwin, 311, Lwin, Hwin, " ", #PB_Window_SystemMenu |#PB_Window_ScreenCentered)
SetWindowColor(#Wnd,RGBA(128, 128, 128, 122))
StickyWindow(#Wnd,1)
;HEADER
TextColorGadget(#Header,0,0,Lworld,30,"Contagion v"+v$ + " ~ by Ar-S",RGB(255, 255, 255), RGB(40, 40, 40), Font1)
;TEXT FOOTER
TextColorGadget(#TextFooter,0,Hwin-60,Lwin,30,"Malade(s) : "+Str(M) + " /// Porteur(s) : "+Str(PS) + " /// Non contaminé(s) : "+Str(S) + " /// Mort(s) : "+Str(dead) + " /// Immunisé(s) "+Str(IM),RGB(255, 255, 255), RGB(40, 40, 40), Font1)
StringGadget(#INFO,0,Hwin-30,Lwin,30,"",#PB_String3D_ReadOnly)
SetGadgetColor(#info,#PB_Gadget_BackColor,$0)
SetGadgetColor(#info,#PB_Gadget_FrontColor,#Green)
;Use Tool start up effect
AnimateWindow_(WindowID(#Wnd),250,#AW_BLEND)
HideWindow(#Wnd,#False)
AddWindowTimer(#wnd, #TimerMove, 200)
AddWindowTimer(#wnd, #TimerEvol, 10000)
OpenWindowedScreen(WindowID(#wnd),0,30,Lworld,Hworld)
CreatSprite()
InitializePeople()
Jour$ = "Jour " + Str(Njour)
EndIf
EndProcedure
OpenWnd()
Repeat
Repeat
Event = WindowEvent()
Select Event
Case #PB_Event_Gadget
Case #PB_Event_CloseWindow
End
Case #PB_Event_Timer
Select EventTimer()
Case #TimerEvol
Jour$ = "Jour " + Str(Njour)
; Evolution de la santé
ForEach People()
Select PEOPLE()\etat
Case #Sick
If PEOPLE()\confine = 1 And PEOPLE()\Y < Hworld-39
PEOPLE()\Y = Random(Hworld-7,Hworld-39)
EndIf
DesDeLaVie = Random(2,0)
Select DesDeLaVie
Case 0,1
PEOPLE()\life -1
Case 2
PEOPLE()\life +1
EndSelect
If PEOPLE()\life >= 10
PEOPLE()\etat = #IMU
PEOPLE()\sprite = #SP_IMU
M-1
IM+1
SetGadgetColor(#INFO,#PB_Gadget_FrontColor, #Green)
SetGadgetText(#info,UCase(" -- YEAH -- " + PEOPLE()\name + " est guerrit et immunisé :) "))
PEOPLE()\confine = 0
PEOPLE()\life = 10
ElseIf PEOPLE()\life = 0
PEOPLE()\etat = #DEAD
DEAD+1
M-1
PEOPLE()\confine = 1
SetGadgetColor(#INFO,#PB_Gadget_FrontColor, #Red)
SetGadgetText(#info,UCase(" -- NOOO -- " + PEOPLE()\name + " est mort :[ "))
PEOPLE()\Y = Hwin+10
EndIf
Case #CLEANSick
DesDeLaVie = Random(2,0)
Select DesDeLaVie
Case 0
PEOPLE()\life -1
Case 1,2
PEOPLE()\life +1
EndSelect
If PEOPLE()\life >= 10
PEOPLE()\etat = #IMU
PEOPLE()\sprite = #SP_IMU
life = 10
PS-1
IM+1
SetGadgetColor(#INFO,#PB_Gadget_FrontColor, #Green)
SetGadgetText(#info,UCase(" -- YEAH -- " + PEOPLE()\name + " est guerrit et immunisé :) "))
PEOPLE()\confine = 0
PEOPLE()\life = 10
ElseIf PEOPLE()\life < 6 And PEOPLE()\life > 0
PEOPLE()\etat = #SICK
PEOPLE()\sprite = #SP_SICK
M+1
PS-1
PEOPLE()\confine = 1
SetGadgetColor(#INFO,#PB_Gadget_FrontColor, #Yellow)
SetGadgetText(#info,UCase(" HUM.. " + PEOPLE()\name + " est devenu porteur asymptomatique "))
ElseIf PEOPLE()\life = 0
PEOPLE()\etat = #DEAD
DEAD+1
M-1
SetGadgetColor(#INFO,#PB_Gadget_FrontColor, #Red)
SetGadgetText(#info,UCase(" -- NOOO -- " + PEOPLE()\name + " est mort :[ "))
PEOPLE()\Y = Hwin+10
PEOPLE()\confine = 1
EndIf
EndSelect
Next
Njour+1
If Bilan() = 1 And PASS = 0
RemoveWindowTimer(#WND, #TimerMove)
RemoveWindowTimer(#WND, #TimerEvol)
ClearScreen(0)
Q=MessageRequester("Information","En "+Str(Njour)+ " jours."+Chr(10)+"Sur 100 personnes, cette épidémie a fait "+Str(dead) +" morts"+Chr(10)+ Str(S) + " personnes n'ont pas été touché."+Chr(10)+ Str(im+dead) + " ont contractés la maladie dont "+Str(IM) +" ont guérri et sont maintenant immunisées."+Chr(10)+"Souhaitez vous relancer une simulation ?",#PB_MessageRequester_YesNo)
Select Q
Case #PB_MessageRequester_Yes
AddWindowTimer(#wnd, #TimerMove, 200)
AddWindowTimer(#wnd, #TimerEvol, 10000)
InitializePeople()
Njour = 1
Jour$ = "Jour " + Str(Njour)
AddWindowTimer(#wnd, #TimerMove, 200)
AddWindowTimer(#wnd, #TimerEvol, 10000)
ClearScreen(0)
StartDrawing (ScreenOutput())
DrawText (5,5,Jour$,#Green,$0)
StopDrawing()
Case #PB_MessageRequester_No
End
EndSelect
EndIf
Case #TimerMove
count+1
MovePeople()
If count = 10
ChangeDir()
count = Random(9,0)
EndIf
EndSelect
EndSelect
Until event=0
; 2D
FlipBuffers()
ClearScreen(0)
Display()
Delay(1)
ForEver