Yo,
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.
White Squares: Healthy People
Red squares: sick people
Yellow squares: asymptomatic carriers
Green square: Healed/immunized persons
Green rectangle at the bottom: Containment zone.
V0.3
- Sick people go into containment, they have a chance of remission and become immune or they may die.
- Asympto can become more seriously ill and thus become confined or recover and become immune.
- at the end, when he or she is no longer sick, a check-up appears.
Translated with http://www.DeepL.com/Translator (free version)
Code: Select all
;======================================================================================
;
; 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 celà donne une image assez parlante de l'intéret 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