Author Topic: Pandemic Simulation (joint effort with Fellippe!)  (Read 4715 times)

0 Members and 1 Guest are viewing this topic.

Offline loudar

  • Newbie
  • Posts: 73
  • improve it bit by bit.
    • View Profile
Pandemic Simulation (joint effort with Fellippe!)
« on: July 20, 2020, 03:21:55 pm »
Hey everyone!

Fellippe started this pandemic simulator and I had too much fun messing around with it, so I added replay, saving and opening to and from files!
I used the file dialog code from Jobert14!

Hope you enjoy it as much as I do, attached are some screenshots of my simulations :D

UPDATES:
The Hospital Update: https://www.qb64.org/forum/index.php?topic=2827.msg120956#msg120956
The Distanced Update: https://www.qb64.org/forum/index.php?topic=2827.msg121043#msg121043

Code: QB64: [Select]
  1.  
  2. SCREEN _NEWIMAGE(1920, 1080, 32)
  3. _TITLE "Pandemic"
  4.  
  5. ' Dialog flag constants (use + or OR to use more than 1 flag value)
  6. CONST OFN_ALLOWMULTISELECT = &H200& '  Allows the user to select more than one file, not recommended!
  7. CONST OFN_CREATEPROMPT = &H2000& '     Prompts if a file not found should be created(GetOpenFileName only).
  8. CONST OFN_EXTENSIONDIFFERENT = &H400& 'Allows user to specify file extension other than default extension.
  9. CONST OFN_FILEMUSTEXIST = &H1000& '    Chechs File name exists(GetOpenFileName only).
  10. CONST OFN_HIDEREADONLY = &H4& '        Hides read-only checkbox(GetOpenFileName only)
  11. CONST OFN_NOCHANGEDIR = &H8& '         Restores the current directory to original value if user changed
  12. CONST OFN_NODEREFERENCELINKS = &H100000& 'Returns path and file name of selected shortcut(.LNK) file instead of file referenced.
  13. CONST OFN_NONETWORKBUTTON = &H20000& ' Hides and disables the Network button.
  14. CONST OFN_NOREADONLYRETURN = &H8000& ' Prevents selection of read-only files, or files in read-only subdirectory.
  15. CONST OFN_NOVALIDATE = &H100& '        Allows invalid file name characters.
  16. CONST OFN_OVERWRITEPROMPT = &H2& '     Prompts if file already exists(GetSaveFileName only)
  17. CONST OFN_PATHMUSTEXIST = &H800& '     Checks Path name exists (set with OFN_FILEMUSTEXIST).
  18. CONST OFN_READONLY = &H1& '            Checks read-only checkbox. Returns if checkbox is checked
  19. CONST OFN_SHAREAWARE = &H4000& '       Ignores sharing violations in networking
  20. CONST OFN_SHOWHELP = &H10& '           Shows the help button (useless!)
  21. '--------------------------------------------------------------------------------------------
  22.  
  23. TYPE FILEDIALOGTYPE
  24.     $IF 32BIT THEN
  25.     lStructSize AS LONG '        For the DLL call
  26.     hwndOwner AS LONG '          Dialog will hide behind window when not set correctly
  27.     hInstance AS LONG '          Handle to a module that contains a dialog box template.
  28.     lpstrFilter AS _OFFSET '     Pointer of the string of file filters
  29.     lpstrCustFilter AS _OFFSET
  30.     nMaxCustFilter AS LONG
  31.     nFilterIndex AS LONG '       One based starting filter index to use when dialog is called
  32.     lpstrFile AS _OFFSET '       String full of 0's for the selected file name
  33.     nMaxFile AS LONG '           Maximum length of the string stuffed with 0's minus 1
  34.     lpstrFileTitle AS _OFFSET '  Same as lpstrFile
  35.     nMaxFileTitle AS LONG '      Same as nMaxFile
  36.     lpstrInitialDir AS _OFFSET ' Starting directory
  37.     lpstrTitle AS _OFFSET '      Dialog title
  38.     flags AS LONG '              Dialog flags
  39.     nFileOffset AS INTEGER '     Zero-based offset from path beginning to file name string pointed to by lpstrFile
  40.     nFileExtension AS INTEGER '  Zero-based offset from path beginning to file extension string pointed to by lpstrFile.
  41.     lpstrDefExt AS _OFFSET '     Default/selected file extension
  42.     lCustData AS LONG
  43.     lpfnHook AS LONG
  44.     lpTemplateName AS _OFFSET
  45.     $ELSE
  46.         lStructSize AS _OFFSET '      For the DLL call
  47.         hwndOwner AS _OFFSET '        Dialog will hide behind window when not set correctly
  48.         hInstance AS _OFFSET '        Handle to a module that contains a dialog box template.
  49.         lpstrFilter AS _OFFSET '      Pointer of the string of file filters
  50.         lpstrCustFilter AS LONG
  51.         nMaxCustFilter AS LONG
  52.         nFilterIndex AS _INTEGER64 '  One based starting filter index to use when dialog is called
  53.         lpstrFile AS _OFFSET '        String full of 0's for the selected file name
  54.         nMaxFile AS _OFFSET '         Maximum length of the string stuffed with 0's minus 1
  55.         lpstrFileTitle AS _OFFSET '   Same as lpstrFile
  56.         nMaxFileTitle AS _OFFSET '    Same as nMaxFile
  57.         lpstrInitialDir AS _OFFSET '  Starting directory
  58.         lpstrTitle AS _OFFSET '       Dialog title
  59.         flags AS _INTEGER64 '         Dialog flags
  60.         nFileOffset AS _INTEGER64 '   Zero-based offset from path beginning to file name string pointed to by lpstrFile
  61.         nFileExtension AS _INTEGER64 'Zero-based offset from path beginning to file extension string pointed to by lpstrFile.
  62.         lpstrDefExt AS _OFFSET '      Default/selected file extension
  63.         lCustData AS _INTEGER64
  64.         lpfnHook AS _INTEGER64
  65.         lpTemplateName AS _OFFSET
  66.     $END IF
  67.  
  68. DECLARE DYNAMIC LIBRARY "comdlg32" ' Library declarations using _OFFSET types
  69.     FUNCTION GetOpenFileNameA& (DIALOGPARAMS AS FILEDIALOGTYPE) ' The Open file dialog
  70.     FUNCTION GetSaveFileNameA& (DIALOGPARAMS AS FILEDIALOGTYPE) ' The Save file dialog
  71.  
  72.     FUNCTION FindWindow& (BYVAL ClassName AS _OFFSET, WindowName$) ' To get hWnd handle
  73.  
  74. hWnd& = _WINDOWHANDLE 'FindWindow(0, "Pandemic" + CHR$(0)) 'get window handle using _TITLE string
  75. DIM SHARED restartreplay
  76.  
  77. TYPE object
  78.     x AS SINGLE
  79.     y AS SINGLE
  80.     w AS INTEGER
  81.     h AS INTEGER
  82.     size AS INTEGER
  83.     xv AS SINGLE
  84.     yv AS SINGLE
  85.     speed AS SINGLE
  86.     state AS _BYTE '1 = healthy; 2 = contamined; 3 = dead; 4 = recovered
  87.     start AS SINGLE
  88.     c AS _UNSIGNED LONG
  89.  
  90. maxseconds = 5000
  91. DIM SHARED healthy(maxseconds)
  92. DIM SHARED contamined(maxseconds)
  93. DIM SHARED dead(maxseconds)
  94. DIM SHARED recovered(maxseconds)
  95.  
  96. TYPE chance
  97.     infection AS SINGLE
  98.     death AS SINGLE
  99.     statechange AS SINGLE
  100.     reinfection AS SINGLE
  101. DIM SHARED chance AS chance
  102.  
  103. DIM collision AS object
  104. DIM SHARED safedistance
  105. REDIM SHARED wall(0) AS object
  106. 'outer walls
  107. pandemicWindow 0, 0, _WIDTH, _HEIGHT - 180
  108. DIM SHARED graphlx: DIM SHARED graphly: DIM SHARED graphux: DIM SHARED graphuy
  109. graphlx = 15
  110. graphly = _HEIGHT - 150
  111. graphux = _WIDTH / 2
  112. graphuy = _HEIGHT - 20
  113.  
  114. '--------------------------------------------------------------------------------------------------------
  115.  
  116. 'variation
  117. maxpeople = 300
  118. totalInfected = 5
  119. peoplesize = 2
  120. sd = 2 'in meters
  121. scale = 5
  122. safedistance = sd * scale
  123.  
  124. 'chances
  125. chance.infection = 0.3
  126. chance.death = 0.025
  127. chance.statechange = 14 'amount in days
  128. chance.reinfection = 0.001
  129.  
  130. '--------------------------------------------------------------------------------------------------------
  131.  
  132. DIM SHARED o(maxpeople) AS object
  133.  
  134. c(1) = _RGB32(50, 200, 55)
  135. c(2) = _RGB32(205, 0, 0)
  136. c(3) = _RGB32(67)
  137. c(4) = _RGB32(222, 144, 0)
  138.  
  139. DIM SHARED saved
  140. restart:
  141. IF _FILEEXISTS("replay.dat") THEN KILL "replay.dat" 'prevents playing old replays and sort of bugging out lol
  142. saved = 0
  143. OPEN "replay.dat" FOR BINARY AS #1
  144. FOR i = 1 TO UBOUND(o)
  145.     o(i).size = peoplesize
  146.     DO
  147.         o(i).x = RND * _WIDTH
  148.         o(i).y = RND * (_HEIGHT - 200)
  149.         retry = 0
  150.         FOR j = 1 TO UBOUND(wall) 'prevent creation of individuals inside walls
  151.             IF rectCirc(wall(j), o(i), collision) THEN
  152.                 retry = -1
  153.                 EXIT FOR
  154.             END IF
  155.         NEXT
  156.     LOOP WHILE retry
  157.     o(i).xv = RND * 1 'different random values for more realist
  158.     o(i).yv = RND * 1
  159.     IF INT(RND + 0.5) = 1 THEN
  160.         flip = 1
  161.     ELSE
  162.         flip = -1
  163.     END IF
  164.     o(i).speed = (0.2 + (RND * 1.5)) * flip 'base speed + random multiplier and random direction
  165.     o(i).state = 1
  166.     o(i).start = TIMER
  167.  
  168. FOR i = 1 TO totalInfected
  169.     infected = _CEIL(RND * UBOUND(o))
  170.     o(infected).state = 2
  171.     DO
  172.         o(infected).x = RND * _WIDTH
  173.         o(infected).y = RND * (_HEIGHT - 200)
  174.         retry = 0
  175.         FOR j = 1 TO UBOUND(wall) 'prevent creation of individuals inside walls
  176.             IF rectCirc(wall(j), o(infected), collision) THEN
  177.                 retry = -1
  178.                 EXIT FOR
  179.             END IF
  180.         NEXT
  181.     LOOP WHILE retry
  182.  
  183. COLOR _RGB32(255), _RGB32(0, 0)
  184.  
  185. starttime = TIMER
  186. initstatechange = chance.statechange
  187.  
  188.     framestart = TIMER
  189.     CLS
  190.  
  191.     FOR i = 1 TO UBOUND(wall)
  192.         LINE (wall(i).x, wall(i).y)-STEP(wall(i).w, wall(i).h), _RGB32(255), BF
  193.     NEXT
  194.  
  195.     healthy = 0: contamined = 0: dead = 0: recovered = 0
  196.  
  197.     FOR i = 1 TO UBOUND(o)
  198.         '1 = healthy; 2 = contamined; 3 = dead; 4 = recovered
  199.         SELECT EVERYCASE o(i).state
  200.             CASE 1, 2, 4: move o(i)
  201.             CASE 2: evolve o(i)
  202.             CASE 1, 2, 3, 4: show o(i)
  203.             CASE 1: healthy = healthy + 1
  204.             CASE 2: contamined = contamined + 1
  205.             CASE 3: dead = dead + 1
  206.             CASE 4: recovered = recovered + 1
  207.         END SELECT
  208.     NEXT
  209.  
  210.     savedata
  211.  
  212.     frameend = TIMER
  213.     IF frameend - framestart > 1 / 60 AND initstatechange = chance.statechange THEN
  214.         chance.statechange = initstatechange * (60 * (frameend - framestart))
  215.     ELSE
  216.         IF initstatechange <> chance.statechange AND initstatechange <> 0 AND frameend - framestart <= 1 / 60 THEN
  217.             chance.statechange = initstatechange
  218.         END IF
  219.     END IF
  220.  
  221.     textstatusx = (graphux / _FONTWIDTH) + 3
  222.     textstatusy = (graphly / _FONTHEIGHT) + 1
  223.     LOCATE textstatusy, textstatusx
  224.     PRINT "Healthy:", healthy, , "[F5] to restart simulation"
  225.     LOCATE textstatusy + 1, textstatusx
  226.     PRINT "Contamined:", contamined, , "[F6] to replay"
  227.     LOCATE textstatusy + 2, textstatusx
  228.     PRINT "Dead:", dead
  229.     LOCATE textstatusy + 3, textstatusx
  230.     PRINT "Recovered:", recovered
  231.     LOCATE textstatusy + 4, textstatusx
  232.     PRINT "Time:", TIMER - starttime
  233.     LOCATE textstatusy + 6, textstatusx
  234.     PRINT "SIMULATION @" + STR$(chance.statechange)
  235.     secondbf = second
  236.     second = INT(TIMER - starttime)
  237.     IF second <> secondbf THEN
  238.         healthy(second) = healthy
  239.         contamined(second) = contamined
  240.         dead(second) = dead
  241.         recovered(second) = recovered
  242.         IF people = 0 AND second > 1 THEN people = healthy(second - 1) + contamined(second - 1) + dead(second - 1) + recovered(second - 1)
  243.     END IF
  244.  
  245.     'graph
  246.     people = healthy + contamined + dead + recovered
  247.     LINE (graphlx, graphly)-(graphux, graphuy), _RGB32(0, 0), BF
  248.     graphwidth = graphux - graphlx
  249.     graphheight = graphuy - graphly
  250.     IF TIMER - starttime > 1 THEN
  251.         gp = 0: DO: gp = gp + 1
  252.             LINE (graphlx + ((gp - 1) * graphwidth / INT(TIMER - starttime)), graphly)-(graphlx + (gp * graphwidth / INT(TIMER - starttime)), graphly + (graphheight * healthy(gp) / people)), c(1), BF
  253.             LINE (graphlx + ((gp - 1) * graphwidth / INT(TIMER - starttime)), graphly + (graphheight * healthy(gp) / people))-(graphlx + (gp * graphwidth / INT(TIMER - starttime)), graphly + (graphheight * (healthy(gp) + contamined(gp)) / people)), c(2), BF
  254.             LINE (graphlx + ((gp - 1) * graphwidth / INT(TIMER - starttime)), graphly + (graphheight * (healthy(gp) + contamined(gp)) / people))-(graphlx + (gp * graphwidth / INT(TIMER - starttime)), graphly + (graphheight * (healthy(gp) + contamined(gp) + dead(gp)) / people)), c(3), BF
  255.             LINE (graphlx + ((gp - 1) * graphwidth / INT(TIMER - starttime)), graphly + (graphheight * (healthy(gp) + contamined(gp) + dead(gp)) / people))-(graphlx + (gp * graphwidth / INT(TIMER - starttime)), graphuy), c(4), BF
  256.         LOOP UNTIL gp = INT(TIMER - starttime)
  257.     END IF
  258.  
  259.     _DISPLAY
  260.     _LIMIT 60
  261.     endtime = TIMER - starttime
  262.     Key$ = INKEY$
  263.     IF Key$ = CHR$(0) + CHR$(63) THEN GOTO restart
  264.     IF Key$ = CHR$(0) + CHR$(64) THEN
  265.         CLOSE #1
  266.         GOTO restartreplay
  267.     END IF
  268. LOOP UNTIL _KEYHIT = 27 OR endtime = maxseconds - 1 'stops simulation
  269. 'replay
  270. restartreplay:
  271. OPEN "replay.dat" FOR BINARY AS #1
  272. starttime = TIMER
  273. IF EOF(1) = 0 THEN
  274.     DO
  275.         GET #1, , o()
  276.         CLS
  277.         healthy = 0: contamined = 0: dead = 0: recovered = 0
  278.  
  279.         FOR i = 1 TO UBOUND(wall)
  280.             LINE (wall(i).x, wall(i).y)-STEP(wall(i).w, wall(i).h), _RGB32(255), BF
  281.         NEXT
  282.  
  283.         FOR i = 1 TO UBOUND(o)
  284.             '1 = healthy; 2 = contamined; 3 = dead; 4 = recovered
  285.             SELECT EVERYCASE o(i).state
  286.                 CASE 1, 2, 3, 4: show o(i)
  287.                 CASE 1: healthy = healthy + 1
  288.                 CASE 2: contamined = contamined + 1
  289.                 CASE 3: dead = dead + 1
  290.                 CASE 4: recovered = recovered + 1
  291.             END SELECT
  292.         NEXT
  293.  
  294.         textstatusx = (graphux / _FONTWIDTH) + 3
  295.         textstatusy = (graphly / _FONTHEIGHT) + 1
  296.         LOCATE textstatusy, textstatusx
  297.         PRINT "Healthy:", healthy, , "[F5] to restart replay"
  298.         LOCATE textstatusy + 1, textstatusx
  299.         PRINT "Contamined:", contamined, , "[F6] to switch to simulation"
  300.         LOCATE textstatusy + 2, textstatusx
  301.         PRINT "Dead:", dead
  302.         LOCATE textstatusy + 3, textstatusx
  303.         PRINT "Recovered:", recovered, ,
  304.         IF saved = 0 THEN
  305.             PRINT "[F1] to save replay to file"
  306.         ELSE
  307.             PRINT "- Replay saved! -"
  308.         END IF
  309.         LOCATE textstatusy + 4, textstatusx
  310.         PRINT "Time:", TIMER - starttime, , "[F2] to load replay from file"
  311.         LOCATE textstatusy + 6, textstatusx
  312.         _CONTROLCHR OFF
  313.         PRINT , , CHR$(16) + " PLAY   "
  314.         _CONTROLCHR ON
  315.         LOCATE textstatusy + 6, textstatusx
  316.         PRINT "REPLAY"
  317.         secondbf = second
  318.         second = INT(TIMER - starttime)
  319.         IF second <> secondbf THEN
  320.             healthy(second) = healthy
  321.             contamined(second) = contamined
  322.             dead(second) = dead
  323.             recovered(second) = recovered
  324.             people = healthy + contamined + dead + recovered
  325.         END IF
  326.  
  327.         LINE (graphlx, graphly - 20)-(graphux, graphly - 5), _RGB32(0), BF
  328.         LINE (graphlx, graphly - 20)-(graphux, graphly - 5), _RGB32(255), B
  329.         LINE (graphlx, graphly - 20)-(graphlx + (LOC(1) / LOF(1) * (graphux - graphlx)), graphly - 5), _RGB32(255), BF
  330.  
  331.         'graph
  332.         LINE (graphlx, graphly)-(graphux, graphuy), _RGB32(0, 0), BF
  333.         graphwidth = graphux - graphlx
  334.         graphheight = graphuy - graphly
  335.         IF TIMER - starttime > 1 THEN
  336.             gp = 0: DO: gp = gp + 1
  337.                 LINE (graphlx + ((gp - 1) * graphwidth / INT(TIMER - starttime)), graphly)-(graphlx + (gp * graphwidth / INT(TIMER - starttime)), graphly + (graphheight * healthy(gp) / people)), c(1), BF
  338.                 LINE (graphlx + ((gp - 1) * graphwidth / INT(TIMER - starttime)), graphly + (graphheight * healthy(gp) / people))-(graphlx + (gp * graphwidth / INT(TIMER - starttime)), graphly + (graphheight * (healthy(gp) + contamined(gp)) / people)), c(2), BF
  339.                 LINE (graphlx + ((gp - 1) * graphwidth / INT(TIMER - starttime)), graphly + (graphheight * (healthy(gp) + contamined(gp)) / people))-(graphlx + (gp * graphwidth / INT(TIMER - starttime)), graphly + (graphheight * (healthy(gp) + contamined(gp) + dead(gp)) / people)), c(3), BF
  340.                 LINE (graphlx + ((gp - 1) * graphwidth / INT(TIMER - starttime)), graphly + (graphheight * (healthy(gp) + contamined(gp) + dead(gp)) / people))-(graphlx + (gp * graphwidth / INT(TIMER - starttime)), graphuy), c(4), BF
  341.             LOOP UNTIL gp = INT(TIMER - starttime)
  342.         END IF
  343.  
  344.         _DISPLAY
  345.         _LIMIT 60
  346.         Key$ = INKEY$
  347.         IF Key$ = " " THEN
  348.             COLOR _RGB32(255), _RGB32(0)
  349.             LOCATE textstatusy + 6, textstatusx
  350.             PRINT , , CHR$(186) + " PAUSE "
  351.             LOCATE textstatusy + 6, textstatusx
  352.             PRINT "REPLAY"
  353.             _DISPLAY
  354.             DO: LOOP UNTIL INKEY$ = " "
  355.         END IF
  356.         IF Key$ = CHR$(0) + CHR$(63) THEN GOTO restartreplay
  357.         IF Key$ = CHR$(0) + CHR$(64) THEN
  358.             CLOSE #1
  359.             GOTO restart
  360.         END IF
  361.         IF Key$ = CHR$(0) + CHR$(59) THEN savereplay
  362.         IF Key$ = CHR$(0) + CHR$(60) THEN
  363.             loadreplay
  364.             IF restartreplay = 1 THEN
  365.                 restartreplay = 0
  366.                 GOTO restartreplay
  367.             END IF
  368.         END IF
  369.     LOOP UNTIL EOF(1) = -1 'OR TIMER - starttime >= endtime
  370.     CLS
  371.     LOCATE (_HEIGHT / 2) / _FONTHEIGHT, (_WIDTH / 2) / _FONTWIDTH - (LEN("Replay finished.") / 2)
  372.     PRINT "Replay finished."
  373.     LOCATE ((_HEIGHT / 2) / _FONTHEIGHT) + 2, (_WIDTH / 2) / _FONTWIDTH - (LEN("[F5] to restart replay. [F6] to restart simulation.") / 2)
  374.     PRINT "[F5] to restart replay. [F6] to restart simulation."
  375.     _DISPLAY
  376.     IF INKEY$ = CHR$(0) + CHR$(63) THEN GOTO restartreplay
  377.     IF INKEY$ = CHR$(0) + CHR$(64) THEN GOTO restart
  378.  
  379. SUB savereplay
  380.     CLOSE #1
  381.     OPEN "replay.dat" FOR BINARY AS #1
  382.     OPEN "saved_replay" + DATE$ + "_" + HEX$(TIMER) + ".prp" FOR BINARY AS #2
  383.     IF LOF(1) <> 0 THEN
  384.         DO
  385.             GET #1, , o()
  386.             PUT #2, , o()
  387.         LOOP UNTIL EOF(1) <> 0
  388.     END IF
  389.     CLOSE #1
  390.     CLOSE #2
  391.     OPEN "replay.dat" FOR BINARY AS #1
  392.     saved = 1
  393.  
  394. SUB loadreplay
  395.     ' Do the Open File dialog call!
  396.     Filter$ = "Pandemic Replay (*.prp)"
  397.     Flags& = OFN_FILEMUSTEXIST + OFN_NOCHANGEDIR + OFN_READONLY '    add flag constants here
  398.     OFile$ = GetOpenFileName$("Open Pandemic Replay", ".\", Filter$, 1, Flags&, hWnd&)
  399.  
  400.     IF OFile$ <> "" THEN ' Display Open dialog results
  401.         CLOSE #1
  402.         CLOSE #2
  403.         OPEN OFile$ FOR BINARY AS #1
  404.         OPEN "replay.dat" FOR BINARY AS #2
  405.         IF LOF(1) <> 0 THEN
  406.             DO
  407.                 GET #1, , o()
  408.                 PUT #2, , o()
  409.             LOOP UNTIL EOF(1) <> 0
  410.         END IF
  411.         CLOSE #1
  412.         CLOSE #2
  413.         'IF (Flags& AND OFN_READONLY) THEN PRINT "Read-only checkbox checked." 'read-only value in return
  414.         restartreplay = 1
  415.     END IF
  416.  
  417. SUB savedata
  418.     PUT #1, , o()
  419.  
  420. SUB pandemicWindow (lx, ly, ux, uy)
  421.     addWall lx, ly, ux - lx, 3
  422.     addWall lx, uy, ux - lx, 3
  423.     addWall lx, ly, 3, uy - ly
  424.     addWall ux - 4, ly, 3, uy - ly
  425.  
  426. SUB addWall (x AS INTEGER, y AS INTEGER, w AS INTEGER, h AS INTEGER)
  427.     REDIM _PRESERVE wall(1 TO UBOUND(wall) + 1) AS object
  428.     wall(UBOUND(wall)).x = x
  429.     wall(UBOUND(wall)).y = y
  430.     wall(UBOUND(wall)).w = w
  431.     wall(UBOUND(wall)).h = h
  432.  
  433. SUB evolve (this AS object)
  434.     IF TIMER - this.start >= chance.statechange * RND + (chance.statechange * 0.5) THEN
  435.         this.start = TIMER
  436.         IF RND * 100 <= chance.death * 100 THEN 'more realistic chance of death
  437.             this.state = 3
  438.         ELSE
  439.             this.state = 4
  440.         END IF
  441.     END IF
  442.  
  443. SUB show (this AS object)
  444.     CircleFill this.x, this.y, this.size, c(this.state)
  445.  
  446. SUB move (this AS object)
  447.     DIM collision AS object
  448.  
  449.     this.x = this.x + (this.xv * this.speed)
  450.     this.y = this.y + (this.yv * this.speed)
  451.     FOR i = 1 TO UBOUND(wall)
  452.         IF rectCirc(wall(i), this, collision) THEN
  453.             collType = (collision.x + collision.y)
  454.             SELECT CASE collType
  455.                 CASE 10, 12: this.xv = this.xv * -1
  456.                 CASE 17, 33: this.yv = this.yv * -1
  457.                 CASE ELSE
  458.                     this.xv = this.xv * -1
  459.                     this.yv = this.yv * -1
  460.             END SELECT
  461.             EXIT FOR
  462.         END IF
  463.     NEXT
  464.  
  465.     FOR i = 1 TO UBOUND(o)
  466.         IF dist(o(i), this) < this.size + (safedistance * RND) THEN
  467.         END IF
  468.         IF o(i).state = 2 AND this.state <> 2 THEN
  469.             IF dist(o(i), this) < this.size + (safedistance * RND) THEN
  470.                 IF this.state <> 4 AND RND * 1 <= chance.infection THEN
  471.                     this.state = 2
  472.                     this.start = TIMER
  473.                 ELSEIF this.state = 4 AND RND * 1 < chance.reinfection THEN
  474.                     this.state = 2
  475.                     this.start = TIMER
  476.                 END IF
  477.             END IF
  478.         END IF
  479.     NEXT
  480.  
  481. SUB CircleFill (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
  482.     ' CX = center x coordinate
  483.     ' CY = center y coordinate
  484.     '  R = radius
  485.     '  C = fill color
  486.     DIM Radius AS INTEGER, RadiusError AS INTEGER
  487.     DIM X AS INTEGER, Y AS INTEGER
  488.     Radius = ABS(R)
  489.     RadiusError = -Radius
  490.     X = Radius
  491.     Y = 0
  492.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
  493.     LINE (CX - X, CY)-(CX + X, CY), C, BF
  494.     WHILE X > Y
  495.         RadiusError = RadiusError + Y * 2 + 1
  496.         IF RadiusError >= 0 THEN
  497.             IF X <> Y + 1 THEN
  498.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  499.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  500.             END IF
  501.             X = X - 1
  502.             RadiusError = RadiusError - X * 2
  503.         END IF
  504.         Y = Y + 1
  505.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  506.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  507.     WEND
  508.  
  509. FUNCTION rectCirc%% (rect AS object, circ AS object, collision AS object)
  510.     'adapted from http://www.jeffreythompson.org/collision-detection/circle-rect.php
  511.     DIM test AS object
  512.     test.x = circ.x
  513.     test.y = circ.y
  514.  
  515.     collision.x = 1
  516.     IF circ.x < rect.x THEN
  517.         test.x = rect.x
  518.         collision.x = 2
  519.     ELSEIF circ.x > rect.x + rect.w THEN
  520.         test.x = rect.x + rect.w
  521.         collision.x = 4
  522.     END IF
  523.  
  524.     collision.y = 8
  525.     IF circ.y < rect.y THEN
  526.         test.y = rect.y
  527.         collision.y = 16
  528.     ELSEIF circ.y > rect.y + rect.h THEN
  529.         test.y = rect.y + rect.h
  530.         collision.y = 32
  531.     END IF
  532.  
  533.     rectCirc%% = (dist(circ, test) <= circ.size)
  534.  
  535. FUNCTION dist! (o1 AS object, o2 AS object)
  536.     x1! = o1.x
  537.     y1! = o1.y
  538.     x2! = o2.x
  539.     y2! = o2.y
  540.     dist! = _HYPOT((x2! - x1!), (y2! - y1!))
  541.  
  542. FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
  543.     map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
  544.  
  545. FUNCTION GetOpenFileName$ (Title$, InitialDir$, Filter$, FilterIndex, Flags&, hWnd&)
  546.     '  Title$      - The dialog title.
  547.     '  InitialDir$ - If this left blank, it will use the directory where the last opened file is
  548.     '  located. Specify ".\" if you want to always use the current directory.
  549.     '  Filter$     - File filters separated by pipes (|) in the same format as using VB6 common dialogs.
  550.     '  FilterIndex - The initial file filter to use. Will be altered by user during the call.
  551.     '  Flags&      - Dialog flags. Will be altered by the user during the call.
  552.     '  hWnd&       - Your program's window handle that should be aquired by the FindWindow function.
  553.     '
  554.     ' Returns: Blank when cancel is clicked otherwise, the file name selected by the user.
  555.     ' FilterIndex and Flags& will be changed depending on the user's selections.
  556.  
  557.     DIM OpenCall AS FILEDIALOGTYPE ' Needed for dialog call
  558.  
  559.     fFilter$ = Filter$
  560.     FOR R = 1 TO LEN(fFilter$) ' Replace the pipes with character zero
  561.         IF MID$(fFilter$, R, 1) = "|" THEN MID$(fFilter$, R, 1) = CHR$(0)
  562.     NEXT R
  563.     fFilter$ = fFilter$ + CHR$(0)
  564.  
  565.     lpstrFile$ = STRING$(2048, 0) ' For the returned file name
  566.     lpstrDefExt$ = STRING$(10, 0) ' Extension will not be added when this is not specified
  567.     OpenCall.lStructSize = LEN(OpenCall)
  568.     OpenCall.hwndOwner = hWnd&
  569.     OpenCall.lpstrFilter = _OFFSET(fFilter$)
  570.     OpenCall.nFilterIndex = FilterIndex
  571.     OpenCall.lpstrFile = _OFFSET(lpstrFile$)
  572.     OpenCall.nMaxFile = LEN(lpstrFile$) - 1
  573.     OpenCall.lpstrFileTitle = OpenCall.lpstrFile
  574.     OpenCall.nMaxFileTitle = OpenCall.nMaxFile
  575.     OpenCall.lpstrInitialDir = _OFFSET(InitialDir$)
  576.     OpenCall.lpstrTitle = _OFFSET(Title$)
  577.     OpenCall.lpstrDefExt = _OFFSET(lpstrDefExt$)
  578.     OpenCall.flags = Flags&
  579.  
  580.     Result = GetOpenFileNameA&(OpenCall) '            Do Open File dialog call!
  581.  
  582.     IF Result THEN ' Trim the remaining zeros
  583.         GetOpenFileName$ = LEFT$(lpstrFile$, INSTR(lpstrFile$, CHR$(0)) - 1)
  584.         Flags& = OpenCall.flags
  585.         FilterIndex = OpenCall.nFilterIndex
  586.     END IF
  587.  
  588.  
  589. FUNCTION GetSaveFileName$ (Title$, InitialDir$, Filter$, FilterIndex, Flags&, hWnd&)
  590.     '  Title$      - The dialog title.
  591.     '  InitialDir$ - If this left blank, it will use the directory where the last opened file is
  592.     '     located. Specify ".\" if you want to always use the current directory.
  593.     '  Filter$     - File filters separated by pipes (|) in the same format as VB6 common dialogs.
  594.     '  FilterIndex - The initial file filter to use. Will be altered by user during the call.
  595.     '  Flags&      - Dialog flags. Will be altered by the user during the call.
  596.     '  hWnd&       - Your program's window handle that should be aquired by the FindWindow function.
  597.  
  598.     ' Returns: Blank when cancel is clicked otherwise, the file name entered by the user.
  599.     ' FilterIndex and Flags& will be changed depending on the user's selections.
  600.  
  601.     DIM SaveCall AS FILEDIALOGTYPE ' Needed for dialog call
  602.  
  603.     fFilter$ = Filter$
  604.     FOR R = 1 TO LEN(fFilter$) ' Replace the pipes with zeros
  605.         IF MID$(fFilter$, R, 1) = "|" THEN MID$(fFilter$, R, 1) = CHR$(0)
  606.     NEXT R
  607.     fFilter$ = fFilter$ + CHR$(0)
  608.  
  609.     lpstrFile$ = STRING$(2048, 0) ' For the returned file name
  610.     lpstrDefExt$ = STRING$(10, 0) ' Extension will not be added when this is not specified
  611.     SaveCall.lStructSize = LEN(SaveCall)
  612.     SaveCall.hwndOwner = hWnd&
  613.     SaveCall.lpstrFilter = _OFFSET(fFilter$)
  614.     SaveCall.nFilterIndex = FilterIndex
  615.     SaveCall.lpstrFile = _OFFSET(lpstrFile$)
  616.     SaveCall.nMaxFile = LEN(lpstrFile$) - 1
  617.     SaveCall.lpstrFileTitle = SaveCall.lpstrFile
  618.     SaveCall.nMaxFileTitle = SaveCall.nMaxFile
  619.     SaveCall.lpstrInitialDir = _OFFSET(InitialDir$)
  620.     SaveCall.lpstrTitle = _OFFSET(Title$)
  621.     SaveCall.lpstrDefExt = _OFFSET(lpstrDefExt$)
  622.     SaveCall.flags = Flags&
  623.  
  624.     Result& = GetSaveFileNameA&(SaveCall) ' Do dialog call!
  625.  
  626.     IF Result& THEN ' Trim the remaining zeros
  627.         GetSaveFileName$ = LEFT$(lpstrFile$, INSTR(lpstrFile$, CHR$(0)) - 1)
  628.         Flags& = SaveCall.flags
  629.         FilterIndex = SaveCall.nFilterIndex
  630.     END IF

 
unknown.png
 
unknown2.png
« Last Edit: July 22, 2020, 09:05:19 am by loudar »
Check out what I do besides coding: http://loudar.myportfolio.com/

Offline SpriggsySpriggs

  • Forum Resident
  • Posts: 1145
  • Larger than life
    • View Profile
    • GitHub
Re: Pandemic Simulation (joint effort with Fellippe!)
« Reply #1 on: July 20, 2020, 03:35:12 pm »
That's dang cool
Shuwatch!

FellippeHeitor

  • Guest
Re: Pandemic Simulation (joint effort with Fellippe!)
« Reply #2 on: July 20, 2020, 04:04:23 pm »
🥰

Offline loudar

  • Newbie
  • Posts: 73
  • improve it bit by bit.
    • View Profile
Re: Pandemic Simulation (joint effort with Fellippe!)
« Reply #3 on: July 20, 2020, 06:58:07 pm »
The Hospital Update!

Yes, exactly. With a limit of people in hospital, intake per day, curing percentage and more! Share your best runs :D

Code: QB64: [Select]
  1.  
  2. SCREEN _NEWIMAGE(1920, 1080, 32)
  3. _TITLE "Pandemic"
  4.  
  5. ' Dialog flag constants (use + or OR to use more than 1 flag value)
  6. CONST OFN_ALLOWMULTISELECT = &H200& '  Allows the user to select more than one file, not recommended!
  7. CONST OFN_CREATEPROMPT = &H2000& '     Prompts if a file not found should be created(GetOpenFileName only).
  8. CONST OFN_EXTENSIONDIFFERENT = &H400& 'Allows user to specify file extension other than default extension.
  9. CONST OFN_FILEMUSTEXIST = &H1000& '    Chechs File name exists(GetOpenFileName only).
  10. CONST OFN_HIDEREADONLY = &H4& '        Hides read-only checkbox(GetOpenFileName only)
  11. CONST OFN_NOCHANGEDIR = &H8& '         Restores the current directory to original value if user changed
  12. CONST OFN_NODEREFERENCELINKS = &H100000& 'Returns path and file name of selected shortcut(.LNK) file instead of file referenced.
  13. CONST OFN_NONETWORKBUTTON = &H20000& ' Hides and disables the Network button.
  14. CONST OFN_NOREADONLYRETURN = &H8000& ' Prevents selection of read-only files, or files in read-only subdirectory.
  15. CONST OFN_NOVALIDATE = &H100& '        Allows invalid file name characters.
  16. CONST OFN_OVERWRITEPROMPT = &H2& '     Prompts if file already exists(GetSaveFileName only)
  17. CONST OFN_PATHMUSTEXIST = &H800& '     Checks Path name exists (set with OFN_FILEMUSTEXIST).
  18. CONST OFN_READONLY = &H1& '            Checks read-only checkbox. Returns if checkbox is checked
  19. CONST OFN_SHAREAWARE = &H4000& '       Ignores sharing violations in networking
  20. CONST OFN_SHOWHELP = &H10& '           Shows the help button (useless!)
  21. '--------------------------------------------------------------------------------------------
  22.  
  23. TYPE FILEDIALOGTYPE
  24.     $IF 32BIT THEN
  25.     lStructSize AS LONG '        For the DLL call
  26.     hwndOwner AS LONG '          Dialog will hide behind window when not set correctly
  27.     hInstance AS LONG '          Handle to a module that contains a dialog box template.
  28.     lpstrFilter AS _OFFSET '     Pointer of the string of file filters
  29.     lpstrCustFilter AS _OFFSET
  30.     nMaxCustFilter AS LONG
  31.     nFilterIndex AS LONG '       One based starting filter index to use when dialog is called
  32.     lpstrFile AS _OFFSET '       String full of 0's for the selected file name
  33.     nMaxFile AS LONG '           Maximum length of the string stuffed with 0's minus 1
  34.     lpstrFileTitle AS _OFFSET '  Same as lpstrFile
  35.     nMaxFileTitle AS LONG '      Same as nMaxFile
  36.     lpstrInitialDir AS _OFFSET ' Starting directory
  37.     lpstrTitle AS _OFFSET '      Dialog title
  38.     flags AS LONG '              Dialog flags
  39.     nFileOffset AS INTEGER '     Zero-based offset from path beginning to file name string pointed to by lpstrFile
  40.     nFileExtension AS INTEGER '  Zero-based offset from path beginning to file extension string pointed to by lpstrFile.
  41.     lpstrDefExt AS _OFFSET '     Default/selected file extension
  42.     lCustData AS LONG
  43.     lpfnHook AS LONG
  44.     lpTemplateName AS _OFFSET
  45.     $ELSE
  46.         lStructSize AS _OFFSET '      For the DLL call
  47.         hwndOwner AS _OFFSET '        Dialog will hide behind window when not set correctly
  48.         hInstance AS _OFFSET '        Handle to a module that contains a dialog box template.
  49.         lpstrFilter AS _OFFSET '      Pointer of the string of file filters
  50.         lpstrCustFilter AS LONG
  51.         nMaxCustFilter AS LONG
  52.         nFilterIndex AS _INTEGER64 '  One based starting filter index to use when dialog is called
  53.         lpstrFile AS _OFFSET '        String full of 0's for the selected file name
  54.         nMaxFile AS _OFFSET '         Maximum length of the string stuffed with 0's minus 1
  55.         lpstrFileTitle AS _OFFSET '   Same as lpstrFile
  56.         nMaxFileTitle AS _OFFSET '    Same as nMaxFile
  57.         lpstrInitialDir AS _OFFSET '  Starting directory
  58.         lpstrTitle AS _OFFSET '       Dialog title
  59.         flags AS _INTEGER64 '         Dialog flags
  60.         nFileOffset AS _INTEGER64 '   Zero-based offset from path beginning to file name string pointed to by lpstrFile
  61.         nFileExtension AS _INTEGER64 'Zero-based offset from path beginning to file extension string pointed to by lpstrFile.
  62.         lpstrDefExt AS _OFFSET '      Default/selected file extension
  63.         lCustData AS _INTEGER64
  64.         lpfnHook AS _INTEGER64
  65.         lpTemplateName AS _OFFSET
  66.     $END IF
  67.  
  68. DECLARE DYNAMIC LIBRARY "comdlg32" ' Library declarations using _OFFSET types
  69.     FUNCTION GetOpenFileNameA& (DIALOGPARAMS AS FILEDIALOGTYPE) ' The Open file dialog
  70.     FUNCTION GetSaveFileNameA& (DIALOGPARAMS AS FILEDIALOGTYPE) ' The Save file dialog
  71.  
  72.     FUNCTION FindWindow& (BYVAL ClassName AS _OFFSET, WindowName$) ' To get hWnd handle
  73.  
  74. hWnd& = _WINDOWHANDLE 'FindWindow(0, "Pandemic" + CHR$(0)) 'get window handle using _TITLE string
  75. DIM SHARED restartreplay
  76.  
  77. TYPE object
  78.     x AS SINGLE
  79.     y AS SINGLE
  80.     w AS INTEGER
  81.     h AS INTEGER
  82.     size AS INTEGER
  83.     xv AS SINGLE
  84.     yv AS SINGLE
  85.     speed AS SINGLE
  86.     state AS _BYTE '1 = healthy; 2 = contamined; 3 = dead; 4 = recovered
  87.     severity AS _BYTE
  88.     symptoms AS _BYTE
  89.     start AS SINGLE
  90.     intake AS SINGLE
  91.     c AS _UNSIGNED LONG
  92.  
  93. maxseconds = 5000
  94. DIM SHARED healthy(maxseconds)
  95. DIM SHARED contamined(maxseconds)
  96. DIM SHARED dead(maxseconds)
  97. DIM SHARED recovered(maxseconds)
  98. DIM SHARED hospitalizedi(maxseconds)
  99. DIM SHARED hospitalizedh(maxseconds)
  100. DIM SHARED hospitalizedr(maxseconds)
  101.  
  102. TYPE chance
  103.     infection AS SINGLE
  104.     death AS SINGLE
  105.     statechange AS SINGLE
  106.     reinfection AS SINGLE
  107.     severity AS SINGLE
  108.     symptoms AS SINGLE
  109.     hospite AS SINGLE
  110.     curing AS SINGLE
  111. DIM SHARED chance AS chance
  112.  
  113. DIM collision AS object
  114. DIM SHARED safedistance
  115. DIM SHARED hospitalized
  116. DIM SHARED hospitallimit
  117. DIM SHARED dailyintake
  118. DIM SHARED dailylimit
  119. REDIM SHARED wall(0) AS object
  120. 'outer walls
  121. pandemicWindow 0, 0, _WIDTH * 2 / 3, _HEIGHT - 180
  122. pandemicWindow _WIDTH * 2 / 3, 0, _WIDTH, _HEIGHT - 180
  123. DIM SHARED graphlx: DIM SHARED graphly: DIM SHARED graphux: DIM SHARED graphuy
  124. graphlx = 15
  125. graphly = _HEIGHT - 150
  126. graphux = _WIDTH / 2
  127. graphuy = _HEIGHT - 20
  128.  
  129. '--------------------------------------------------------------------------------------------------------
  130.  
  131. 'variation
  132. maxpeople = 830
  133. totalInfected = 1
  134. peoplesize = 2
  135. sd = 2 'in meters
  136. scale = 5
  137. safedistance = sd * scale
  138. hospitallimit = maxpeople / 10
  139. dailylimit = hospitallimit / 7
  140.  
  141. 'chances
  142. chance.infection = 0.7
  143. chance.death = 0.025
  144. chance.statechange = 14 'amount in days
  145. chance.reinfection = 0.001
  146. chance.severity = 0.01
  147. chance.symptoms = 0.5 'chance of showing symptoms when infected. if not infected, the chance is 25% of that
  148. chance.hospite = 0.9 'chance of getting into a hospital when showing symptoms
  149. chance.curing = 0.8 'chance of getting cured in a hospital
  150.  
  151. '--------------------------------------------------------------------------------------------------------
  152.  
  153. DIM SHARED o(maxpeople) AS object
  154.  
  155. c(1) = _RGB32(50, 200, 55)
  156. c(2) = _RGB32(205, 0, 0)
  157. c(3) = _RGB32(67)
  158. c(4) = _RGB32(222, 144, 0)
  159. c(5) = _RGB32(0, 200, 249)
  160. c(6) = c(1)
  161. c(7) = c(4)
  162.  
  163. DIM SHARED saved
  164. restart:
  165. IF _FILEEXISTS("replay.dat") THEN KILL "replay.dat" 'prevents playing old replays and sort of bugging out lol
  166. saved = 0
  167. OPEN "replay.dat" FOR BINARY AS #1
  168. FOR i = 1 TO UBOUND(o)
  169.     o(i).size = peoplesize
  170.     DO
  171.         o(i).x = RND * _WIDTH * 2 / 3
  172.         o(i).y = RND * (_HEIGHT - 200)
  173.         retry = 0
  174.         FOR j = 1 TO UBOUND(wall) 'prevent creation of individuals inside walls
  175.             IF rectCirc(wall(j), o(i), collision) THEN
  176.                 retry = -1
  177.                 EXIT FOR
  178.             END IF
  179.         NEXT
  180.     LOOP WHILE retry
  181.     o(i).xv = RND * 1 'different random values for more realist
  182.     o(i).yv = RND * 1
  183.     IF INT(RND + 0.5) = 1 THEN
  184.         flip = 1
  185.     ELSE
  186.         flip = -1
  187.     END IF
  188.     o(i).speed = (0.2 + (RND * 1.5)) * flip 'base speed + random multiplier and random direction
  189.     o(i).state = 1
  190.     o(i).start = TIMER
  191.  
  192. FOR i = 1 TO totalInfected
  193.     infected = _CEIL(RND * UBOUND(o))
  194.     o(infected).state = 2
  195.     DO
  196.         o(infected).x = RND * _WIDTH * 2 / 3
  197.         o(infected).y = RND * (_HEIGHT - 200)
  198.         retry = 0
  199.         FOR j = 1 TO UBOUND(wall) 'prevent creation of individuals inside walls
  200.             IF rectCirc(wall(j), o(infected), collision) THEN
  201.                 retry = -1
  202.                 EXIT FOR
  203.             END IF
  204.         NEXT
  205.     LOOP WHILE retry
  206.  
  207. COLOR _RGB32(255), _RGB32(0, 0)
  208.  
  209. starttime = TIMER
  210. initstatechange = chance.statechange
  211.  
  212.     framestart = TIMER
  213.     CLS
  214.  
  215.     FOR i = 1 TO UBOUND(wall)
  216.         LINE (wall(i).x, wall(i).y)-STEP(wall(i).w, wall(i).h), _RGB32(255), BF
  217.     NEXT
  218.  
  219.     healthy = 0: contamined = 0: dead = 0: recovered = 0: hospitalizedi = 0: hospitalizedh = 0: hospitalizedr = 0
  220.  
  221.     FOR i = 1 TO UBOUND(o)
  222.         '1 = healthy; 2 = contamined; 3 = dead; 4 = recovered; 5 = hospitalized with infection; 6 = hospitalized without infection
  223.         SELECT EVERYCASE o(i).state
  224.             CASE 1, 2, 4: move o(i)
  225.             CASE 2: evolve o(i)
  226.             CASE 1, 2, 4
  227.                 checksymptoms o(i)
  228.                 IF o(i).symptoms = 1 THEN hospital o(i)
  229.             CASE 1, 2, 3, 4, 5, 6, 7: show o(i)
  230.             CASE 5: cure o(i)
  231.             CASE 5, 6, 7: release o(i)
  232.             CASE 1: healthy = healthy + 1
  233.             CASE 2: contamined = contamined + 1
  234.             CASE 3: dead = dead + 1
  235.             CASE 4: recovered = recovered + 1
  236.             CASE 5: hospitalizedi = hospitalizedi + 1
  237.             CASE 6: hospitalizedh = hospitalizedh + 1
  238.             CASE 7: hospitalizedr = hospitalizedr + 1
  239.         END SELECT
  240.     NEXT
  241.  
  242.     savedata
  243.  
  244.     frameend = TIMER
  245.     IF frameend - framestart > 1 / 60 AND initstatechange = chance.statechange THEN
  246.         chance.statechange = initstatechange * (60 * (frameend - framestart))
  247.     ELSE
  248.         IF initstatechange <> chance.statechange AND initstatechange <> 0 AND frameend - framestart <= 1 / 60 THEN
  249.             chance.statechange = initstatechange
  250.         END IF
  251.     END IF
  252.  
  253.     textstatusx = (graphux / _FONTWIDTH) + 3
  254.     textstatusy = (graphly / _FONTHEIGHT) + 1
  255.     LOCATE textstatusy, textstatusx
  256.     PRINT "Healthy:", healthy, , "[F5] to restart simulation"
  257.     LOCATE textstatusy + 1, textstatusx
  258.     PRINT "Contamined:", contamined, , "[F6] to replay"
  259.     LOCATE textstatusy + 2, textstatusx
  260.     PRINT "Dead:", dead
  261.     LOCATE textstatusy + 3, textstatusx
  262.     PRINT "Recovered:", recovered, , "People:", people
  263.     LOCATE textstatusy + 4, textstatusx
  264.     PRINT "Hospitalized:", hospitalizedi; "/"; hospitalizedh; "/"; hospitalizedr; "   "
  265.     LOCATE textstatusy + 6, textstatusx
  266.     PRINT "Time:", TIMER - starttime
  267.     LOCATE textstatusy + 7, textstatusx
  268.     PRINT "SIMULATION @" + STR$(chance.statechange)
  269.     secondbf = second
  270.     second = INT(TIMER - starttime)
  271.     IF second <> secondbf THEN
  272.         dailyintake = 0
  273.         healthy(second) = healthy
  274.         contamined(second) = contamined
  275.         dead(second) = dead
  276.         recovered(second) = recovered
  277.         hospitalizedi(second) = hospitalizedi
  278.         hospitalizedh(second) = hospitalizedh
  279.         hospitalizedr(second) = hospitalizedr
  280.         hospitalized = hospitalizedi + hospitalizedh + hospitalizedr
  281.     END IF
  282.  
  283.     'graph
  284.     people = UBOUND(o)
  285.     LINE (graphlx, graphly)-(graphux, graphuy), _RGB32(0, 0), BF
  286.     graphwidth = graphux - graphlx
  287.     graphheight = graphuy - graphly
  288.     IF TIMER - starttime > 1 THEN
  289.         gp = 0: DO: gp = gp + 1
  290.             LINE (graphlx + ((gp - 1) * graphwidth / INT(TIMER - starttime)), graphly)-(graphlx + (gp * graphwidth / INT(TIMER - starttime)), graphly + (graphheight * (healthy(gp) / people))), c(1), BF
  291.             LINE (graphlx + ((gp - 1) * graphwidth / INT(TIMER - starttime)), graphly + (graphheight * (healthy(gp) / people)))-(graphlx + (gp * graphwidth / INT(TIMER - starttime)), graphly + (graphheight * ((healthy(gp) + contamined(gp)) / people))), c(2), BF
  292.             LINE (graphlx + ((gp - 1) * graphwidth / INT(TIMER - starttime)), graphly + (graphheight * ((healthy(gp) + contamined(gp)) / people)))-(graphlx + (gp * graphwidth / INT(TIMER - starttime)), graphly + (graphheight * ((healthy(gp) + contamined(gp) + dead(gp)) / people))), c(3), BF
  293.             LINE (graphlx + ((gp - 1) * graphwidth / INT(TIMER - starttime)), graphly + (graphheight * ((healthy(gp) + contamined(gp) + dead(gp)) / people)))-(graphlx + (gp * graphwidth / INT(TIMER - starttime)), graphly + (graphheight * ((healthy(gp) + contamined(gp) + dead(gp) + recovered(gp)) / people))), c(4), BF
  294.             LINE (graphlx + ((gp - 1) * graphwidth / INT(TIMER - starttime)), graphly + (graphheight * ((healthy(gp) + contamined(gp) + dead(gp) + recovered(gp)) / people)))-(graphlx + (gp * graphwidth / INT(TIMER - starttime)), graphuy), c(5), BF
  295.         LOOP UNTIL gp = INT(TIMER - starttime)
  296.     END IF
  297.  
  298.     _DISPLAY
  299.     _LIMIT 60
  300.     endtime = TIMER - starttime
  301.     KEY$ = INKEY$
  302.     IF KEY$ = CHR$(0) + CHR$(63) THEN GOTO restart
  303.     IF KEY$ = CHR$(0) + CHR$(64) THEN
  304.         CLOSE #1
  305.         GOTO restartreplay
  306.     END IF
  307. LOOP UNTIL _KEYHIT = 27 OR endtime = maxseconds - 1 'stops simulation
  308. 'replay
  309. restartreplay:
  310. OPEN "replay.dat" FOR BINARY AS #1
  311. starttime = TIMER
  312. IF EOF(1) = 0 THEN
  313.     DO
  314.         GET #1, , o()
  315.         CLS
  316.         healthy = 0: contamined = 0: dead = 0: recovered = 0
  317.  
  318.         FOR i = 1 TO UBOUND(wall)
  319.             LINE (wall(i).x, wall(i).y)-STEP(wall(i).w, wall(i).h), _RGB32(255), BF
  320.         NEXT
  321.  
  322.         FOR i = 1 TO UBOUND(o)
  323.             '1 = healthy; 2 = contamined; 3 = dead; 4 = recovered; 5 = hospitalized with infection; 6 = hospitalized without infection
  324.             SELECT EVERYCASE o(i).state
  325.                 CASE 1, 2, 3, 4, 5, 6, 7: show o(i)
  326.                 CASE 1: healthy = healthy + 1
  327.                 CASE 2: contamined = contamined + 1
  328.                 CASE 3: dead = dead + 1
  329.                 CASE 4: recovered = recovered + 1
  330.                 CASE 5: hospitalizedi = hospitalizedi + 1
  331.                 CASE 6: hospitalizedh = hospitalizedh + 1
  332.                 CASE 7: hospitalizedr = hospitalizedr + 1
  333.             END SELECT
  334.         NEXT
  335.  
  336.         textstatusx = (graphux / _FONTWIDTH) + 3
  337.         textstatusy = (graphly / _FONTHEIGHT) + 1
  338.         LOCATE textstatusy, textstatusx
  339.         PRINT "Healthy:", healthy, , "[F5] to restart replay"
  340.         LOCATE textstatusy + 1, textstatusx
  341.         PRINT "Contamined:", contamined, , "[F6] to switch to simulation"
  342.         LOCATE textstatusy + 2, textstatusx
  343.         PRINT "Dead:", dead
  344.         LOCATE textstatusy + 3, textstatusx
  345.         PRINT "Recovered:", recovered
  346.         LOCATE textstatusy + 4, textstatusx
  347.         PRINT "Hospitalized:", hospitalizedi; "/"; hospitalizedh; "/"; hospitalizedr; "   "
  348.         LOCATE textstatusy + 6, textstatusx
  349.         PRINT "Time:", TIMER - starttime, ,
  350.         IF saved = 0 THEN
  351.             PRINT "[F1] to save replay to file"
  352.         ELSE
  353.             PRINT "- Replay saved! -"
  354.         END IF
  355.         LOCATE textstatusy + 7, textstatusx
  356.         _CONTROLCHR OFF
  357.         PRINT , , " " + CHR$(16) + " PLAY   ", , "[F2] to load replay from file"
  358.         _CONTROLCHR ON
  359.         LOCATE textstatusy + 6, textstatusx
  360.         PRINT "REPLAY"
  361.         secondbf = second
  362.         second = INT(TIMER - starttime)
  363.         IF second <> secondbf THEN
  364.             healthy(second) = healthy
  365.             contamined(second) = contamined
  366.             dead(second) = dead
  367.             recovered(second) = recovered
  368.             hospitalizedi(second) = hospitalizedi
  369.             hospitalizedh(second) = hospitalizedh
  370.             hospitalizedr(second) = hospitalizedr
  371.             hospitalized = hospitalizedi + hospitalizedh + hospitalizedr
  372.         END IF
  373.  
  374.         LINE (graphlx, graphly - 20)-(graphux, graphly - 5), _RGB32(0), BF
  375.         LINE (graphlx, graphly - 20)-(graphux, graphly - 5), _RGB32(255), B
  376.         LINE (graphlx, graphly - 20)-(graphlx + (LOC(1) / LOF(1) * (graphux - graphlx)), graphly - 5), _RGB32(255), BF
  377.  
  378.         'graph
  379.         people = UBOUND(o)
  380.         LINE (graphlx, graphly)-(graphux, graphuy), _RGB32(0, 0), BF
  381.         graphwidth = graphux - graphlx
  382.         graphheight = graphuy - graphly
  383.         IF TIMER - starttime > 1 THEN
  384.             gp = 0: DO: gp = gp + 1
  385.                 LINE (graphlx + ((gp - 1) * graphwidth / INT(TIMER - starttime)), graphly)-(graphlx + (gp * graphwidth / INT(TIMER - starttime)), graphly + (graphheight * (healthy(gp) / people))), c(1), BF
  386.                 LINE (graphlx + ((gp - 1) * graphwidth / INT(TIMER - starttime)), graphly + (graphheight * (healthy(gp) / people)))-(graphlx + (gp * graphwidth / INT(TIMER - starttime)), graphly + (graphheight * ((healthy(gp) + contamined(gp)) / people))), c(2), BF
  387.                 LINE (graphlx + ((gp - 1) * graphwidth / INT(TIMER - starttime)), graphly + (graphheight * ((healthy(gp) + contamined(gp)) / people)))-(graphlx + (gp * graphwidth / INT(TIMER - starttime)), graphly + (graphheight * ((healthy(gp) + contamined(gp) + dead(gp)) / people))), c(3), BF
  388.                 LINE (graphlx + ((gp - 1) * graphwidth / INT(TIMER - starttime)), graphly + (graphheight * ((healthy(gp) + contamined(gp) + dead(gp)) / people)))-(graphlx + (gp * graphwidth / INT(TIMER - starttime)), graphly + (graphheight * ((healthy(gp) + contamined(gp) + dead(gp) + recovered(gp)) / people))), c(4), BF
  389.                 LINE (graphlx + ((gp - 1) * graphwidth / INT(TIMER - starttime)), graphly + (graphheight * ((healthy(gp) + contamined(gp) + dead(gp) + recovered(gp)) / people)))-(graphlx + (gp * graphwidth / INT(TIMER - starttime)), graphuy), c(5), BF
  390.             LOOP UNTIL gp = INT(TIMER - starttime)
  391.         END IF
  392.  
  393.         _DISPLAY
  394.         _LIMIT 60
  395.         KEY$ = INKEY$
  396.         IF KEY$ = " " THEN
  397.             COLOR _RGB32(255), _RGB32(0)
  398.             LOCATE textstatusy + 6, textstatusx
  399.             PRINT , , " " + CHR$(186) + " PAUSE "
  400.             LOCATE textstatusy + 6, textstatusx
  401.             PRINT "REPLAY"
  402.             _DISPLAY
  403.             DO: LOOP UNTIL INKEY$ = " "
  404.         END IF
  405.         IF KEY$ = CHR$(0) + CHR$(63) THEN GOTO restartreplay
  406.         IF KEY$ = CHR$(0) + CHR$(64) THEN
  407.             CLOSE #1
  408.             GOTO restart
  409.         END IF
  410.         IF KEY$ = CHR$(0) + CHR$(59) THEN savereplay
  411.         IF KEY$ = CHR$(0) + CHR$(60) THEN
  412.             loadreplay
  413.             IF restartreplay = 1 THEN
  414.                 restartreplay = 0
  415.                 GOTO restartreplay
  416.             END IF
  417.         END IF
  418.     LOOP UNTIL EOF(1) = -1 'OR TIMER - starttime >= endtime
  419.     CLS
  420.     LOCATE (_HEIGHT / 2) / _FONTHEIGHT, (_WIDTH / 2) / _FONTWIDTH - (LEN("Replay finished.") / 2)
  421.     PRINT "Replay finished."
  422.     LOCATE ((_HEIGHT / 2) / _FONTHEIGHT) + 2, (_WIDTH / 2) / _FONTWIDTH - (LEN("[F5] to restart replay. [F6] to start a new simulation.") / 2)
  423.     PRINT "[F5] to restart replay. [F6] to restart simulation."
  424.     _DISPLAY
  425.     IF INKEY$ = CHR$(0) + CHR$(63) THEN GOTO restartreplay
  426.     IF INKEY$ = CHR$(0) + CHR$(64) THEN GOTO restart
  427.  
  428. SUB savereplay
  429.     CLOSE #1
  430.     OPEN "replay.dat" FOR BINARY AS #1
  431.     OPEN "saved_replay" + DATE$ + "_" + HEX$(TIMER) + ".prp" FOR BINARY AS #2
  432.     IF LOF(1) <> 0 THEN
  433.         DO
  434.             GET #1, , o()
  435.             PUT #2, , o()
  436.         LOOP UNTIL EOF(1) <> 0
  437.     END IF
  438.     CLOSE #1
  439.     CLOSE #2
  440.     OPEN "replay.dat" FOR BINARY AS #1
  441.     saved = 1
  442.  
  443. SUB loadreplay
  444.     ' Do the Open File dialog call!
  445.     Filter$ = "Pandemic Replay (*.prp)"
  446.     Flags& = OFN_FILEMUSTEXIST + OFN_NOCHANGEDIR + OFN_READONLY '    add flag constants here
  447.     OFile$ = GetOpenFileName$("Open Pandemic Replay", ".\", Filter$, 1, Flags&, hWnd&)
  448.  
  449.     IF OFile$ <> "" THEN ' Display Open dialog results
  450.         CLOSE #1
  451.         CLOSE #2
  452.         OPEN OFile$ FOR BINARY AS #1
  453.         OPEN "replay.dat" FOR BINARY AS #2
  454.         IF LOF(1) <> 0 THEN
  455.             DO
  456.                 GET #1, , o()
  457.                 PUT #2, , o()
  458.             LOOP UNTIL EOF(1) <> 0
  459.         END IF
  460.         CLOSE #1
  461.         CLOSE #2
  462.         'IF (Flags& AND OFN_READONLY) THEN PRINT "Read-only checkbox checked." 'read-only value in return
  463.         restartreplay = 1
  464.     END IF
  465.  
  466. SUB savedata
  467.     PUT #1, , o()
  468.  
  469. SUB pandemicWindow (lx, ly, ux, uy)
  470.     addWall lx, ly + 15, ux - lx, 4
  471.     addWall lx, uy, ux - lx, 4
  472.     addWall lx, ly, 3, uy - ly
  473.     addWall ux - 4, ly + 4, 3, uy - ly
  474.  
  475. SUB addWall (x AS INTEGER, y AS INTEGER, w AS INTEGER, h AS INTEGER)
  476.     REDIM _PRESERVE wall(1 TO UBOUND(wall) + 1) AS object
  477.     wall(UBOUND(wall)).x = x
  478.     wall(UBOUND(wall)).y = y
  479.     wall(UBOUND(wall)).w = w
  480.     wall(UBOUND(wall)).h = h
  481.  
  482. SUB checksymptoms (this AS object)
  483.     IF this.state = 2 THEN
  484.         IF RND * 100 <= chance.symptoms THEN
  485.             this.symptoms = 1
  486.         END IF
  487.     ELSE
  488.         IF RND * 10000 <= chance.symptoms THEN
  489.             this.symptoms = 1
  490.         END IF
  491.     END IF
  492.  
  493. SUB hospital (this AS object)
  494.     IF RND * 100 <= chance.hospite * 100 AND hospitalized < hospitallimit AND dailyintake < dailylimit THEN 'only puts you in hospital if you're rich enough $$$$
  495.         dailyintake = dailyintake + 1
  496.         hospitalized = hospitalized + 1
  497.         this.x = (_WIDTH / 3 * 2) + (this.x / 2) 'move into hospital area
  498.         IF this.state = 2 THEN
  499.             this.state = 5 'hospitalized with infection
  500.         ELSEIF this.state = 1 THEN
  501.             this.state = 6 'hospitalized healthy
  502.         ELSE
  503.             this.state = 7 'hospitalized recovered
  504.         END IF
  505.         this.intake = TIMER
  506.     END IF
  507.  
  508. SUB cure (this AS object)
  509.     IF RND * 100 <= chance.curing * 100 THEN
  510.         IF this.state = 5 THEN this.state = 7
  511.         this.symptoms = 0
  512.     END IF
  513.  
  514. SUB release (this AS object)
  515.     IF TIMER - this.intake >= 7 THEN
  516.         hospitalized = hospitalized - 1
  517.         IF this.state = 6 THEN
  518.             this.state = 1
  519.         ELSEIF this.state = 7 THEN
  520.             this.state = 4
  521.         END IF
  522.         this.x = (this.x - (_WIDTH / 3 * 2)) * 2
  523.     END IF
  524.  
  525. SUB evolve (this AS object)
  526.     IF TIMER - this.start >= (chance.statechange / 2) * RND + (chance.statechange * 0.25) THEN 'if severity occurs, it does so before death
  527.         IF RND * 100 <= chance.severity * 100 THEN 'severity is only relevant when infected
  528.             this.severity = this.severity + 1
  529.         END IF
  530.     END IF
  531.     IF TIMER - this.start >= chance.statechange * RND + (chance.statechange * 0.5) THEN
  532.         this.start = TIMER
  533.         IF RND * 100 <= chance.death * 100 THEN 'more realistic chance of death
  534.             this.state = 3
  535.         ELSE
  536.             this.state = 4
  537.         END IF
  538.     END IF
  539.  
  540. SUB show (this AS object)
  541.     IF this.state = 5 OR this.state = 6 OR this.state = 7 THEN CircleFill this.x, this.y, this.size + 2, c(5)
  542.     IF this.symptoms = 1 THEN CircleFill this.x, this.y, this.size + 1, _RGB32(255)
  543.     CircleFill this.x, this.y, this.size, c(this.state)
  544.  
  545. SUB move (this AS object)
  546.     DIM collision AS object
  547.  
  548.     this.x = this.x + (this.xv * this.speed)
  549.     this.y = this.y + (this.yv * this.speed)
  550.     FOR i = 1 TO UBOUND(wall)
  551.         IF rectCirc(wall(i), this, collision) THEN
  552.             collType = (collision.x + collision.y)
  553.             SELECT CASE collType
  554.                 CASE 10, 12: this.xv = this.xv * -1
  555.                 CASE 17, 33: this.yv = this.yv * -1
  556.                 CASE ELSE
  557.                     this.xv = this.xv * -1
  558.                     this.yv = this.yv * -1
  559.             END SELECT
  560.             EXIT FOR
  561.         END IF
  562.     NEXT
  563.  
  564.     FOR i = 1 TO UBOUND(o)
  565.         IF dist(o(i), this) < this.size + (safedistance * RND) THEN
  566.         END IF
  567.         IF o(i).state = 2 AND this.state <> 2 THEN
  568.             IF dist(o(i), this) < this.size + (safedistance * RND) THEN
  569.                 IF this.state <> 4 AND RND * 1 <= chance.infection THEN
  570.                     this.state = 2
  571.                     this.start = TIMER
  572.                 ELSEIF this.state = 4 AND RND * 1 < chance.reinfection THEN
  573.                     this.state = 2
  574.                     this.start = TIMER
  575.                 END IF
  576.             END IF
  577.         END IF
  578.     NEXT
  579.  
  580. SUB CircleFill (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
  581.     ' CX = center x coordinate
  582.     ' CY = center y coordinate
  583.     '  R = radius
  584.     '  C = fill color
  585.     DIM Radius AS INTEGER, RadiusError AS INTEGER
  586.     DIM X AS INTEGER, Y AS INTEGER
  587.     Radius = ABS(R)
  588.     RadiusError = -Radius
  589.     X = Radius
  590.     Y = 0
  591.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
  592.     LINE (CX - X, CY)-(CX + X, CY), C, BF
  593.     WHILE X > Y
  594.         RadiusError = RadiusError + Y * 2 + 1
  595.         IF RadiusError >= 0 THEN
  596.             IF X <> Y + 1 THEN
  597.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  598.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  599.             END IF
  600.             X = X - 1
  601.             RadiusError = RadiusError - X * 2
  602.         END IF
  603.         Y = Y + 1
  604.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  605.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  606.     WEND
  607.  
  608. FUNCTION rectCirc%% (rect AS object, circ AS object, collision AS object)
  609.     'adapted from http://www.jeffreythompson.org/collision-detection/circle-rect.php
  610.     DIM test AS object
  611.     test.x = circ.x
  612.     test.y = circ.y
  613.  
  614.     collision.x = 1
  615.     IF circ.x < rect.x THEN
  616.         test.x = rect.x
  617.         collision.x = 2
  618.     ELSEIF circ.x > rect.x + rect.w THEN
  619.         test.x = rect.x + rect.w
  620.         collision.x = 4
  621.     END IF
  622.  
  623.     collision.y = 8
  624.     IF circ.y < rect.y THEN
  625.         test.y = rect.y
  626.         collision.y = 16
  627.     ELSEIF circ.y > rect.y + rect.h THEN
  628.         test.y = rect.y + rect.h
  629.         collision.y = 32
  630.     END IF
  631.  
  632.     rectCirc%% = (dist(circ, test) <= circ.size)
  633.  
  634. FUNCTION dist! (o1 AS object, o2 AS object)
  635.     x1! = o1.x
  636.     y1! = o1.y
  637.     x2! = o2.x
  638.     y2! = o2.y
  639.     dist! = _HYPOT((x2! - x1!), (y2! - y1!))
  640.  
  641. FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
  642.     map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
  643.  
  644. FUNCTION GetOpenFileName$ (Title$, InitialDir$, Filter$, FilterIndex, Flags&, hWnd&)
  645.     '  Title$      - The dialog title.
  646.     '  InitialDir$ - If this left blank, it will use the directory where the last opened file is
  647.     '  located. Specify ".\" if you want to always use the current directory.
  648.     '  Filter$     - File filters separated by pipes (|) in the same format as using VB6 common dialogs.
  649.     '  FilterIndex - The initial file filter to use. Will be altered by user during the call.
  650.     '  Flags&      - Dialog flags. Will be altered by the user during the call.
  651.     '  hWnd&       - Your program's window handle that should be aquired by the FindWindow function.
  652.     '
  653.     ' Returns: Blank when cancel is clicked otherwise, the file name selected by the user.
  654.     ' FilterIndex and Flags& will be changed depending on the user's selections.
  655.  
  656.     DIM OpenCall AS FILEDIALOGTYPE ' Needed for dialog call
  657.  
  658.     fFilter$ = Filter$
  659.     FOR R = 1 TO LEN(fFilter$) ' Replace the pipes with character zero
  660.         IF MID$(fFilter$, R, 1) = "|" THEN MID$(fFilter$, R, 1) = CHR$(0)
  661.     NEXT R
  662.     fFilter$ = fFilter$ + CHR$(0)
  663.  
  664.     lpstrFile$ = STRING$(2048, 0) ' For the returned file name
  665.     lpstrDefExt$ = STRING$(10, 0) ' Extension will not be added when this is not specified
  666.     OpenCall.lStructSize = LEN(OpenCall)
  667.     OpenCall.hwndOwner = hWnd&
  668.     OpenCall.lpstrFilter = _OFFSET(fFilter$)
  669.     OpenCall.nFilterIndex = FilterIndex
  670.     OpenCall.lpstrFile = _OFFSET(lpstrFile$)
  671.     OpenCall.nMaxFile = LEN(lpstrFile$) - 1
  672.     OpenCall.lpstrFileTitle = OpenCall.lpstrFile
  673.     OpenCall.nMaxFileTitle = OpenCall.nMaxFile
  674.     OpenCall.lpstrInitialDir = _OFFSET(InitialDir$)
  675.     OpenCall.lpstrTitle = _OFFSET(Title$)
  676.     OpenCall.lpstrDefExt = _OFFSET(lpstrDefExt$)
  677.     OpenCall.flags = Flags&
  678.  
  679.     Result = GetOpenFileNameA&(OpenCall) '            Do Open File dialog call!
  680.  
  681.     IF Result THEN ' Trim the remaining zeros
  682.         GetOpenFileName$ = LEFT$(lpstrFile$, INSTR(lpstrFile$, CHR$(0)) - 1)
  683.         Flags& = OpenCall.flags
  684.         FilterIndex = OpenCall.nFilterIndex
  685.     END IF
  686.  
  687.  
  688. FUNCTION GetSaveFileName$ (Title$, InitialDir$, Filter$, FilterIndex, Flags&, hWnd&)
  689.     '  Title$      - The dialog title.
  690.     '  InitialDir$ - If this left blank, it will use the directory where the last opened file is
  691.     '     located. Specify ".\" if you want to always use the current directory.
  692.     '  Filter$     - File filters separated by pipes (|) in the same format as VB6 common dialogs.
  693.     '  FilterIndex - The initial file filter to use. Will be altered by user during the call.
  694.     '  Flags&      - Dialog flags. Will be altered by the user during the call.
  695.     '  hWnd&       - Your program's window handle that should be aquired by the FindWindow function.
  696.  
  697.     ' Returns: Blank when cancel is clicked otherwise, the file name entered by the user.
  698.     ' FilterIndex and Flags& will be changed depending on the user's selections.
  699.  
  700.     DIM SaveCall AS FILEDIALOGTYPE ' Needed for dialog call
  701.  
  702.     fFilter$ = Filter$
  703.     FOR R = 1 TO LEN(fFilter$) ' Replace the pipes with zeros
  704.         IF MID$(fFilter$, R, 1) = "|" THEN MID$(fFilter$, R, 1) = CHR$(0)
  705.     NEXT R
  706.     fFilter$ = fFilter$ + CHR$(0)
  707.  
  708.     lpstrFile$ = STRING$(2048, 0) ' For the returned file name
  709.     lpstrDefExt$ = STRING$(10, 0) ' Extension will not be added when this is not specified
  710.     SaveCall.lStructSize = LEN(SaveCall)
  711.     SaveCall.hwndOwner = hWnd&
  712.     SaveCall.lpstrFilter = _OFFSET(fFilter$)
  713.     SaveCall.nFilterIndex = FilterIndex
  714.     SaveCall.lpstrFile = _OFFSET(lpstrFile$)
  715.     SaveCall.nMaxFile = LEN(lpstrFile$) - 1
  716.     SaveCall.lpstrFileTitle = SaveCall.lpstrFile
  717.     SaveCall.nMaxFileTitle = SaveCall.nMaxFile
  718.     SaveCall.lpstrInitialDir = _OFFSET(InitialDir$)
  719.     SaveCall.lpstrTitle = _OFFSET(Title$)
  720.     SaveCall.lpstrDefExt = _OFFSET(lpstrDefExt$)
  721.     SaveCall.flags = Flags&
  722.  
  723.     Result& = GetSaveFileNameA&(SaveCall) ' Do dialog call!
  724.  
  725.     IF Result& THEN ' Trim the remaining zeros
  726.         GetSaveFileName$ = LEFT$(lpstrFile$, INSTR(lpstrFile$, CHR$(0)) - 1)
  727.         Flags& = SaveCall.flags
  728.         FilterIndex = SaveCall.nFilterIndex
  729.     END IF
  730.  

 
a414b365db7900d9cf8ac2832be2663e-png.jpg
« Last Edit: July 20, 2020, 07:03:44 pm by loudar »
Check out what I do besides coding: http://loudar.myportfolio.com/

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
Re: Pandemic Simulation (joint effort with Fellippe!)
« Reply #4 on: July 21, 2020, 02:17:31 am »
Nice! I have been following this from Discord. :)
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials

Offline loudar

  • Newbie
  • Posts: 73
  • improve it bit by bit.
    • View Profile
Re: Pandemic Simulation (joint effort with Fellippe!)
« Reply #5 on: July 22, 2020, 09:04:21 am »
The Distanced Update!

Biggest change:
- Added social distancing: People will go the opposite direction of which they were heading in. Groups are not existent yet, though that might be an interesting idea for the next update. Maybe also age-dependent factors?

Some small things too:
- Lots of hospital/symptom errors fixed
- Added a hospital graph
- Repositioned some text
- Added a resolution to the simulation, enabling a higher FPS rate for the same amount of time

First screenshot is at 80% social distancing, second one is at 0%. Significant difference!

 
80 percent.png
 
0 percent.png


Code: QB64: [Select]
  1.  
  2. SCREEN _NEWIMAGE(1920, 1080, 32)
  3. _TITLE "Pandemic"
  4.  
  5. ' Dialog flag constants (use + or OR to use more than 1 flag value)
  6. CONST OFN_ALLOWMULTISELECT = &H200& '  Allows the user to select more than one file, not recommended!
  7. CONST OFN_CREATEPROMPT = &H2000& '     Prompts if a file not found should be created(GetOpenFileName only).
  8. CONST OFN_EXTENSIONDIFFERENT = &H400& 'Allows user to specify file extension other than default extension.
  9. CONST OFN_FILEMUSTEXIST = &H1000& '    Chechs File name exists(GetOpenFileName only).
  10. CONST OFN_HIDEREADONLY = &H4& '        Hides read-only checkbox(GetOpenFileName only)
  11. CONST OFN_NOCHANGEDIR = &H8& '         Restores the current directory to original value if user changed
  12. CONST OFN_NODEREFERENCELINKS = &H100000& 'Returns path and file name of selected shortcut(.LNK) file instead of file referenced.
  13. CONST OFN_NONETWORKBUTTON = &H20000& ' Hides and disables the Network button.
  14. CONST OFN_NOREADONLYRETURN = &H8000& ' Prevents selection of read-only files, or files in read-only subdirectory.
  15. CONST OFN_NOVALIDATE = &H100& '        Allows invalid file name characters.
  16. CONST OFN_OVERWRITEPROMPT = &H2& '     Prompts if file already exists(GetSaveFileName only)
  17. CONST OFN_PATHMUSTEXIST = &H800& '     Checks Path name exists (set with OFN_FILEMUSTEXIST).
  18. CONST OFN_READONLY = &H1& '            Checks read-only checkbox. Returns if checkbox is checked
  19. CONST OFN_SHAREAWARE = &H4000& '       Ignores sharing violations in networking
  20. CONST OFN_SHOWHELP = &H10& '           Shows the help button (useless!)
  21. '--------------------------------------------------------------------------------------------
  22.  
  23. TYPE FILEDIALOGTYPE
  24.     $IF 32BIT THEN
  25.     lStructSize AS LONG '        For the DLL call
  26.     hwndOwner AS LONG '          Dialog will hide behind window when not set correctly
  27.     hInstance AS LONG '          Handle to a module that contains a dialog box template.
  28.     lpstrFilter AS _OFFSET '     Pointer of the string of file filters
  29.     lpstrCustFilter AS _OFFSET
  30.     nMaxCustFilter AS LONG
  31.     nFilterIndex AS LONG '       One based starting filter index to use when dialog is called
  32.     lpstrFile AS _OFFSET '       String full of 0's for the selected file name
  33.     nMaxFile AS LONG '           Maximum length of the string stuffed with 0's minus 1
  34.     lpstrFileTitle AS _OFFSET '  Same as lpstrFile
  35.     nMaxFileTitle AS LONG '      Same as nMaxFile
  36.     lpstrInitialDir AS _OFFSET ' Starting directory
  37.     lpstrTitle AS _OFFSET '      Dialog title
  38.     flags AS LONG '              Dialog flags
  39.     nFileOffset AS INTEGER '     Zero-based offset from path beginning to file name string pointed to by lpstrFile
  40.     nFileExtension AS INTEGER '  Zero-based offset from path beginning to file extension string pointed to by lpstrFile.
  41.     lpstrDefExt AS _OFFSET '     Default/selected file extension
  42.     lCustData AS LONG
  43.     lpfnHook AS LONG
  44.     lpTemplateName AS _OFFSET
  45.     $ELSE
  46.         lStructSize AS _OFFSET '      For the DLL call
  47.         hwndOwner AS _OFFSET '        Dialog will hide behind window when not set correctly
  48.         hInstance AS _OFFSET '        Handle to a module that contains a dialog box template.
  49.         lpstrFilter AS _OFFSET '      Pointer of the string of file filters
  50.         lpstrCustFilter AS LONG
  51.         nMaxCustFilter AS LONG
  52.         nFilterIndex AS _INTEGER64 '  One based starting filter index to use when dialog is called
  53.         lpstrFile AS _OFFSET '        String full of 0's for the selected file name
  54.         nMaxFile AS _OFFSET '         Maximum length of the string stuffed with 0's minus 1
  55.         lpstrFileTitle AS _OFFSET '   Same as lpstrFile
  56.         nMaxFileTitle AS _OFFSET '    Same as nMaxFile
  57.         lpstrInitialDir AS _OFFSET '  Starting directory
  58.         lpstrTitle AS _OFFSET '       Dialog title
  59.         flags AS _INTEGER64 '         Dialog flags
  60.         nFileOffset AS _INTEGER64 '   Zero-based offset from path beginning to file name string pointed to by lpstrFile
  61.         nFileExtension AS _INTEGER64 'Zero-based offset from path beginning to file extension string pointed to by lpstrFile.
  62.         lpstrDefExt AS _OFFSET '      Default/selected file extension
  63.         lCustData AS _INTEGER64
  64.         lpfnHook AS _INTEGER64
  65.         lpTemplateName AS _OFFSET
  66.     $END IF
  67.  
  68. DECLARE DYNAMIC LIBRARY "comdlg32" ' Library declarations using _OFFSET types
  69.     FUNCTION GetOpenFileNameA& (DIALOGPARAMS AS FILEDIALOGTYPE) ' The Open file dialog
  70.     FUNCTION GetSaveFileNameA& (DIALOGPARAMS AS FILEDIALOGTYPE) ' The Save file dialog
  71.  
  72. hWnd& = _WINDOWHANDLE 'FindWindow(0, "Pandemic" + CHR$(0)) 'get window handle using _TITLE string
  73. DIM SHARED restartreplay
  74. 'DIM SHARED i AS INTEGER
  75.  
  76. TYPE object
  77.     id AS INTEGER
  78.     x AS SINGLE
  79.     y AS SINGLE
  80.     w AS INTEGER
  81.     h AS INTEGER
  82.     size AS INTEGER
  83.     xv AS SINGLE
  84.     yv AS SINGLE
  85.     xvbf AS SINGLE
  86.     yvbf AS SINGLE
  87.     speed AS SINGLE
  88.     state AS _BYTE '1 = healthy; 2 = contamined; 3 = dead; 4 = recovered
  89.     severity AS _BYTE
  90.     symptoms AS _BYTE
  91.     start AS SINGLE
  92.     intake AS SINGLE
  93.     c AS _UNSIGNED LONG
  94.  
  95. TYPE stat
  96.     healthy AS INTEGER
  97.     contamined AS INTEGER
  98.     dead AS INTEGER
  99.     recovered AS INTEGER
  100.     hospitalizedi AS INTEGER
  101.     hospitalizedh AS INTEGER
  102.     hospitalizedr AS INTEGER
  103.     hospitalized AS INTEGER
  104.     dailyintake AS INTEGER
  105.     contact AS SINGLE
  106.     infections AS SINGLE
  107. REDIM SHARED stat(0) AS stat
  108.  
  109. TYPE chance
  110.     infection AS SINGLE
  111.     death AS SINGLE
  112.     recover AS SINGLE
  113.     statechange AS SINGLE
  114.     reinfection AS SINGLE
  115.     severity AS SINGLE
  116.     symptoms AS SINGLE
  117.     hospite AS SINGLE
  118.     curing AS SINGLE
  119.     laytime AS SINGLE
  120. REDIM SHARED chance AS chance
  121.  
  122. TYPE moveid
  123.     id AS INTEGER
  124.     xv AS SINGLE
  125.     yv AS SINGLE
  126. REDIM SHARED moveid(0) AS moveid
  127.  
  128. TYPE Vector2D
  129.     xv AS SINGLE
  130.     yv AS SINGLE
  131. REDIM SHARED v AS Vector2D
  132.  
  133. DIM collision AS object
  134. DIM SHARED safedistance
  135. DIM SHARED hospitalized
  136. DIM SHARED hospitallimit
  137. DIM SHARED dailyintake
  138. DIM SHARED dailylimit
  139. DIM SHARED socialdistancing
  140. REDIM SHARED wall(0) AS object
  141. 'outer walls
  142. pandemicWindow 0, 0, _WIDTH * 2 / 3, _HEIGHT - 180
  143. pandemicWindow _WIDTH * 2 / 3, 0, _WIDTH, _HEIGHT - 230
  144. DIM SHARED graphlx: DIM SHARED graphly: DIM SHARED graphux: DIM SHARED graphuy
  145. graphlx = 15
  146. graphly = _HEIGHT - 150
  147. graphux = _WIDTH / 2
  148. graphuy = _HEIGHT - 20
  149. DIM SHARED hgraphlx: DIM SHARED hgraphly: DIM SHARED hgraphux: DIM SHARED hgraphuy
  150. hgraphlx = (_WIDTH / 3 * 2) + 15
  151. hgraphly = _HEIGHT - 220
  152. hgraphux = _WIDTH - 15
  153. hgraphuy = _HEIGHT - 195
  154. DIM SHARED fps: fps = 60
  155. DIM SHARED frame
  156.  
  157. '-------------------------------------------------------------------------------------------------------- simulation settings
  158.  
  159. 'variation
  160. maxpeople = 500
  161. totalInfected = 30
  162. peoplesize = 2
  163. sd = 2 'in meters
  164. scale = 5
  165. safedistance = sd * scale
  166. hospitallimit = INT(maxpeople * 0.1)
  167. dailylimit = INT(hospitallimit / 7)
  168. socialdistancing = 0
  169.  
  170. 'chances
  171. chance.infection = 0.6
  172. chance.death = 0.05
  173. chance.recover = 0.8
  174. chance.statechange = 14 'amount in days
  175. chance.reinfection = 0.002
  176. 'chance.severity = 0.01
  177. chance.symptoms = 0.7 'chance of showing symptoms when infected. if not infected, the chance is 1/1000 of that
  178. chance.hospite = 0.8 'chance of getting into a hospital when showing symptoms
  179. chance.curing = 0.2 'chance of getting cured in a hospital
  180. chance.laytime = 7
  181.  
  182. '-------------------------------------------------------------------------------------------------------- replay settings
  183.  
  184. 'replay speed
  185. DIM SHARED resolution
  186. resolution = 60 'x frames per recorded day
  187.  
  188. '--------------------------------------------------------------------------------------------------------
  189.  
  190. REDIM SHARED o(maxpeople) AS object
  191.  
  192. c(1) = _RGB32(50, 200, 55)
  193. c(2) = _RGB32(205, 0, 0)
  194. c(3) = _RGB32(67)
  195. c(4) = _RGB32(222, 144, 0)
  196. c(5) = _RGB32(0, 200, 249)
  197. c(6) = c(1)
  198. c(7) = c(4)
  199.  
  200. DIM SHARED saved
  201. restart:
  202. REDIM stat(0) AS stat
  203. frame = 0
  204. IF _FILEEXISTS("replay.dat") THEN KILL "replay.dat" 'prevents playing old replays and sort of bugging out lol
  205. saved = 0
  206. OPEN "replay.dat" FOR BINARY AS #1
  207. FOR i = 1 TO UBOUND(o)
  208.     o(i).size = peoplesize
  209.     DO
  210.         o(i).x = 10 + (RND * ((_WIDTH * 2 / 3) - 10))
  211.         o(i).y = 10 + (RND * (_HEIGHT - 210))
  212.         retry = 0
  213.         FOR j = 1 TO UBOUND(wall) 'prevent creation of individuals inside walls
  214.             IF rectCirc(wall(j), o(i), collision) THEN
  215.                 retry = -1
  216.                 EXIT FOR
  217.             END IF
  218.         NEXT
  219.         FOR p = 1 TO i
  220.             IF dist!(o(i), o(p)) <= o(i).size + safedistance AND i <> p THEN
  221.                 retry = -1
  222.                 EXIT FOR
  223.             END IF
  224.         NEXT
  225.     LOOP WHILE retry
  226.     o(i).xv = RND * 1
  227.     o(i).yv = RND * 1
  228.     IF INT(RND + 0.5) = 1 THEN
  229.         flip = 1
  230.     ELSE
  231.         flip = -1
  232.     END IF
  233.     IF i > 1 THEN
  234.         o(i).id = o(i - 1).id + 1
  235.     ELSE
  236.         o(i).id = 1
  237.     END IF
  238.     o(i).speed = (0.2 + (RND * 1.5)) * flip 'base speed + random multiplier and random direction
  239.     o(i).state = 1
  240.     o(i).start = TIMER
  241.  
  242. FOR i = 1 TO totalInfected
  243.     infected = _CEIL(RND * UBOUND(o))
  244.     o(infected).state = 2
  245.     DO
  246.         retry = 0
  247.         FOR j = 1 TO UBOUND(wall) 'prevent creation of individuals inside walls
  248.             IF rectCirc(wall(j), o(infected), collision) THEN
  249.                 retry = -1
  250.                 EXIT FOR
  251.             END IF
  252.         NEXT
  253.     LOOP WHILE retry
  254.  
  255. COLOR _RGB32(255), _RGB32(0, 0)
  256.  
  257. starttime = TIMER
  258. initstatechange = chance.statechange
  259.  
  260.     framestart = TIMER
  261.     CLS
  262.  
  263.     FOR i = 1 TO UBOUND(wall)
  264.         LINE (wall(i).x, wall(i).y)-STEP(wall(i).w, wall(i).h), _RGB32(255), BF
  265.     NEXT
  266.  
  267.     healthy = 0: contamined = 0: dead = 0: recovered = 0: hospitalizedi = 0: hospitalizedh = 0: hospitalizedr = 0
  268.  
  269.     FOR i = 1 TO UBOUND(o)
  270.         '1 = healthy; 2 = contamined; 3 = dead; 4 = recovered; 5 = hospitalized with infection; 6 = hospitalized without infection
  271.         SELECT EVERYCASE o(i).state
  272.             CASE 1, 2, 4: move o(i)
  273.             CASE 2: evolve o(i)
  274.             CASE 5: cure o(i)
  275.             CASE 5, 6, 7: release o(i)
  276.             CASE 1, 2, 4
  277.                 checksymptoms o(i)
  278.                 IF o(i).symptoms = 1 THEN hospital o(i)
  279.             CASE 1, 2, 3, 4, 5, 6, 7: show o(i)
  280.             CASE 1: healthy = healthy + 1
  281.             CASE 2: contamined = contamined + 1
  282.             CASE 3: dead = dead + 1
  283.             CASE 4: recovered = recovered + 1
  284.             CASE 5: hospitalizedi = hospitalizedi + 1
  285.             CASE 6: hospitalizedh = hospitalizedh + 1
  286.             CASE 7: hospitalizedr = hospitalizedr + 1
  287.         END SELECT
  288.     NEXT
  289.  
  290.     savedata
  291.  
  292.     frameend = TIMER
  293.     frame = frame + 1
  294.  
  295.     REDIM _PRESERVE stat(0 TO UBOUND(stat) + 1) AS stat
  296.     stat(frame).dailyintake = dailyintake
  297.     IF frame MOD resolution = 0 THEN dailyintake = 0
  298.     stat(frame).healthy = healthy
  299.     stat(frame).contamined = contamined
  300.     stat(frame).dead = dead
  301.     stat(frame).recovered = recovered
  302.     stat(frame).hospitalizedi = hospitalizedi
  303.     stat(frame).hospitalizedh = hospitalizedh
  304.     stat(frame).hospitalizedr = hospitalizedr
  305.     stat(frame).hospitalized = hospitalizedi + hospitalizedh + hospitalizedr
  306.  
  307.     IF frame MOD resolution = 0 AND frame > resolution + 1 THEN
  308.         C = 0: R = 0
  309.         FOR i = frame - resolution - 1 TO frame - 1
  310.             C = C + stat(i).contact
  311.             R = R + stat(i).infections
  312.         NEXT
  313.         C = C / UBOUND(o)
  314.         R = R / stat(frame).contamined
  315.     END IF
  316.  
  317.     textstatusx = (graphux / _FONTWIDTH) + 3
  318.     textstatusy = (graphly / _FONTHEIGHT) + 1
  319.     LOCATE textstatusy, textstatusx
  320.     PRINT "Healthy:", healthy, , "[F5] to restart simulation"
  321.     LOCATE textstatusy + 1, textstatusx
  322.     PRINT "Contamined:", contamined, , "[F6] to replay"
  323.     LOCATE textstatusy + 2, textstatusx
  324.     PRINT "Dead:", dead
  325.     LOCATE textstatusy + 3, textstatusx
  326.     PRINT "Recovered:", recovered, , "People:", people
  327.     LOCATE textstatusy + 4, textstatusx
  328.     PRINT "Hospitalized:",
  329.     COLOR c(2)
  330.     PRINT hospitalizedi;
  331.     COLOR _RGB32(255)
  332.     PRINT "/";
  333.     COLOR c(1)
  334.     PRINT hospitalizedh;
  335.     COLOR _RGB32(255)
  336.     PRINT "/";
  337.     COLOR c(4)
  338.     PRINT hospitalizedr, ,
  339.     COLOR c(5)
  340.     PRINT LTRIM$(STR$(INT((stat(frame).hospitalized / hospitallimit) * 100))); "% Hospital utilization at "; LTRIM$(STR$(INT((stat(frame).dailyintake / dailylimit) * 100))); "% intake rate"
  341.     COLOR _RGB32(255)
  342.     LOCATE textstatusy + 6, textstatusx
  343.     PRINT "Day", INT(frame / resolution) + 1, , , "C="; C; " R="; R
  344.     LOCATE textstatusy + 7, textstatusx
  345.     PRINT "SIMULATION at" + STR$(1 / ((frameend - framestart) * resolution)) + " days per second"
  346.  
  347.     'graph
  348.     people = UBOUND(o)
  349.     LINE (graphlx, graphly)-(graphux, graphuy), _RGB32(0, 0), BF
  350.     graphwidth = graphux - graphlx
  351.     hgraphwidth = hgraphux - hgraphlx
  352.     graphheight = graphuy - graphly
  353.     hgraphheight = hgraphuy - hgraphly
  354.     IF TIMER - starttime > 1 THEN
  355.         gp = 0: DO: gp = gp + 1
  356.             LINE (graphlx + ((gp - 1) * graphwidth / UBOUND(stat)), graphly)-(graphlx + (gp * graphwidth / UBOUND(stat)), graphly + (graphheight * (stat(gp).healthy / people))), c(1), BF
  357.             LINE (graphlx + ((gp - 1) * graphwidth / UBOUND(stat)), graphly + (graphheight * (stat(gp).healthy / people)))-(graphlx + (gp * graphwidth / UBOUND(stat)), graphly + (graphheight * ((stat(gp).healthy + stat(gp).contamined) / people))), c(2), BF
  358.             LINE (graphlx + ((gp - 1) * graphwidth / UBOUND(stat)), graphly + (graphheight * ((stat(gp).healthy + stat(gp).contamined) / people)))-(graphlx + (gp * graphwidth / UBOUND(stat)), graphly + (graphheight * ((stat(gp).healthy + stat(gp).contamined + stat(gp).dead) / people))), c(3), BF
  359.             LINE (graphlx + ((gp - 1) * graphwidth / UBOUND(stat)), graphly + (graphheight * ((stat(gp).healthy + stat(gp).contamined + stat(gp).dead) / people)))-(graphlx + (gp * graphwidth / UBOUND(stat)), graphly + (graphheight * ((stat(gp).healthy + stat(gp).contamined + stat(gp).dead + stat(gp).recovered) / people))), c(4), BF
  360.             LINE (graphlx + ((gp - 1) * graphwidth / UBOUND(stat)), graphly + (graphheight * ((stat(gp).healthy + stat(gp).contamined + stat(gp).dead + stat(gp).recovered) / people)))-(graphlx + (gp * graphwidth / UBOUND(stat)), graphuy), c(5), BF
  361.             LINE (graphlx + ((gp - 1) * graphwidth / UBOUND(stat)), graphuy - (graphheight * ((stat(gp).contamined - stat(gp - 1).contamined) / people)))-(graphlx + (gp * graphwidth / UBOUND(stat)), graphuy - (graphheight * ((stat(gp).contamined - stat(gp - 1).contamined) / people))), _RGB32(255), BF
  362.             LINE (hgraphlx + ((gp - 1) * hgraphwidth / UBOUND(stat)), hgraphuy - ((stat(gp).dailyintake / hospitallimit) * hgraphheight))-(hgraphlx + (gp * hgraphwidth / UBOUND(stat)), hgraphuy), _RGBA(0, 200, 249, 255 / 2), BF
  363.             LINE (hgraphlx + ((gp - 1) * hgraphwidth / UBOUND(stat)), hgraphuy - ((stat(gp).hospitalized / hospitallimit) * hgraphheight))-(hgraphlx + (gp * hgraphwidth / UBOUND(stat)), hgraphuy), c(5), BF
  364.         LOOP UNTIL gp = UBOUND(stat)
  365.     END IF
  366.  
  367.     _DISPLAY
  368.     _LIMIT fps
  369.     endtime = TIMER - starttime
  370.     Key$ = INKEY$
  371.     IF Key$ = CHR$(0) + CHR$(63) THEN GOTO restart
  372.     IF Key$ = CHR$(0) + CHR$(64) THEN
  373.         CLOSE #1
  374.         GOTO restartreplay
  375.     END IF
  376. LOOP UNTIL _KEYHIT = 27 OR endtime = maxseconds - 1 'stops simulation
  377. 'replay
  378. restartreplay:
  379. REDIM stat(0) AS stat
  380. frame = 0
  381. replayspeed = fps / resolution
  382. OPEN "replay.dat" FOR BINARY AS #1
  383. people = UBOUND(o)
  384. starttime = TIMER
  385. IF EOF(1) = 0 THEN
  386.     DO
  387.         GET #1, , o()
  388.         CLS
  389.         healthy = 0: contamined = 0: dead = 0: recovered = 0: hospitalizedi = 0: hospitalizedh = 0: hospitalizedr = 0
  390.         dailyintake = 0
  391.  
  392.         FOR i = 1 TO UBOUND(wall)
  393.             LINE (wall(i).x, wall(i).y)-STEP(wall(i).w, wall(i).h), _RGB32(255), BF
  394.         NEXT
  395.  
  396.         FOR i = 1 TO UBOUND(o)
  397.             '1 = healthy; 2 = contamined; 3 = dead; 4 = recovered; 5 = hospitalized with infection; 6 = hospitalized without infection
  398.             SELECT EVERYCASE o(i).state
  399.                 CASE 1, 2, 3, 4, 5, 6, 7: show o(i)
  400.                 CASE 1: healthy = healthy + 1
  401.                 CASE 2: contamined = contamined + 1
  402.                 CASE 3: dead = dead + 1
  403.                 CASE 4: recovered = recovered + 1
  404.                 CASE 5: hospitalizedi = hospitalizedi + 1
  405.                 CASE 6: hospitalizedh = hospitalizedh + 1
  406.                 CASE 7: hospitalizedr = hospitalizedr + 1
  407.             END SELECT
  408.         NEXT
  409.         IF frame MOD resolution = 0 THEN
  410.             stat(frame).contact = stat(frame).contact / UBOUND(o)
  411.             'stat(frame).contact = 0
  412.         END IF
  413.  
  414.         frame = frame + 1
  415.         REDIM _PRESERVE stat(0 TO UBOUND(stat) + 1) AS stat
  416.         stat(frame).dailyintake = dailyintake
  417.         stat(frame).healthy = healthy
  418.         stat(frame).contamined = contamined
  419.         stat(frame).dead = dead
  420.         stat(frame).recovered = recovered
  421.         stat(frame).hospitalizedi = hospitalizedi
  422.         stat(frame).hospitalizedh = hospitalizedh
  423.         stat(frame).hospitalizedr = hospitalizedr
  424.         stat(frame).hospitalized = hospitalizedi + hospitalizedh + hospitalizedr
  425.         hospitalized = stat(frame).hospitalized
  426.  
  427.         textstatusx = (graphux / _FONTWIDTH) + 3
  428.         textstatusy = (graphly / _FONTHEIGHT) + 1
  429.         LOCATE textstatusy, textstatusx
  430.         PRINT "Healthy:", healthy, , "[F5] to restart replay"
  431.         LOCATE textstatusy + 1, textstatusx
  432.         PRINT "Contamined:", contamined, , "[F6] to switch to simulation"
  433.         LOCATE textstatusy + 2, textstatusx
  434.         PRINT "Dead:", dead
  435.         LOCATE textstatusy + 3, textstatusx
  436.         PRINT "Recovered:", recovered, , "People:", people
  437.         LOCATE textstatusy + 4, textstatusx
  438.         PRINT "Hospitalized:",
  439.         COLOR c(2)
  440.         PRINT hospitalizedi;
  441.         COLOR _RGB32(255)
  442.         PRINT "/";
  443.         COLOR c(1)
  444.         PRINT hospitalizedh;
  445.         COLOR _RGB32(255)
  446.         PRINT "/";
  447.         COLOR c(4)
  448.         PRINT hospitalizedr, ,
  449.         COLOR c(5)
  450.         PRINT LTRIM$(STR$(INT((stat(frame).hospitalized / hospitallimit) * 100))); "% Hospital utilization at "; LTRIM$(STR$(INT((stat(frame).dailyintake / dailylimit) * 100))); "% intake rate"
  451.         COLOR _RGB32(255)
  452.         LOCATE textstatusy + 6, textstatusx
  453.         PRINT "Day", INT(frame / resolution) + 1, , ,
  454.         IF saved = 0 THEN
  455.             PRINT "[F1] to save replay to file"
  456.         ELSE
  457.             PRINT "- Replay saved! -"
  458.         END IF
  459.         LOCATE textstatusy + 7, textstatusx
  460.         _CONTROLCHR OFF
  461.         PRINT , , , , "[F2] to load replay from file"
  462.         _CONTROLCHR ON
  463.         LOCATE textstatusy + 6, textstatusx
  464.         IF replayspeed <> 1 THEN
  465.             PRINT "REPLAY @ "; replayspeed; " days per second"
  466.         ELSE
  467.             PRINT "REPLAY @ "; replayspeed; " day per second"
  468.         END IF
  469.         LOCATE textstatusy + 5, textstatusx
  470.         PRINT CHR$(16) + " PLAY   "
  471.  
  472.         LINE (graphlx, graphly - 20)-(graphux, graphly - 5), _RGB32(255), B
  473.         LINE (graphlx, graphly - 20)-(graphlx + (LOC(1) / LOF(1) * (graphux - graphlx)), graphly - 5), _RGB32(255), BF
  474.  
  475.         'graph
  476.         graphwidth = graphux - graphlx
  477.         hgraphwidth = hgraphux - hgraphlx
  478.         graphheight = graphuy - graphly
  479.         hgraphheight = hgraphuy - hgraphly
  480.         IF TIMER - starttime > 1 THEN
  481.             gp = 0: DO: gp = gp + 1
  482.                 LINE (graphlx + ((gp - 1) * graphwidth / UBOUND(stat)), graphly)-(graphlx + (gp * graphwidth / UBOUND(stat)), graphly + (graphheight * (stat(gp).healthy / people))), c(1), BF
  483.                 LINE (graphlx + ((gp - 1) * graphwidth / UBOUND(stat)), graphly + (graphheight * (stat(gp).healthy / people)))-(graphlx + (gp * graphwidth / UBOUND(stat)), graphly + (graphheight * ((stat(gp).healthy + stat(gp).contamined) / people))), c(2), BF
  484.                 LINE (graphlx + ((gp - 1) * graphwidth / UBOUND(stat)), graphly + (graphheight * ((stat(gp).healthy + stat(gp).contamined) / people)))-(graphlx + (gp * graphwidth / UBOUND(stat)), graphly + (graphheight * ((stat(gp).healthy + stat(gp).contamined + stat(gp).dead) / people))), c(3), BF
  485.                 LINE (graphlx + ((gp - 1) * graphwidth / UBOUND(stat)), graphly + (graphheight * ((stat(gp).healthy + stat(gp).contamined + stat(gp).dead) / people)))-(graphlx + (gp * graphwidth / UBOUND(stat)), graphly + (graphheight * ((stat(gp).healthy + stat(gp).contamined + stat(gp).dead + stat(gp).recovered) / people))), c(4), BF
  486.                 LINE (graphlx + ((gp - 1) * graphwidth / UBOUND(stat)), graphly + (graphheight * ((stat(gp).healthy + stat(gp).contamined + stat(gp).dead + stat(gp).recovered) / people)))-(graphlx + (gp * graphwidth / UBOUND(stat)), graphuy), c(5), BF
  487.                 LINE (graphlx + ((gp - 1) * graphwidth / UBOUND(stat)), graphuy - (graphheight * ((stat(gp).contamined - stat(gp - 1).contamined) / people)))-(graphlx + (gp * graphwidth / UBOUND(stat)), graphuy - (graphheight * ((stat(gp).contamined - stat(gp - 1).contamined) / people))), _RGB32(255), BF
  488.                 LINE (hgraphlx + ((gp - 1) * hgraphwidth / UBOUND(stat)), hgraphuy - ((stat(gp).dailyintake / hospitallimit) * hgraphheight))-(hgraphlx + (gp * hgraphwidth / UBOUND(stat)), hgraphuy), _RGBA(0, 200, 249, 255 / 2), BF
  489.                 LINE (hgraphlx + ((gp - 1) * hgraphwidth / UBOUND(stat)), hgraphuy - ((stat(gp).hospitalized / hospitallimit) * hgraphheight))-(hgraphlx + (gp * hgraphwidth / UBOUND(stat)), hgraphuy), c(5), BF
  490.             LOOP UNTIL gp = UBOUND(stat)
  491.         END IF
  492.  
  493.         _DISPLAY
  494.         _LIMIT fps
  495.         Key$ = INKEY$
  496.         IF Key$ = " " THEN
  497.             COLOR _RGB32(255), _RGB32(0)
  498.             LOCATE textstatusy + 5, textstatusx
  499.             PRINT CHR$(186) + " PAUSE "
  500.             _DISPLAY
  501.             DO: LOOP UNTIL INKEY$ = " "
  502.         END IF
  503.         IF Key$ = CHR$(0) + CHR$(63) THEN GOTO restartreplay
  504.         IF Key$ = CHR$(0) + CHR$(64) THEN
  505.             CLOSE #1
  506.             GOTO restart
  507.         END IF
  508.         IF Key$ = CHR$(0) + CHR$(59) THEN savereplay
  509.         IF Key$ = CHR$(0) + CHR$(60) THEN
  510.             loadreplay
  511.             IF restartreplay = 1 THEN
  512.                 restartreplay = 0
  513.                 GOTO restartreplay
  514.             END IF
  515.         END IF
  516.     LOOP UNTIL EOF(1) = -1 'OR TIMER - starttime >= endtime
  517.     CLS
  518.     LOCATE (_HEIGHT / 2) / _FONTHEIGHT, (_WIDTH / 2) / _FONTWIDTH - (LEN("Replay finished.") / 2)
  519.     PRINT "Replay finished."
  520.     LOCATE ((_HEIGHT / 2) / _FONTHEIGHT) + 2, (_WIDTH / 2) / _FONTWIDTH - (LEN("[F5] to restart replay. [F6] to start a new simulation.") / 2)
  521.     PRINT "[F5] to restart replay. [F6] to start a new simulation."
  522.     _DISPLAY
  523.     Key$ = INKEY$
  524.     IF Key$ = CHR$(0) + CHR$(63) THEN GOTO restartreplay
  525.     IF Key$ = CHR$(0) + CHR$(64) THEN GOTO restart
  526.  
  527. SUB savereplay
  528.     CLOSE #1
  529.     OPEN "replay.dat" FOR BINARY AS #1
  530.     OPEN "saved_replay" + DATE$ + "_" + HEX$(TIMER) + ".prp" FOR BINARY AS #2
  531.     IF LOF(1) <> 0 THEN
  532.         DO
  533.             GET #1, , o()
  534.             PUT #2, , o()
  535.         LOOP UNTIL EOF(1) <> 0
  536.     END IF
  537.     CLOSE #1
  538.     CLOSE #2
  539.     OPEN "replay.dat" FOR BINARY AS #1
  540.     saved = 1
  541.  
  542. SUB loadreplay
  543.     ' Do the Open File dialog call!
  544.     Filter$ = "Pandemic Replay (*.prp)"
  545.     Flags& = OFN_FILEMUSTEXIST + OFN_NOCHANGEDIR + OFN_READONLY '    add flag constants here
  546.     OFile$ = GetOpenFileName$("Open Pandemic Replay", ".\", Filter$, 1, Flags&, hWnd&)
  547.  
  548.     IF OFile$ <> "" THEN ' Display Open dialog results
  549.         CLOSE #1
  550.         CLOSE #2
  551.         OPEN OFile$ FOR BINARY AS #1
  552.         OPEN "replay.dat" FOR BINARY AS #2
  553.         IF LOF(1) <> 0 THEN
  554.             DO
  555.                 GET #1, , o()
  556.                 PUT #2, , o()
  557.             LOOP UNTIL EOF(1) <> 0
  558.         END IF
  559.         CLOSE #1
  560.         CLOSE #2
  561.         restartreplay = 1
  562.     END IF
  563.  
  564. SUB savedata
  565.     PUT #1, , o()
  566.  
  567. SUB pandemicWindow (lx, ly, ux, uy)
  568.     addWall lx, ly + 15, ux - lx, 4
  569.     addWall lx, uy, ux - lx - 1, 4
  570.     addWall lx, ly, 3, uy - ly
  571.     addWall ux - 4, ly + 4, 3, uy - ly
  572.  
  573. SUB addWall (x AS INTEGER, y AS INTEGER, w AS INTEGER, h AS INTEGER)
  574.     REDIM _PRESERVE wall(1 TO UBOUND(wall) + 1) AS object
  575.     wall(UBOUND(wall)).x = x
  576.     wall(UBOUND(wall)).y = y
  577.     wall(UBOUND(wall)).w = w
  578.     wall(UBOUND(wall)).h = h
  579.  
  580. SUB checksymptoms (this AS object)
  581.     IF this.state = 2 THEN
  582.         IF RND * 100 <= chance.symptoms THEN
  583.             this.symptoms = 1
  584.         END IF
  585.     ELSE
  586.         IF RND * 100000 <= chance.symptoms THEN '1/1000 chance to show symptoms anyway
  587.             this.symptoms = 1
  588.         END IF
  589.     END IF
  590.  
  591. SUB hospital (this AS object)
  592.     IF RND * 100 <= chance.hospite * 100 AND hospitalized < hospitallimit AND dailyintake < dailylimit THEN 'only puts you in hospital if you're rich enough $$$$
  593.         dailyintake = dailyintake + 1
  594.         hospitalized = hospitalized + 1
  595.         this.x = (_WIDTH / 3 * 2) + (this.x / 2)
  596.         this.y = this.y * ((_HEIGHT - 230) / (_HEIGHT - 180))
  597.         IF this.state = 2 THEN
  598.             this.state = 5 'hospitalized with infection
  599.         ELSEIF this.state = 1 THEN
  600.             this.state = 6 'hospitalized healthy
  601.         ELSE
  602.             this.state = 7 'hospitalized recovered
  603.         END IF
  604.         this.intake = frame
  605.     END IF
  606.  
  607. SUB cure (this AS object)
  608.     IF RND * 100 <= chance.curing * 100 THEN
  609.         IF this.state = 5 THEN this.state = 7
  610.         this.symptoms = 0
  611.     END IF
  612.  
  613. SUB release (this AS object)
  614.     IF INT((frame - this.intake) / resolution) >= chance.laytime + (RND * (chance.laytime / 2)) - (chance.laytime / 4) THEN
  615.         hospitalized = hospitalized - 1
  616.         IF this.state = 5 THEN
  617.             this.state = 2
  618.         ELSEIF this.state = 6 THEN
  619.             this.state = 1
  620.         ELSEIF this.state = 7 THEN
  621.             this.state = 4
  622.         END IF
  623.         this.symptoms = 0
  624.         this.x = (this.x - (_WIDTH / 3 * 2)) * 2
  625.         this.y = this.y * ((_HEIGHT - 180) / (_HEIGHT - 230))
  626.     END IF
  627.  
  628. SUB evolve (this AS object)
  629.     'IF (frame - this.start) / resolution >= (chance.statechange / 2) * RND + (chance.statechange * 0.25) THEN 'if severity occurs, it does so before death
  630.     '    IF RND * 100 <= chance.severity * 100 THEN 'severity is only relevant when infected
  631.     '        this.severity = this.severity + 1
  632.     '    END IF
  633.     'END IF
  634.     IF INT((frame - this.start) / resolution) >= chance.statechange + (RND * (chance.statechange * 0.5)) THEN
  635.         this.start = frame
  636.         IF RND * 100 <= chance.death * 100 THEN
  637.             this.state = 3
  638.             this.symptoms = 0
  639.         ELSEIF RND * 100 <= chance.recover * 100 THEN
  640.             this.state = 4
  641.             this.symptoms = 0
  642.         END IF
  643.     END IF
  644.  
  645. SUB show (this AS object)
  646.     IF this.state = 5 OR this.state = 6 OR this.state = 7 THEN CircleFill this.x, this.y, this.size + 2, c(5)
  647.     IF this.symptoms = 1 THEN CircleFill this.x, this.y, this.size + 1, _RGB32(255)
  648.     CircleFill this.x, this.y, this.size, c(this.state)
  649.  
  650. SUB move (this AS object)
  651.     DIM collision AS object
  652.  
  653.     this.x = this.x + (this.xv * this.speed)
  654.     this.y = this.y + (this.yv * this.speed)
  655.     FOR i = 1 TO UBOUND(wall)
  656.         IF rectCirc(wall(i), this, collision) THEN
  657.             collType = (collision.x + collision.y)
  658.             SELECT CASE collType
  659.                 CASE 10, 12: this.xv = this.xv * -1
  660.                 CASE 17, 33: this.yv = this.yv * -1
  661.                 CASE ELSE
  662.                     this.xv = this.xv * -1
  663.                     this.yv = this.yv * -1
  664.             END SELECT
  665.             EXIT FOR
  666.         END IF
  667.     NEXT
  668.  
  669.     person = 0
  670.     FOR i = 1 TO UBOUND(o)
  671.         IF dist(o(i), this) < this.size + (safedistance * (RND + 0.5)) AND o(i).id <> this.id AND RND * 100 <= socialdistancing THEN 'different chance of recognizing safedistance than the infection
  672.             person = person + 1
  673.             REDIM moveid(0 TO person) AS moveid
  674.             moveid(person).id = o(i).id
  675.             moveid(person).xv = o(i).xv
  676.             moveid(person).yv = o(i).yv
  677.         END IF
  678.         IF dist(o(i), this) < this.size + (safedistance * RND) AND o(i).id <> this.id THEN
  679.             stat(frame).contact = stat(frame).contact + 1
  680.             IF o(i).state = 2 AND this.state <> 2 THEN
  681.                 IF this.state <> 4 AND RND * 1 <= chance.infection THEN
  682.                     stat(frame).infections = stat(frame).infections + 1
  683.                     this.state = 2
  684.                     this.start = frame
  685.                 ELSEIF this.state = 4 AND RND * 1 < chance.reinfection THEN
  686.                     stat(frame).infections = stat(frame).infections + 1
  687.                     this.state = 2
  688.                     this.start = frame
  689.                 END IF
  690.             END IF
  691.         END IF
  692.     NEXT
  693.     IF UBOUND(moveid) > 0 THEN
  694.         v.xv = 0
  695.         v.yv = 0
  696.         FOR p = 1 TO UBOUND(moveid)
  697.             v.xv = v.xv + (moveid(p).xv / UBOUND(moveid))
  698.             v.yv = v.yv + (moveid(p).yv / UBOUND(moveid))
  699.         NEXT
  700.         this.xv = -this.xv
  701.         this.yv = -this.yv
  702.         REDIM moveid(0) AS moveid
  703.     END IF
  704.  
  705. SUB CircleFill (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
  706.     ' CX = center x coordinate
  707.     ' CY = center y coordinate
  708.     '  R = radius
  709.     '  C = fill color
  710.     DIM Radius AS INTEGER, RadiusError AS INTEGER
  711.     DIM X AS INTEGER, Y AS INTEGER
  712.     Radius = ABS(R)
  713.     RadiusError = -Radius
  714.     X = Radius
  715.     Y = 0
  716.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
  717.     LINE (CX - X, CY)-(CX + X, CY), C, BF
  718.     WHILE X > Y
  719.         RadiusError = RadiusError + Y * 2 + 1
  720.         IF RadiusError >= 0 THEN
  721.             IF X <> Y + 1 THEN
  722.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  723.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  724.             END IF
  725.             X = X - 1
  726.             RadiusError = RadiusError - X * 2
  727.         END IF
  728.         Y = Y + 1
  729.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  730.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  731.     WEND
  732.  
  733. FUNCTION rectCirc%% (rect AS object, circ AS object, collision AS object)
  734.     'adapted from http://www.jeffreythompson.org/collision-detection/circle-rect.php
  735.     DIM test AS object
  736.     test.x = circ.x
  737.     test.y = circ.y
  738.  
  739.     collision.x = 1
  740.     IF circ.x < rect.x THEN
  741.         test.x = rect.x
  742.         collision.x = 2
  743.     ELSEIF circ.x > rect.x + rect.w THEN
  744.         test.x = rect.x + rect.w
  745.         collision.x = 4
  746.     END IF
  747.  
  748.     collision.y = 8
  749.     IF circ.y < rect.y THEN
  750.         test.y = rect.y
  751.         collision.y = 16
  752.     ELSEIF circ.y > rect.y + rect.h THEN
  753.         test.y = rect.y + rect.h
  754.         collision.y = 32
  755.     END IF
  756.  
  757.     rectCirc%% = (dist(circ, test) <= circ.size)
  758.  
  759. FUNCTION dist! (o1 AS object, o2 AS object)
  760.     x1! = o1.x
  761.     y1! = o1.y
  762.     x2! = o2.x
  763.     y2! = o2.y
  764.     dist! = _HYPOT((x2! - x1!), (y2! - y1!))
  765.  
  766. FUNCTION map! (value!, minRange!, maxRange!, newMinRange!, newMaxRange!)
  767.     map! = ((value! - minRange!) / (maxRange! - minRange!)) * (newMaxRange! - newMinRange!) + newMinRange!
  768.  
  769. FUNCTION GetOpenFileName$ (Title$, InitialDir$, Filter$, FilterIndex, Flags&, hWnd&)
  770.     '  Title$      - The dialog title.
  771.     '  InitialDir$ - If this left blank, it will use the directory where the last opened file is
  772.     '  located. Specify ".\" if you want to always use the current directory.
  773.     '  Filter$     - File filters separated by pipes (|) in the same format as using VB6 common dialogs.
  774.     '  FilterIndex - The initial file filter to use. Will be altered by user during the call.
  775.     '  Flags&      - Dialog flags. Will be altered by the user during the call.
  776.     '  hWnd&       - Your program's window handle that should be aquired by the FindWindow function.
  777.     '
  778.     ' Returns: Blank when cancel is clicked otherwise, the file name selected by the user.
  779.     ' FilterIndex and Flags& will be changed depending on the user's selections.
  780.  
  781.     DIM OpenCall AS FILEDIALOGTYPE ' Needed for dialog call
  782.  
  783.     fFilter$ = Filter$
  784.     FOR R = 1 TO LEN(fFilter$) ' Replace the pipes with character zero
  785.         IF MID$(fFilter$, R, 1) = "|" THEN MID$(fFilter$, R, 1) = CHR$(0)
  786.     NEXT R
  787.     fFilter$ = fFilter$ + CHR$(0)
  788.  
  789.     lpstrFile$ = STRING$(2048, 0) ' For the returned file name
  790.     lpstrDefExt$ = STRING$(10, 0) ' Extension will not be added when this is not specified
  791.     OpenCall.lStructSize = LEN(OpenCall)
  792.     OpenCall.hwndOwner = hWnd&
  793.     OpenCall.lpstrFilter = _OFFSET(fFilter$)
  794.     OpenCall.nFilterIndex = FilterIndex
  795.     OpenCall.lpstrFile = _OFFSET(lpstrFile$)
  796.     OpenCall.nMaxFile = LEN(lpstrFile$) - 1
  797.     OpenCall.lpstrFileTitle = OpenCall.lpstrFile
  798.     OpenCall.nMaxFileTitle = OpenCall.nMaxFile
  799.     OpenCall.lpstrInitialDir = _OFFSET(InitialDir$)
  800.     OpenCall.lpstrTitle = _OFFSET(Title$)
  801.     OpenCall.lpstrDefExt = _OFFSET(lpstrDefExt$)
  802.     OpenCall.flags = Flags&
  803.  
  804.     Result = GetOpenFileNameA&(OpenCall) '            Do Open File dialog call!
  805.  
  806.     IF Result THEN ' Trim the remaining zeros
  807.         GetOpenFileName$ = LEFT$(lpstrFile$, INSTR(lpstrFile$, CHR$(0)) - 1)
  808.         Flags& = OpenCall.flags
  809.         FilterIndex = OpenCall.nFilterIndex
  810.     END IF
  811.  
  812.  
  813. FUNCTION GetSaveFileName$ (Title$, InitialDir$, Filter$, FilterIndex, Flags&, hWnd&)
  814.     '  Title$      - The dialog title.
  815.     '  InitialDir$ - If this left blank, it will use the directory where the last opened file is
  816.     '     located. Specify ".\" if you want to always use the current directory.
  817.     '  Filter$     - File filters separated by pipes (|) in the same format as VB6 common dialogs.
  818.     '  FilterIndex - The initial file filter to use. Will be altered by user during the call.
  819.     '  Flags&      - Dialog flags. Will be altered by the user during the call.
  820.     '  hWnd&       - Your program's window handle that should be aquired by the FindWindow function.
  821.  
  822.     ' Returns: Blank when cancel is clicked otherwise, the file name entered by the user.
  823.     ' FilterIndex and Flags& will be changed depending on the user's selections.
  824.  
  825.     DIM SaveCall AS FILEDIALOGTYPE ' Needed for dialog call
  826.  
  827.     fFilter$ = Filter$
  828.     FOR R = 1 TO LEN(fFilter$) ' Replace the pipes with zeros
  829.         IF MID$(fFilter$, R, 1) = "|" THEN MID$(fFilter$, R, 1) = CHR$(0)
  830.     NEXT R
  831.     fFilter$ = fFilter$ + CHR$(0)
  832.  
  833.     lpstrFile$ = STRING$(2048, 0) ' For the returned file name
  834.     lpstrDefExt$ = STRING$(10, 0) ' Extension will not be added when this is not specified
  835.     SaveCall.lStructSize = LEN(SaveCall)
  836.     SaveCall.hwndOwner = hWnd&
  837.     SaveCall.lpstrFilter = _OFFSET(fFilter$)
  838.     SaveCall.nFilterIndex = FilterIndex
  839.     SaveCall.lpstrFile = _OFFSET(lpstrFile$)
  840.     SaveCall.nMaxFile = LEN(lpstrFile$) - 1
  841.     SaveCall.lpstrFileTitle = SaveCall.lpstrFile
  842.     SaveCall.nMaxFileTitle = SaveCall.nMaxFile
  843.     SaveCall.lpstrInitialDir = _OFFSET(InitialDir$)
  844.     SaveCall.lpstrTitle = _OFFSET(Title$)
  845.     SaveCall.lpstrDefExt = _OFFSET(lpstrDefExt$)
  846.     SaveCall.flags = Flags&
  847.  
  848.     Result& = GetSaveFileNameA&(SaveCall) ' Do dialog call!
  849.  
  850.     IF Result& THEN ' Trim the remaining zeros
  851.         GetSaveFileName$ = LEFT$(lpstrFile$, INSTR(lpstrFile$, CHR$(0)) - 1)
  852.         Flags& = SaveCall.flags
  853.         FilterIndex = SaveCall.nFilterIndex
  854.     END IF
Check out what I do besides coding: http://loudar.myportfolio.com/

Offline luke

  • Administrator
  • Seasoned Forum Regular
  • Posts: 324
    • View Profile
Re: Pandemic Simulation (joint effort with Fellippe!)
« Reply #6 on: July 22, 2020, 11:09:26 am »
I did a similar kind of thing, although I've only got susceptible, infect, recovered and dead states. Sometimes patient zero dies before they can transmit the disease, so you might need to run it multiple times.
Green: Susceptible
Red: Infected
Blue: Recovered
Black: Dead

Code: [Select]
SCREEN _NEWIMAGE(800, 600, 32)

RANDOMIZE TIMER

CONST NUM_PEOPLE = 10000
CONST PERSON_SIZE = 2
CONST PROB_INFECT = 0.05
CONST PROB_RECOVER = 0.005
CONST PROB_DEATH = 0.001


TYPE object
    x AS SINGLE
    y AS SINGLE
    xv AS SINGLE
    yv AS SINGLE
    state AS _BYTE
    size AS INTEGER
    infected_time AS INTEGER
END TYPE

CONST STATE_SUSCEPTIBLE = 1
CONST STATE_INFECTED = 2
CONST STATE_RECOVERED = 3
CONST STATE_DEAD = 4


DIM SHARED o(NUM_PEOPLE) AS object
DIM SHARED infections(-1 TO _WIDTH + 1, -1 TO _HEIGHT + 1) AS _BYTE
DIM SHARED total_susceptible
DIM SHARED total_infected
DIM SHARED total_recovered
DIM SHARED total_dead

'generate individuals
FOR i = 1 TO UBOUND(o)
    o(i).x = rndx * _WIDTH
    o(i).y = rndx * _HEIGHT
    o(i).xv = 1 - rndx * 2
    o(i).yv = 1 - rndx * 2
    o(i).state = STATE_SUSCEPTIBLE
    o(i).size = PERSON_SIZE
NEXT

o(NUM_PEOPLE).state = STATE_INFECTED
infections(o(NUM_PEOPLE).x, o(NUM_PEOPLE).y) = 1
total_susceptible = NUM_PEOPLE - 1
total_infected = 1


DIM colours(1 TO 10) AS _UNSIGNED LONG
colours(STATE_SUSCEPTIBLE) = _RGB32(11, 255, 0)
colours(STATE_INFECTED) = _RGB32(200, 67, 17)
colours(STATE_RECOVERED) = _RGB32(61, 128, 238)
colours(STATE_DEAD) = _RGBA32(0, 0, 0, 0)


DO
    CLS
    FOR i = 1 TO UBOUND(o)
        move o(i)
        SELECT CASE o(i).state
            CASE STATE_SUSCEPTIBLE
                IF rndx < PROB_INFECT THEN infect o(i)
            CASE STATE_INFECTED
                obj.infected_time = obj.infected_time + 1
                r = rndx
                IF r < PROB_DEATH THEN
                    die o(i)
                ELSEIF r < PROB_DEATH + PROB_RECOVER THEN
                    recover o(i)
                END IF
        END SELECT
        IF o(i).size = 1 THEN PSET (o(i).x, o(i).y), colours(o(i).state) ELSE CircleFill o(i).x, o(i).y, o(i).size, colours(o(i).state)
    NEXT
    PRINT "Susceptible:"; total_susceptible
    PRINT "Infected:"; total_infected
    PRINT "Recovered:"; total_recovered
    PRINT "Dead:"; total_dead
    _LIMIT 120
    _DISPLAY
LOOP UNTIL total_infected = 0

END

SUB die (obj AS object)
    infections(obj.x, obj.y) = infections(obj.x, obj.y) - 1
    obj.state = STATE_DEAD
    total_infected = total_infected - 1
    total_dead = total_dead + 1
END SUB

SUB infect (obj AS object)
    FOR x& = max(0, obj.x - obj.size * 2) TO min(obj.x + obj.size * 2, _WIDTH)
        FOR y& = max(0, obj.y - obj.size * 2) TO min(obj.y + obj.size * 2, _HEIGHT)
            IF infections(x&, y&) THEN
                obj.state = STATE_INFECTED
                infections(obj.x, obj.y) = infections(obj.x, obj.y) + 1
                total_susceptible = total_susceptible - 1
                total_infected = total_infected + 1
                EXIT SUB
            END IF
        NEXT y&
    NEXT x&
END SUB

SUB recover (obj AS object)
    infections(obj.x, obj.y) = infections(obj.x, obj.y) - 1
    obj.state = STATE_RECOVERED
    total_infected = total_infected - 1
    total_recovered = total_recovered + 1
    obj.infected_time = 0
END SUB



FUNCTION min& (a&, b&)
    IF a& < b& THEN min& = a& ELSE min& = b&
END FUNCTION

FUNCTION max& (a&, b&)
    IF a& < b& THEN max& = b& ELSE max& = a&
END FUNCTION

SUB move (obj AS object)
    IF obj.state = STATE_INFECTED THEN infections(obj.x, obj.y) = infections(obj.x, obj.y) - 1
    obj.x = obj.x + obj.xv
    IF obj.x < 0 OR obj.x > _WIDTH THEN obj.xv = obj.xv * -1

    obj.y = obj.y + obj.yv
    IF obj.y < 0 OR obj.y > _HEIGHT THEN obj.yv = obj.yv * -1
    IF obj.state = STATE_INFECTED THEN infections(obj.x, obj.y) = infections(obj.x, obj.y) + 1
END SUB

SUB CircleFill (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
    ' CX = center x coordinate
    ' CY = center y coordinate
    '  R = radius
    '  C = fill color
    DIM Radius AS INTEGER, RadiusError AS INTEGER
    DIM X AS INTEGER, Y AS INTEGER
    Radius = ABS(R)
    RadiusError = -Radius
    X = Radius
    Y = 0
    IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
    LINE (CX - X, CY)-(CX + X, CY), C, BF
    WHILE X > Y
        RadiusError = RadiusError + Y * 2 + 1
        IF RadiusError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    WEND
END SUB


FUNCTION rndx
    $IF WINDOWS THEN
        rndx = RND
    $ELSE
        STATIC f&
        IF f& = 0 THEN
            f& = FREEFILE
            OPEN "/dev/urandom" FOR BINARY AS #f&
        END IF
        GET #f&, , v~&
        rndx = v~& / (2 ^ 32 - 1)
    $END IF
END FUNCTION

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
Re: Pandemic Simulation (joint effort with Fellippe!)
« Reply #7 on: July 23, 2020, 03:45:24 am »
I modified Luke's code so that rendering part is handle by OpenGL.
The following program efficiently renders 100K people.

Code: QB64: [Select]
  1. 'Pandemic Simulator by luke
  2. 'OpenGL rendering MOD Ashish
  3. _TITLE "Pandemic Simulator by Luke MOD Ashish [100K People]"
  4. SCREEN _NEWIMAGE(800, 600, 32)
  5.  
  6.  
  7. CONST NUM_PEOPLE = 100000
  8. CONST PERSON_SIZE = 1
  9. CONST PROB_INFECT = 0.05
  10. CONST PROB_RECOVER = 0.005
  11. CONST PROB_DEATH = 0.001
  12.  
  13. TYPE gl_color
  14.     r AS SINGLE
  15.     g AS SINGLE
  16.     b AS SINGLE
  17.     a AS SINGLE
  18.  
  19.  
  20. TYPE object
  21.     x AS SINGLE '4bytes
  22.     y AS SINGLE '4bytes
  23.     clr AS gl_color '16 bytes
  24.     xv AS SINGLE '4bytes
  25.     yv AS SINGLE '4bytes
  26.     state AS _BYTE '1 byte
  27.     size AS INTEGER '2 bytes
  28.     infected_time AS INTEGER '2 bytes
  29.  
  30. CONST STATE_SUSCEPTIBLE = 1
  31. CONST STATE_INFECTED = 2
  32. CONST STATE_RECOVERED = 3
  33. CONST STATE_DEAD = 4
  34.  
  35.  
  36. DIM SHARED o(NUM_PEOPLE) AS object
  37. DIM SHARED infections(-1 TO _WIDTH + 1, -1 TO _HEIGHT + 1) AS _BYTE
  38. DIM SHARED total_susceptible
  39. DIM SHARED total_infected
  40. DIM SHARED total_recovered
  41. DIM SHARED total_dead
  42.  
  43. DIM SHARED glAllow AS _BYTE
  44.  
  45. 'generate individuals
  46. FOR i = 1 TO UBOUND(o)
  47.     'o(i).x = rndx * _WIDTH
  48.     'o(i).y = rndx * _HEIGHT
  49.     'o(i).xv = 1 - rndx * 2
  50.     'o(i).yv = 1 - rndx * 2
  51.     o(i).x = RND * _WIDTH
  52.     o(i).y = RND * _HEIGHT
  53.     o(i).xv = 1 - RND * 2
  54.     o(i).yv = 1 - RND * 2
  55.  
  56.     o(i).state = STATE_SUSCEPTIBLE
  57.     o(i).size = PERSON_SIZE
  58.  
  59. o(NUM_PEOPLE).state = STATE_INFECTED
  60. infections(o(NUM_PEOPLE).x, o(NUM_PEOPLE).y) = 1
  61. total_susceptible = NUM_PEOPLE - 1
  62. total_infected = 1
  63.  
  64.  
  65. 'DIM colours(1 TO 10) AS _UNSIGNED LONG
  66. 'colours(STATE_SUSCEPTIBLE) = _RGB32(11, 255, 0)
  67. 'colours(STATE_INFECTED) = _RGB32(200, 67, 17)
  68. 'colours(STATE_RECOVERED) = _RGB32(61, 128, 238)
  69. 'colours(STATE_DEAD) = _RGBA32(0, 0, 0, 0)
  70.  
  71. DIM colours(1 TO 10) AS gl_color
  72. colours(STATE_SUSCEPTIBLE).r = 11 / 255
  73. colours(STATE_SUSCEPTIBLE).g = 255 / 255
  74. colours(STATE_SUSCEPTIBLE).b = 0 / 255
  75. colours(STATE_SUSCEPTIBLE).a = 0.5
  76.  
  77. colours(STATE_INFECTED).r = 200 / 255
  78. colours(STATE_INFECTED).g = 67 / 255
  79. colours(STATE_INFECTED).b = 17 / 255
  80. colours(STATE_INFECTED).a = 0.5
  81.  
  82. colours(STATE_RECOVERED).r = 61 / 255
  83. colours(STATE_RECOVERED).g = 128 / 255
  84. colours(STATE_RECOVERED).b = 238 / 255
  85. colours(STATE_RECOVERED).a = 0.5
  86.  
  87. colours(STATE_DEAD).r = 0 / 255
  88. colours(STATE_DEAD).g = 0 / 255
  89. colours(STATE_DEAD).b = 0 / 255
  90. colours(STATE_DEAD).a = 0.5
  91.  
  92. COLOR , 1
  93. glAllow = 1
  94.  
  95.     CLS , 1
  96.     FOR i = 1 TO UBOUND(o)
  97.         o(i).clr = colours(o(i).state)
  98.         move o(i)
  99.         SELECT CASE o(i).state
  100.             CASE STATE_SUSCEPTIBLE
  101.                 IF rndx < PROB_INFECT THEN infect o(i)
  102.             CASE STATE_INFECTED
  103.                 obj.infected_time = obj.infected_time + 1
  104.                 r = rndx
  105.                 IF r < PROB_DEATH THEN
  106.                     die o(i)
  107.                 ELSEIF r < PROB_DEATH + PROB_RECOVER THEN
  108.                     recover o(i)
  109.                 END IF
  110.         END SELECT
  111.         'IF o(i).size = 1 THEN PSET (o(i).x, o(i).y), colours(o(i).state) ELSE CircleFill o(i).x, o(i).y, o(i).size, colours(o(i).state)
  112.     NEXT
  113.     PRINT "Susceptible:"; total_susceptible
  114.     PRINT "Infected:"; total_infected
  115.     PRINT "Recovered:"; total_recovered
  116.     PRINT "Dead:"; total_dead
  117.     _LIMIT 120
  118.     _DISPLAY
  119. LOOP UNTIL total_infected = 0
  120.  
  121.  
  122. SUB _GL ()
  123.     IF glAllow = 0 THEN EXIT SUB
  124.     STATIC init, offx, offy
  125.     IF init = 0 THEN
  126.         init = 1
  127.         _glViewport 0, 0, _WIDTH, _HEIGHT
  128.         offx = _WIDTH / 2
  129.         offy = _HEIGHT / 2
  130.     END IF
  131.  
  132.     _glEnable _GL_BLEND
  133.  
  134.     _glMatrixMode _GL_MODELVIEW
  135.     _glTranslatef -1, 1, 0
  136.     _glScalef 1 / offx, -1 / offy, 1
  137.  
  138.  
  139.     'main rendering of objects done here
  140.     _glPointSize PERSON_SIZE * 2
  141.     _glEnableClientState _GL_VERTEX_ARRAY
  142.     _glEnableClientState _GL_COLOR_ARRAY
  143.     _glColorPointer 4, _GL_FLOAT, 37, _OFFSET(o()) + 8
  144.     _glVertexPointer 2, _GL_FLOAT, 37, _OFFSET(o())
  145.     _glDrawArrays _GL_POINTS, 1, UBOUND(o)
  146.     _glDisableClientState _GL_COLOR_ARRAY
  147.     _glDisableClientState _GL_VERTEX_ARRAY
  148.  
  149.     _glFlush
  150.  
  151.  
  152.  
  153. SUB die (obj AS object)
  154.     infections(obj.x, obj.y) = infections(obj.x, obj.y) - 1
  155.     obj.state = STATE_DEAD
  156.     total_infected = total_infected - 1
  157.     total_dead = total_dead + 1
  158.  
  159. SUB infect (obj AS object)
  160.     FOR x& = max(0, obj.x - obj.size * 2) TO min(obj.x + obj.size * 2, _WIDTH)
  161.         FOR y& = max(0, obj.y - obj.size * 2) TO min(obj.y + obj.size * 2, _HEIGHT)
  162.             IF infections(x&, y&) THEN
  163.                 obj.state = STATE_INFECTED
  164.                 infections(obj.x, obj.y) = infections(obj.x, obj.y) + 1
  165.                 total_susceptible = total_susceptible - 1
  166.                 total_infected = total_infected + 1
  167.                 EXIT SUB
  168.             END IF
  169.         NEXT y&
  170.     NEXT x&
  171.  
  172. SUB recover (obj AS object)
  173.     infections(obj.x, obj.y) = infections(obj.x, obj.y) - 1
  174.     obj.state = STATE_RECOVERED
  175.     total_infected = total_infected - 1
  176.     total_recovered = total_recovered + 1
  177.     obj.infected_time = 0
  178.  
  179.  
  180.  
  181. FUNCTION min& (a&, b&)
  182.     IF a& < b& THEN min& = a& ELSE min& = b&
  183.  
  184. FUNCTION max& (a&, b&)
  185.     IF a& < b& THEN max& = b& ELSE max& = a&
  186.  
  187. SUB move (obj AS object)
  188.     IF obj.state = STATE_INFECTED THEN infections(obj.x, obj.y) = infections(obj.x, obj.y) - 1
  189.     obj.x = obj.x + obj.xv
  190.     IF obj.x < 0 OR obj.x > _WIDTH THEN obj.xv = obj.xv * -1
  191.  
  192.     obj.y = obj.y + obj.yv
  193.     IF obj.y < 0 OR obj.y > _HEIGHT THEN obj.yv = obj.yv * -1
  194.     IF obj.state = STATE_INFECTED THEN infections(obj.x, obj.y) = infections(obj.x, obj.y) + 1
  195.  
  196. SUB CircleFill (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
  197.     ' CX = center x coordinate
  198.     ' CY = center y coordinate
  199.     '  R = radius
  200.     '  C = fill color
  201.     DIM Radius AS INTEGER, RadiusError AS INTEGER
  202.     DIM X AS INTEGER, Y AS INTEGER
  203.     Radius = ABS(R)
  204.     RadiusError = -Radius
  205.     X = Radius
  206.     Y = 0
  207.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
  208.     LINE (CX - X, CY)-(CX + X, CY), C, BF
  209.     WHILE X > Y
  210.         RadiusError = RadiusError + Y * 2 + 1
  211.         IF RadiusError >= 0 THEN
  212.             IF X <> Y + 1 THEN
  213.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  214.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  215.             END IF
  216.             X = X - 1
  217.             RadiusError = RadiusError - X * 2
  218.         END IF
  219.         Y = Y + 1
  220.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  221.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  222.     WEND
  223.  
  224.  
  225.     $IF WINDOWS THEN
  226.         rndx = RND
  227.     $ELSE
  228.         STATIC f&
  229.         IF f& = 0 THEN
  230.         f& = FREEFILE
  231.         OPEN "/dev/urandom" FOR BINARY AS #f&
  232.         END IF
  233.         GET #f&, , v~&
  234.         rndx = v~& / (2 ^ 32 - 1)
  235.     $END IF
  236.  
  237.  
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: Pandemic Simulation (joint effort with Fellippe!)
« Reply #8 on: July 23, 2020, 07:08:44 am »
@loudar
to the first version.... to see the whole screen on my little notebook I have had
Code: QB64: [Select]
  1.     _FULLSCREEN  ,  _SMOOTH

It is fun but my epidemy is slow and so it is no an epidemy!
I'm lucky!
Programming isn't difficult, only it's  consuming time and coffee

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: Pandemic Simulation (joint effort with Fellippe!)
« Reply #9 on: July 23, 2020, 07:20:11 am »
@loudar
the same for the other 2 versions... that work well and are more expressive!
Programming isn't difficult, only it's  consuming time and coffee

Offline TempodiBasic

  • Forum Resident
  • Posts: 1792
    • View Profile
Re: Pandemic Simulation (joint effort with Fellippe!)
« Reply #10 on: July 23, 2020, 07:31:22 am »
@Ashish
1. Great for _Opengl version
2. Impressive as it can show the contiguous contagion by direct contact... it is the same of the spreading of cancer in the body in the place of development site.
3. it is fine to see in the model 2 other variables of epidemy's life...
  3.1 the travelling of a contagiuos to another part of the world  ( a jump to a safe area of the world is like a travel by air or by ship)
  3.2 the use of isolation of persons for protection  (1/100 of rate of contagion)
  3.3 the use of barrier protections (mask, glovers and so on  1/50 of rate of contagion)
  3.4 the use of enpowering Immunitary Defence (good foods, no stress, the right rest,  1/50 of rate of contagion and 1/60 of rate of death)

mathematical simulation is very cool!
Programming isn't difficult, only it's  consuming time and coffee

Offline loudar

  • Newbie
  • Posts: 73
  • improve it bit by bit.
    • View Profile
Re: Pandemic Simulation (joint effort with Fellippe!)
« Reply #11 on: July 23, 2020, 12:27:35 pm »
@loudar
the same for the other 2 versions... that work well and are more expressive!

Yeah I wish the advancements of the other two versions would be merged with the more feature-rich version, but they use the stuff that I barely know, so I'd take way too long to implement it. But they're really cool.
Check out what I do besides coding: http://loudar.myportfolio.com/