API tools faq
paste
Advertisement
LDVM

CONTAGION

LDVM
Apr 21st, 2020
2,920
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
PureBasic 7.79 KB | None | 0 0
raw download clone embed print report
  1. ;======================================================================================
  2. ;
  3. ;  CONTAGION v0.1
  4. ; By Ar-S // PB 5.72 // 21/04/2020
  5. ; https://www.purebasic.fr/french/viewtopic.php?f=2&t=18032
  6. ;======================================================================================
  7. ; Petite simulation pour montrer la rapidité avec laquelle un virus assez transmissible peut se propager
  8. ; Il ni a rien de scientifique dans mon code, mais celà donne une image assez parlante de l'intéret de garder
  9. ; ses distances et de se protéger. Gestes barrières, lavage de main, masque.
  10. ; Prenez soin de vous !
  11. ;
  12. ;  Small simulation To show how fast a fairly communicable virus can spread.
  13. ;  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.
  14. ; Take care of yourselves.
  15. ;======================================================================================
  16.  
  17. Declare OpenWnd()
  18. Declare TextColorGadget(GadgetID,x,y,l,h,message.s, FrontColor, BackColor, The_font, alignement = #SS_CENTER)
  19. Declare MovePeople()
  20.  
  21. DisableDebugger
  22.  
  23. InitSprite()
  24.  
  25. Enumeration
  26.   #Wnd
  27.   #LineTop
  28.   #Gadget_LineTop
  29.   #LineLeft
  30.   #Gadget_LineLeft
  31.   #LineRight
  32.   #Gadget_LineRight
  33.   #LineBottom
  34.   #Gadget_LineBottom
  35.   #Header
  36.   #INFOTEXT
  37.   #Frame
  38.   #Progressbar
  39.   #TextFooter
  40.   #Escape
  41.   #ESCExit
  42. EndEnumeration
  43.  
  44. Enumeration spritesss
  45.   #SP_SICK
  46.   #SP_CLEANSICK
  47.   #SP_CLEAN
  48. EndEnumeration
  49.  
  50. Enumeration
  51.  
  52.   #TimerMove
  53.   #TimerDay
  54. EndEnumeration
  55.  
  56.  
  57.  
  58. ;Define startup effect
  59. #AW_BLEND = $80000
  60.  
  61. Global v$ = "0.1"
  62. Global Lwin, Hwin, Lbt, Hbt, BT_BackCol, BT_TextCol, BT_HoverCol, BT_OutlineCol, StarMIN, StarMAX, MenuFont
  63. Global.b alive = 99
  64. Global.b S=99, PS=0 , M=1
  65.  
  66. ;Etats
  67. #DEAD = 0
  68. #CLEAN = 1
  69. #CLEANSick = 2
  70. #SICK = 3
  71.  
  72. #LEFT = 0
  73. #RIGHT = 1
  74. #UP = 2
  75. #DOWN = 3
  76.  
  77. Structure SP
  78.   sprite.b
  79.   x.i
  80.   y.i
  81.   c.i
  82.   spread.f
  83.   life.b
  84.   etat.b
  85.   speed.f
  86.   DirX.b
  87.   DirY.b
  88. EndStructure
  89.  
  90. Structure INFECTION
  91.   x.i
  92.   y.i
  93. EndStructure
  94.  
  95.  
  96. Global Dim PEOPLE.SP(alive)
  97. Global.b NClean,NSick,NDead,NCleanSick
  98. Global NewList Spot.INFECTION()
  99.  
  100. ; *** MODIFIER LA TAILLE DE LA FENETRE ICI
  101. Lwin = 650
  102. Hwin = 600
  103. ; *****************************************
  104.  
  105.  
  106.  
  107.  
  108. Procedure TextColorGadget(GadgetID,x,y,l,h,message.s, FrontColor, BackColor, The_font, alignement = #SS_CENTER)
  109.   ; Ar-S
  110.   TextGadget(GadgetID, x, y, l, h, message.s, #SS_CENTERIMAGE|alignement)
  111.   SetGadgetColor(GadgetID, #PB_Gadget_FrontColor,FrontColor)
  112.   SetGadgetColor(GadgetID, #PB_Gadget_BackColor, BackColor)
  113.   SetGadgetFont(GadgetID, FontID(The_font))
  114.  
  115. EndProcedure
  116.  
  117.  
  118. Procedure CreatSprite()
  119.  
  120.   CreateSprite(#SP_SICK,5,5)
  121.   CreateSprite(#SP_CLEAN,5,5)
  122.   CreateSprite(#SP_CLEANSICK,5,5)
  123.  
  124.   StartDrawing(SpriteOutput(#SP_sICK))
  125.   Box(0,0,5,5,#Red)
  126.   StopDrawing()
  127.  
  128.   StartDrawing(SpriteOutput(#SP_CLEANSICK))
  129.   Box(0,0,5,5,#Yellow)
  130.   StopDrawing()
  131.  
  132.   StartDrawing(SpriteOutput(#SP_CLEAN))
  133.   Box(0,0,5,5,$FFFFFF)
  134.   StopDrawing()
  135.  
  136. EndProcedure
  137.  
  138.  
  139.  
  140. Procedure InitializePeople()
  141.   ; 99 personnes saines
  142.   For i = 0 To alive-1
  143.     PEOPLE(i)\sprite = #SP_CLEAN
  144.     PEOPLE(i)\X = Random(Lwin+50,0)
  145.     PEOPLE(i)\Y = Random(Hwin-10,0)
  146.     PEOPLE(i)\c = #Green
  147.     PEOPLE(i)\etat = #CLEAN
  148.     PEOPLE(i)\spread = 0
  149.     PEOPLE(i)\life = 10
  150.     PEOPLE(i)\speed = Random(5,0)
  151.     PEOPLE(i)\DirX = Random(#RIGHT,#LEFT)
  152.     PEOPLE(i)\DirY = Random(#DOWN,#UP)
  153.   Next
  154.  
  155.   ; Patient 0
  156.   PEOPLE(alive)\sprite = #SP_SICK
  157.   PEOPLE(alive)\X = Random(Lwin-55,50)
  158.   PEOPLE(alive)\Y = Random(Hwin-100,50)
  159.   PEOPLE(alive)\c = #Yellow
  160.   PEOPLE(alive)\etat = #CLEANSick
  161.   PEOPLE(alive)\spread = 1
  162.   PEOPLE(alive)\life = 10
  163.   PEOPLE(alive)\speed = Random(3,1)
  164.   PEOPLE(alive)\DirX = Random(#RIGHT,#LEFT)
  165.   PEOPLE(alive)\DirY = Random(#DOWN,#UP)
  166.  
  167. EndProcedure
  168.  
  169. Procedure MovePeople()
  170.  
  171.   ClearList (spot() )
  172.  
  173.   For A = 0 To alive
  174.    
  175.     ; Spot d'infection
  176.    
  177.     If  PEOPLE(A)\etat = #SICK Or PEOPLE(A)\etat = #CLEANSick
  178.       AddElement ( Spot() )
  179.       Spot()\X = PEOPLE(A)\x
  180.       Spot()\Y = PEOPLE(A)\Y      
  181.     EndIf
  182.   Next
  183.  
  184.   For A = 0 To alive
  185.    
  186.     ;Deplacement des gens
  187.    
  188.     If PEOPLE(A)\DirX = #LEFT
  189.       PEOPLE(A)\X -  PEOPLE(A)\speed
  190.       If PEOPLE(A)\X < -5
  191.         PEOPLE(A)\DirX = #RIGHT
  192.       EndIf
  193.      
  194.     Else
  195.       PEOPLE(A)\X +  PEOPLE(A)\speed
  196.       If PEOPLE(A)\X > Lwin+5
  197.         PEOPLE(A)\DirX = #LEFT
  198.       EndIf
  199.      
  200.     EndIf
  201.    
  202.     If PEOPLE(A)\DirY = #UP
  203.       PEOPLE(A)\Y -  PEOPLE(A)\speed
  204.       If PEOPLE(A)\Y < -5
  205.         PEOPLE(A)\DirY = #DOWN
  206.       EndIf
  207.      
  208.     Else
  209.       PEOPLE(A)\Y +  PEOPLE(A)\speed
  210.       If PEOPLE(A)\Y > Hwin-60
  211.         PEOPLE(A)\DirY = #UP
  212.       EndIf
  213.     EndIf
  214.    
  215.    
  216.    
  217.    
  218.    
  219.    
  220.   Next
  221.  
  222.    ; Test de contamination
  223.    ForEach Spot()
  224.  
  225.       For i = 0 To alive
  226.      
  227.         If  PEOPLE(i)\etat = #Clean
  228.           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
  229.  
  230.               Contamination = Random(#SICK,#CLEANSick)
  231.               If Contamination = #SICK
  232.                PEOPLE(i)\etat = #SICK
  233.                PEOPLE(i)\sprite = #SP_SICK
  234.                M+1
  235.              Else
  236.                PEOPLE(i)\etat = #CLEANSICK
  237.                PEOPLE(i)\sprite = #SP_CLEANSICK
  238.                PS+1
  239.             EndIf
  240.            
  241.           EndIf
  242.         EndIf
  243.        
  244.       Next
  245.      
  246.      
  247.     Next
  248.      
  249.       S=100-(M+PS)
  250.      
  251.      
  252.     SetGadgetText(#TextFooter,"Malade(s) : "+Str(M) + "  /// Porteur(s) saint(s) : "+Str(PS) + "  /// Non contaminé(s) : "+Str(S))
  253.  
  254.  
  255. EndProcedure
  256.  
  257.  
  258.  
  259.  
  260. Procedure ChangeDir()
  261.  
  262.   For i = 0 To alive
  263.     PEOPLE(i)\DirX = Random(#RIGHT,#LEFT)
  264.     PEOPLE(i)\DirY = Random(#DOWN,#UP)
  265.     PEOPLE(i)\speed = Random(5,0)
  266.   Next
  267.  
  268.  
  269. EndProcedure
  270.  
  271.  
  272.  
  273.  
  274. Procedure Display()
  275.  
  276.  
  277.   For i= 0 To alive  
  278.     DisplaySprite(PEOPLE(i)\sprite, PEOPLE(i)\X,  PEOPLE(i)\Y)
  279.   Next
  280.  
  281.  
  282. EndProcedure
  283.  
  284.  
  285.  
  286.  
  287.  
  288. ; MAIN WINDOW
  289. Procedure OpenWnd()
  290.   Font1 = LoadFont(#PB_Any, "Segoe UI", 11, #PB_Font_HighQuality)
  291.   Font2 = LoadFont(#PB_Any, "Segoe UI", 10, #PB_Font_HighQuality)
  292.   Font3 = LoadFont(#PB_Any, "Segoe UI", 9, #PB_Font_HighQuality)
  293.  
  294.   If OpenWindow(#Wnd, Lwin, 311, Lwin, Hwin, " ", #PB_Window_SystemMenu |#PB_Window_ScreenCentered)
  295.     SetWindowColor(#Wnd,RGBA(128, 128, 128, 122))
  296.    
  297.     StickyWindow(#Wnd,1)
  298.    
  299.     ;HEADER
  300.     TextColorGadget(#Header,0,0,Lwin,30,"Contagion  v"+v$ + " ~ by Ar-S",RGB(255, 255, 255), RGB(40, 40, 40), Font1)
  301.    
  302.     ;TEXT FOOTER
  303.      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)
  304.    
  305.     ;Use Tool start up effect
  306.     AnimateWindow_(WindowID(#Wnd),250,#AW_BLEND)
  307.     HideWindow(#Wnd,#False)
  308.    
  309.     AddWindowTimer(#wnd, #TimerMove, 200)
  310.    
  311.    
  312.     OpenWindowedScreen(WindowID(#wnd),0,30,Lwin,hwin-60)
  313.     CreatSprite()
  314.     InitializePeople()
  315.    
  316.   EndIf
  317. EndProcedure
  318.  
  319. OpenWnd()
  320.  
  321. Repeat
  322.   Repeat
  323.     Event = WindowEvent()
  324.    
  325.     Select Event
  326.       Case #PB_Event_Gadget
  327.        
  328.        
  329.       Case #PB_Event_CloseWindow
  330.         End
  331.        
  332.        
  333.       Case #PB_Event_Timer
  334.         Select EventTimer()
  335.            
  336.           Case #TimerMove
  337.            
  338.            
  339.             MovePeople()
  340.             count+1
  341.            
  342.             If count = 10
  343.               ChangeDir()
  344.               count = Random(10,0)
  345.             EndIf
  346.            
  347.         EndSelect
  348.        
  349.        
  350.     EndSelect
  351.    
  352.   Until event=0
  353.  
  354.   ; 2D
  355.   FlipBuffers()
  356.   ClearScreen(0)
  357.   Display()
  358.  
  359.  
  360.   Delay(1)
  361.  
  362. ForEver
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!