It is currently Wed Jul 08, 2020 1:01 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 2 posts ] 
Author Message
 Post subject: [DEMO] Contagion v0.3
PostPosted: Tue Apr 21, 2020 1:49 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sat Oct 06, 2007 11:20 pm
Posts: 292
Location: France
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:
;======================================================================================
;
;  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 webSite (french) with PB apps : LDVMULTIMEDIA
PB - 5.4x LTS / 5.7x - W10 x64 - Ryzen 7 3700x
Repeat : try : until done = 1


Top
 Profile  
Reply with quote  
 Post subject: Re: [DEMO] Contagion v0.3
PostPosted: Sat Apr 25, 2020 2:11 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sat Oct 06, 2007 11:20 pm
Posts: 292
Location: France
Code Updated

_________________
~Ar-S~

My webSite (french) with PB apps : LDVMULTIMEDIA
PB - 5.4x LTS / 5.7x - W10 x64 - Ryzen 7 3700x
Repeat : try : until done = 1


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 2 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 3 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  
cron

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye