[DEMO] Contagion v0.3

Advanced game related topics
User avatar
ar-s
Enthusiast
Enthusiast
Posts: 340
Joined: Sat Oct 06, 2007 11:20 pm
Location: France

[DEMO] Contagion v0.3

Post by ar-s »

Image

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



~Ar-S~
My Image Hoster for PB users
My webSite (french) with PB apps : LDVMULTIMEDIA
PB - 3.x / 5.7x / 6 - W11 x64 - Ryzen 7 3700x / #Rpi4

Code: Select all

r3p347 : 7ry : un71l d0n3 = 1
User avatar
ar-s
Enthusiast
Enthusiast
Posts: 340
Joined: Sat Oct 06, 2007 11:20 pm
Location: France

Re: [DEMO] Contagion v0.3

Post by ar-s »

Code Updated
~Ar-S~
My Image Hoster for PB users
My webSite (french) with PB apps : LDVMULTIMEDIA
PB - 3.x / 5.7x / 6 - W11 x64 - Ryzen 7 3700x / #Rpi4

Code: Select all

r3p347 : 7ry : un71l d0n3 = 1
Post Reply