Create a new version of paste:

New Paste
Syntax Highlighting
;======================================================================================
;
;  CONTAGION v0.1
; 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
  #ESCExit
EndEnumeration

Enumeration spritesss
  #SP_SICK
  #SP_CLEANSICK
  #SP_CLEAN
EndEnumeration

Enumeration
  
  #TimerMove
  #TimerDay
EndEnumeration



;Define startup effect
#AW_BLEND = $80000

Global v$ = "0.1"
Global Lwin, Hwin, Lbt, Hbt, BT_BackCol, BT_TextCol, BT_HoverCol, BT_OutlineCol, StarMIN, StarMAX, MenuFont
Global.b alive = 99
Global.b S=99, PS=0 , M=1

;Etats
#DEAD = 0
#CLEAN = 1
#CLEANSick = 2
#SICK = 3

#LEFT = 0
#RIGHT = 1
#UP = 2
#DOWN = 3

Structure SP
  sprite.b
  x.i
  y.i
  c.i
  spread.f
  life.b
  etat.b
  speed.f
  DirX.b
  DirY.b
EndStructure

Structure INFECTION
  x.i
  y.i
EndStructure


Global Dim PEOPLE.SP(alive)
Global.b NClean,NSick,NDead,NCleanSick
Global NewList Spot.INFECTION()

; *** MODIFIER LA TAILLE DE LA FENETRE ICI
Lwin = 650
Hwin = 600
; *****************************************




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)
  
  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()
  
EndProcedure



Procedure InitializePeople()
  ; 99 personnes saines
  For i = 0 To alive-1
    PEOPLE(i)\sprite = #SP_CLEAN
    PEOPLE(i)\X = Random(Lwin+50,0)
    PEOPLE(i)\Y = Random(Hwin-10,0)
    PEOPLE(i)\c = #Green
    PEOPLE(i)\etat = #CLEAN
    PEOPLE(i)\spread = 0
    PEOPLE(i)\life = 10
    PEOPLE(i)\speed = Random(5,0)
    PEOPLE(i)\DirX = Random(#RIGHT,#LEFT)
    PEOPLE(i)\DirY = Random(#DOWN,#UP)
  Next
  
  ; Patient 0
  PEOPLE(alive)\sprite = #SP_SICK
  PEOPLE(alive)\X = Random(Lwin-55,50)
  PEOPLE(alive)\Y = Random(Hwin-100,50)
  PEOPLE(alive)\c = #Yellow
  PEOPLE(alive)\etat = #CLEANSick
  PEOPLE(alive)\spread = 1
  PEOPLE(alive)\life = 10
  PEOPLE(alive)\speed = Random(3,1)
  PEOPLE(alive)\DirX = Random(#RIGHT,#LEFT)
  PEOPLE(alive)\DirY = Random(#DOWN,#UP)
  
EndProcedure

Procedure MovePeople()
  
  ClearList (spot() )
  
  For A = 0 To alive
    
    ; Spot d'infection
    
    If  PEOPLE(A)\etat = #SICK Or PEOPLE(A)\etat = #CLEANSick
      AddElement ( Spot() )
      Spot()\X = PEOPLE(A)\x
      Spot()\Y = PEOPLE(A)\Y      
    EndIf
  Next
  
  For A = 0 To alive
    
    ;Deplacement des gens
    
    If PEOPLE(A)\DirX = #LEFT
      PEOPLE(A)\X -  PEOPLE(A)\speed
      If PEOPLE(A)\X < -5
        PEOPLE(A)\DirX = #RIGHT
      EndIf
      
    Else
      PEOPLE(A)\X +  PEOPLE(A)\speed
      If PEOPLE(A)\X > Lwin+5
        PEOPLE(A)\DirX = #LEFT
      EndIf
      
    EndIf
    
    If PEOPLE(A)\DirY = #UP
      PEOPLE(A)\Y -  PEOPLE(A)\speed
      If PEOPLE(A)\Y < -5
        PEOPLE(A)\DirY = #DOWN
      EndIf
      
    Else
      PEOPLE(A)\Y +  PEOPLE(A)\speed
      If PEOPLE(A)\Y > Hwin-60
        PEOPLE(A)\DirY = #UP
      EndIf
    EndIf
    
    
    
    
    
    
  Next
  
   ; Test de contamination
   ForEach Spot()

      For i = 0 To alive
      
        If  PEOPLE(i)\etat = #Clean
          If PEOPLE(i)\X > Spot()\X-5 And PEOPLE(i)\X < Spot()\X +10 And PEOPLE(i)\Y > Spot()\Y-5 And PEOPLE(i)\Y < Spot()\Y +10

              Contamination = Random(#SICK,#CLEANSick)
              If Contamination = #SICK
               PEOPLE(i)\etat = #SICK 
               PEOPLE(i)\sprite = #SP_SICK
               M+1
             Else
               PEOPLE(i)\etat = #CLEANSICK
               PEOPLE(i)\sprite = #SP_CLEANSICK
               PS+1
            EndIf
            
          EndIf
        EndIf
        
      Next
      
      
    Next
     
      S=100-(M+PS)
      
      
    SetGadgetText(#TextFooter,"Malade(s) : "+Str(M) + "  /// Porteur(s) saint(s) : "+Str(PS) + "  /// Non contaminé(s) : "+Str(S))
  
  
EndProcedure




Procedure ChangeDir()
  
  For i = 0 To alive
    PEOPLE(i)\DirX = Random(#RIGHT,#LEFT)
    PEOPLE(i)\DirY = Random(#DOWN,#UP)
    PEOPLE(i)\speed = Random(5,0)
  Next
  
  
EndProcedure




Procedure Display()
  
  
  For i= 0 To alive   
    DisplaySprite(PEOPLE(i)\sprite, PEOPLE(i)\X,  PEOPLE(i)\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,Lwin,30,"Contagion  v"+v$ + " ~ by Ar-S",RGB(255, 255, 255), RGB(40, 40, 40), Font1)
    
    ;TEXT FOOTER
     TextColorGadget(#TextFooter,0,Hwin-30,Lwin,30,"Malade(s) : "+Str(M)  + "  /// Porteur(s) saint(s) : "+Str(PS) + "  /// Non contaminé(s) : "+Str(S),RGB(255, 255, 255), RGB(40, 40, 40), Font1)
    
    ;Use Tool start up effect
    AnimateWindow_(WindowID(#Wnd),250,#AW_BLEND)
    HideWindow(#Wnd,#False)
    
    AddWindowTimer(#wnd, #TimerMove, 200)
    
    
    OpenWindowedScreen(WindowID(#wnd),0,30,Lwin,hwin-60)
    CreatSprite()
    InitializePeople()
    
  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 #TimerMove
            
            
            MovePeople()
            count+1
            
            If count = 10
              ChangeDir()
              count = Random(10,0)
            EndIf
            
        EndSelect
        
        
    EndSelect
    
  Until event=0
  
  ; 2D
  FlipBuffers()
  ClearScreen(0)
  Display()
  
  
  Delay(1)
  
ForEver
Optional Paste Settings
Category:
Tags:
Syntax Highlighting:
Paste Expiration:
Paste Exposure:
Folder:
PasswordNEW
Disabled
Burn after read NEW
Paste Name / Title:
Hello Guest
You are currently not logged in, this means you can not edit or delete anything you paste. Sign Up or Login