'Corona virus simulator 'by badidea ≫ Apr 01, 2020 22:23 'https://www.freebasic.net/forum/viewtopic.php?f=3&t=28414&start=30#p270296 'Simulation of virus containment failure: '国境を越えてウイルスが拡散するシミュレーション #Include "fbgfx.bi" #Include "string.bi" ' Sets the graphics method GDI ' 描画方法を GDI に設定 SetEnviron("fbgfx=GDI") Type int2d As Integer x, y Declare Constructor Declare Constructor(x As Integer, y As Integer) Declare Operator Cast () As String End Type Constructor int2d End Constructor Constructor int2d(x As Integer, y As Integer) This.x = x : This.y = y End Constructor ' "x, y" Operator int2d.cast () As String Return Str(x) & "," & Str(y) End Operator Operator = (a As int2d, b As int2d) As boolean If a.x <> b.x Then Return FALSE If a.y <> b.y Then Return FALSE Return TRUE End Operator Operator <> (a As int2d, b As int2d) As boolean If a.x = b.x And a.y = b.y Then Return FALSE Return TRUE End Operator ' a + b Operator + (a As int2d, b As int2d) As int2d Return Type(a.x + b.x, a.y + b.y) End Operator ' a - b Operator - (a As int2d, b As int2d) As int2d Return Type(a.x - b.x, a.y - b.y) End Operator ' -a Operator - (a As int2d) As int2d Return Type(-a.x, -a.y) End Operator ' a * b Operator * (a As int2d, b As int2d) As int2d Return Type(a.x * b.x, a.y * b.y) End Operator ' a * mul Operator * (a As int2d, mul As Integer) As int2d Return Type(a.x * mul, a.y * mul) End Operator ' a \ b Operator \ (a As int2d, b As int2d) As int2d Return Type(a.x \ b.x, a.y \ b.y) End Operator ' a \ div Operator \ (a As int2d, divider As Integer) As int2d Return Type(a.x \ divider, a.y \ divider) End Operator '=============================================================================== Type sgl2d As Single x, y Declare Constructor Declare Constructor(x As Single, y As Single) Declare Operator Cast() As String Declare Function cross(b As sgl2d) As Single Declare Function lengthSqrd() As Single Declare Function dist(b As sgl2d) As Single Declare Function distSqrd(b As sgl2d) As Single Declare Function normalise() As sgl2d End Type Constructor sgl2d End Constructor Constructor sgl2d(x As Single, y As Single) This.x = x : This.y = y End Constructor Function sgl2d.cross(b As sgl2d) As Single Return This.x * b.y - This.y * b.x End Function Function sgl2d.lengthSqrd() As Single Return (This.x * This.x) + (This.y * This.y) End Function Function sgl2d.dist(b As sgl2d) As Single Dim As Single dx = This.x - b.x Dim As Single dy = This.y - b.y Return Sqr((dx * dx) + (dy * dy)) End Function Function sgl2d.distSqrd(b As sgl2d) As Single Dim As Single dx = This.x - b.x Dim As Single dy = This.y - b.y Return (dx * dx) + (dy * dy) End Function Function sgl2d.normalise() As sgl2d Dim As Single length = Sqr((This.x * This.x) + (This.y * This.y)) Return sgl2d(This.x / length, This.y / length) End Function ' "x, y" Operator sgl2d.cast() As String Return Str(x) & "," & Str(y) End Operator '---- operators --- ' distance / lenth Operator Len (a As sgl2d) As Single Return Sqr(a.x * a.x + a.y * a.y) End Operator ' a = b ? Operator = (a As sgl2d, b As sgl2d) As boolean If a.x <> b.x Then Return FALSE If a.y <> b.y Then Return FALSE Return TRUE End Operator ' a != b ? Operator <> (a As sgl2d, b As sgl2d) As boolean If a.x = b.x And a.y = b.y Then Return FALSE Return TRUE End Operator ' a + b Operator + (a As sgl2d, b As sgl2d) As sgl2d Return Type(a.x + b.x, a.y + b.y) End Operator ' a - b Operator - (a As sgl2d, b As sgl2d) As sgl2d Return Type(a.x - b.x, a.y - b.y) End Operator ' -a Operator - (a As sgl2d) As sgl2d Return Type(-a.x, -a.y) End Operator ' a * b Operator * (a As sgl2d, b As sgl2d) As sgl2d Return Type(a.x * b.x, a.y * b.y) End Operator ' a * mul Operator * (a As sgl2d, mul As Single) As sgl2d Return Type(a.x * mul, a.y * mul) End Operator ' a / div Operator / (a As sgl2d, div As Single) As sgl2d Return Type(a.x / div, a.y / div) End Operator '=============================================================================== 'list can grow, but never shrink, for performance, non-sorted 'パフォーマンスのため、ソートされていません。 'リストは縮小せず、大きくなります。 Type grow_list Dim As Integer index(Any) Private: Dim As Integer numItems Public: Declare Constructor(startSize As Integer) Declare Constructor() Declare Destructor() Declare Sub Add(newIndex As Integer) Declare Sub empty() Declare Function numAlloc() As Integer Declare Function numInUse() As Integer Declare Sub show() 'non-list methods End Type Constructor grow_list(startSize As Integer) If startSize > 0 Then ReDim index(startSize - 1) End If End Constructor Constructor grow_list() This.constructor(0) End Constructor Destructor grow_list() Erase(index) End Destructor Sub grow_list.add(newIndex As Integer) Dim As Integer ub = UBound(index) 'if list is full, increase list size by 1 'リストがいっぱいになると、リストのサイズを1増やします If numItems = ub + 1 Then ReDim Preserve index(numItems) End If index(numItems) = newIndex numItems += 1 End Sub Sub grow_list.empty() numItems = 0 End Sub Function grow_list.numAlloc() As Integer Return UBound(index) + 1 End Function Function grow_list.numInUse() As Integer Return numItems End Function 'for debugging Sub grow_list.show() Print "--- " & numInUse() & " / " & numAlloc() & " ---" For i As Integer = 0 To numItems - 1 Print i, index(i) Next End Sub '=============================================================================== #Define MOUSE_IDLE 0 #Define MOUSE_POS_CHANGED 1 #Define MOUSE_LB_PRESSED 2 #Define MOUSE_LB_RELEASED 3 #Define MOUSE_RB_PRESSED 4 #Define MOUSE_RB_RELEASED 5 #Define MOUSE_MB_PRESSED 6 #Define MOUSE_MB_RELEASED 7 #Define MOUSE_WHEEL_UP 8 #Define MOUSE_WHEEL_DOWN 9 Type mouse_type Pos As int2d posChange As int2d wheel As Integer buttons As Integer lb As Integer 'left button rb As Integer 'right button mb As Integer 'middle button End Type Function handleMouse(ByRef mouse As mouse_type) As Integer Static previous As mouse_type Dim As Integer change = MOUSE_IDLE GetMouse mouse.pos.x, mouse.pos.y, mouse.wheel, mouse.buttons If (mouse.buttons = -1) Then mouse.lb = 0 mouse.rb = 0 mouse.mb = 0 mouse.posChange.x = 0 mouse.posChange.y = 0 Else mouse.lb = (mouse.buttons And 1) mouse.rb = (mouse.buttons Shr 1) And 1 mouse.mb = (mouse.buttons Shr 2) And 1 If (previous.pos.x <> mouse.pos.x Or previous.pos.y <> mouse.pos.y) Then change = MOUSE_POS_CHANGED End If mouse.posChange.x = mouse.pos.x - previous.pos.x mouse.posChange.y = mouse.pos.y - previous.pos.y If (previous.buttons <> mouse.buttons) Then If (previous.lb = 0 And mouse.lb = 1) Then change = MOUSE_LB_PRESSED If (previous.lb = 1 And mouse.lb = 0) Then change = MOUSE_LB_RELEASED If (previous.rb = 0 And mouse.rb = 1) Then change = MOUSE_RB_PRESSED If (previous.rb = 1 And mouse.rb = 0) Then change = MOUSE_RB_RELEASED If (previous.mb = 0 And mouse.mb = 1) Then change = MOUSE_MB_PRESSED If (previous.mb = 1 And mouse.mb = 0) Then change = MOUSE_MB_RELEASED End If If (mouse.wheel > previous.wheel) Then change = MOUSE_WHEEl_UP If (mouse.wheel < previous.wheel) Then change = MOUSE_WHEEl_DOWN previous = mouse End If Return change End Function '=============================================================================== 'Note: y+ = up, x+ = right, (0,0) = center Type scaled_graphics_type Dim As Single scale = 1 ' = 1 / pixel_size 'pixels / meter 'dim as int2d offset' = (scrn_w \ 2, h \ 2) 'offset in pixels Dim As sgl2d offset Dim As Integer w = -1, h = -1 Dim As Integer wc = -1, hc = -1 'center x,y Declare Sub setScreen(w As Integer, h As Integer) Declare Sub setScaling(scale As Single, offset As sgl2d) Declare Sub clearScreen(c As ULong) Declare Function pos2screen(p As sgl2d) As int2d Declare Sub drawPixel(p As sgl2d, c As ULong) Declare Sub drawCircle(p As sgl2d, r As Single, c As ULong) 'declare sub drawCircleFilled(p as sgl2d, r as single, c as ulong, cFill as ulong) Declare Sub drawCircleFilled(p As sgl2d, r As Single, c As ULong) Declare Sub drawElipse(p As sgl2d, r As Single, aspect As Single, c As ULong) Declare Sub drawLine(p1 As sgl2d, p2 As sgl2d, c As ULong) Declare Sub drawRect(p1 As sgl2d, p2 As sgl2d, c As ULong) Declare Sub drawRectFilled(p1 As sgl2d, p2 As sgl2d, c As ULong) End Type Sub scaled_graphics_type.setScreen(w As Integer, h As Integer) This.w = w 'width This.h = h 'height wc = w \ 2 hc = h \ 2 ScreenRes w, h, 32 Width w \ 8, h \ 16 'bigger font End Sub Sub scaled_graphics_type.setScaling(scale As Single, offset As sgl2d) This.scale = scale This.offset = offset End Sub Sub scaled_graphics_type.clearScreen(c As ULong) Line(0, 0)-(w - 1, h - 1), c, bf End Sub Function scaled_graphics_type.pos2screen(p As sgl2d) As int2d Return int2d(Int(wc + (p.x - offset.x) * scale), h - Int(hc + (p.y - offset.y) * scale)) End Function Sub scaled_graphics_type.drawPixel(p As sgl2d, c As ULong) Dim As int2d posScrn = pos2screen(p) PSet(posScrn.x, posScrn.y), c End Sub Sub scaled_graphics_type.drawCircle(p As sgl2d, r As Single, c As ULong) Dim As int2d posScrn = pos2screen(p) Circle(posScrn.x, posScrn.y), r * scale, c End Sub Sub scaled_graphics_type.drawCircleFilled(p As sgl2d, r As Single, c As ULong) Dim As int2d posScrn = pos2screen(p) Circle(posScrn.x, posScrn.y), r * scale, c,,,,f End Sub Sub scaled_graphics_type.drawElipse(p As sgl2d, r As Single, aspect As Single, c As ULong) Dim As int2d posScrn = pos2screen(p) Circle(posScrn.x, posScrn.y), r * scale, c, , , aspect End Sub Sub scaled_graphics_type.drawLine(p1 As sgl2d, p2 As sgl2d, c As ULong) Dim As int2d posScrn1 = pos2screen(p1) Dim As int2d posScrn2 = pos2screen(p2) Line(posScrn1.x, posScrn1.y)-(posScrn2.x, posScrn2.y), c End Sub Sub scaled_graphics_type.drawRect(p1 As sgl2d, p2 As sgl2d, c As ULong) Dim As int2d posScrn1 = pos2screen(p1) Dim As int2d posScrn2 = pos2screen(p2) Line(posScrn1.x, posScrn1.y)-(posScrn2.x, posScrn2.y), c, b End Sub Sub scaled_graphics_type.drawRectFilled(p1 As sgl2d, p2 As sgl2d, c As ULong) Dim As int2d posScrn1 = pos2screen(p1) Dim As int2d posScrn2 = pos2screen(p2) Line(posScrn1.x, posScrn1.y)-(posScrn2.x, posScrn2.y), c, bf End Sub '=============================================================================== Const As Single INFEC_DIST = 0.05 'm Const As Single INFEC_DIST_SQRD = INFEC_DIST ^ 2 Const As Single SICK_DAYS_MIN = 7, SICK_DAYS_MAX = 21 Const As Single MORTALITY = 3 / 100 'const as single SICK_SPEED_FACTOR = 0.25 'disable due to some bug Const SEC_PER_DAY = 24 * 60 * 60 Const As Single DAY_PER_SEC = 1 / SEC_PER_DAY Const PERSONS = 5000 Const As Single V_MAX = 0.1 / 3600 '1 m/hr Const As Single MAP_X_MAX = +50, MAP_X_MIN = -MAP_X_MAX Const As Single MAP_Y_MAX = +35, MAP_Y_MIN = -MAP_Y_MAX Const As Single MAP_W = MAP_X_MAX - MAP_X_MIN Const As Single MAP_H = MAP_Y_MAX - MAP_Y_MIN Const DRAW_INTERVAL = 10 '1 to 10 Const FOLLOW_PATIENT_0 = FALSE Const NUM_SECT_X = 16 * 3, NUM_SECT_Y = 12 * 3 Dim As grow_list sector(NUM_SECT_X - 1, NUM_SECT_Y -1) 'screen stuff Const As Single PPM = 6.0 'pixels per meter (set zoom level) Const SCRN_W = 1050, SCRN_H = 750 Dim Shared As scaled_graphics_type sg sg.setScreen(SCRN_W, SCRN_H) sg.setScaling(PPM, sgl2d(0, 0)) Enum HEALTH_STATE ST_INIT '0 ST_INFEC '1 ST_RECOV '2 ST_DEAD '3 ST_LAST 'number of states End Enum Dim As Integer statCounters(ST_LAST - 1) Dim As ULong stateColor(ST_LAST - 1) = _ {RGB(0, 150, 0), RGB(150, 0, 0), RGB(150, 150, 0), RGB(0, 0, 0)} Dim As Single statPercentage(ST_LAST - 1) Const As ULong WHITE = RGB(250, 250, 250) Const As ULong BLACK = RGB(0, 0, 0) Type person_type p As sgl2d 'position [m] pPrev As sgl2d 'position [m] v As sgl2d 'velocity [m/s] r As Single 'radius [m] sickEndTime As Single 'not double! state As Integer 'health End Type Function drawUpdate(interval As Integer) As boolean Static As Integer counter = 0 counter += 1 If counter >= interval Then counter = 0 Return TRUE Else Return FALSE End If End Function Function rndRangeSgl(min As Single, max As Single) As Single Return Rnd() * (max - min) + min End Function Sub limitInt(ByRef value As Integer, min As Integer, max As Integer) If value < min Then value = min If value > max Then value = max End Sub Dim As Integer mouseEvent, mouseDrag Dim As mouse_type mouse Dim As person_type person(0 To PERSONS-1) Randomize 1234 'initialise persons For i As Integer = 0 To UBound(person) person(i).p.x = rndRangeSgl(MAP_X_MIN, MAP_X_MAX) 'm person(i).p.y = rndRangeSgl(MAP_Y_MIN, MAP_Y_MAX) 'm person(i).pPrev = person(i).p person(i).v.x = rndRangeSgl(-V_MAX, +V_MAX) 'm/s person(i).v.y = rndRangeSgl(-V_MAX, +V_MAX) 'm/s person(i).r = 0.35 'person(i).state = int(rndRangeSgl(0, csng(ST_LAST))) person(i).state = ST_INIT Next 'time step such that a max speed, position change = 20 % of infection distance '位置変化 = 感染距離の 20% となる最大速度の時間ステップ Dim As Single timeStep = (INFEC_DIST * 0.2) / V_MAX 'sec Dim As Single simulDays, simulTime = 0 Dim As Integer numInit, numDead, numRecov Dim As boolean sectioning = TRUE 'move view sg.offset.x = -35 sg.offset.y = -25 Dim As Double tNow(0 To 9), tAcc(0 To 9) Dim As Integer trigger = 1 sg.clearScreen(WHITE) While Not MultiKey(FB.SC_ESCAPE) tNow(0) = Timer 'trigger outbreak If MultiKey(FB.SC_SPACE) Then trigger = 1 If trigger = 1 Then trigger = 0 person(0).state = ST_INFEC person(0).sickEndTime = simulTime _ + rndRangeSgl(SICK_DAYS_MIN, SICK_DAYS_MAX) * SEC_PER_DAY End If 'zoom / drag view by mouse mouseEvent = handleMouse(mouse) If (mouse.buttons <> -1) Then If (mouseEvent = MOUSE_LB_PRESSED) Then mouseDrag = 1 If (mouseEvent = MOUSE_LB_RELEASED) Then mouseDrag = 0 If (mouseEvent = MOUSE_WHEEl_UP) Then sg.scale *= 1.1 If (mouseEvent = MOUSE_WHEEl_DOWN) Then sg.scale /= 1.1 End If If (mouseDrag) Then sg.offset.x -= (mouse.posChange.x / PPM) sg.offset.y += (mouse.posChange.y / PPM) End If 'patient 0 perpective If FOLLOW_PATIENT_0 = TRUE Then sg.offset.x = (person(0).p.x) sg.offset.y = (person(0).p.y) End If tNow(1) = Timer 'update positions For i As Integer = 0 To UBound(person) person(i).p += person(i).v * timeStep Next 'random direction change For i As Integer = 1 To 1 Dim As Integer iPerson = Int(rndRangeSgl(0, PERSONS)) If Rnd() > 0.5 Then person(iPerson).v.x = -person(iPerson).v.x Else person(iPerson).v.y = -person(iPerson).v.y End If Next tNow(2) = Timer 'check wall collisions '壁との衝突を確認 For i As Integer = 0 To UBound(person) With person(i) If .p.x < MAP_X_MIN Then .v.x = +Abs(.v.x) If .p.x > MAP_X_MAX Then .v.x = -Abs(.v.x) If .p.y < MAP_Y_MIN Then .v.y = +Abs(.v.y) If .p.y > MAP_Y_MAX Then .v.y = -Abs(.v.y) If .pPrev.x > 0 And .p.x < 0 Then .v.x = +Abs(.v.x) If .pPrev.x < 0 And .p.x > 0 Then .v.x = -Abs(.v.x) If .pPrev.y > 0 And .p.y < 0 Then .v.y = +Abs(.v.y) If .pPrev.y < 0 And .p.y > 0 Then .v.y = -Abs(.v.y) End With Next tNow(3) = Timer 'check end of sickness '病気の終了を確認 For i As Integer = 0 To UBound(person) If person(i).state = ST_INFEC Then If simulTime > person(i).sickEndTime Then If Rnd() < MORTALITY Then person(i).state = ST_DEAD person(i).v = sgl2d(0, 0) Else person(i).state = ST_RECOV 'person(i).v /= SICK_SPEED_FACTOR 'somthing wrong with this 'person(i).v.x = rndRangeSgl(-V_MAX, +V_MAX) 'm/s 'person(i).v.y = rndRangeSgl(-V_MAX, +V_MAX) 'm/s End If End If End If Next tNow(4) = Timer 'clear sectors For xi As Integer = 0 To NUM_SECT_X - 1 For yi As Integer = 0 To NUM_SECT_Y - 1 sector(xi, yi).empty() Next Next tNow(5) = Timer 'assign persons to sectors 'セクターに人を割り当て For i As Integer = 0 To UBound(person) Dim As Integer xi = Int((person(i).p.x - MAP_X_MIN) / (MAP_W / NUM_SECT_X)) Dim As Integer yi = Int((person(i).p.y - MAP_Y_MIN) / (MAP_H / NUM_SECT_Y)) limitInt(xi, 0, NUM_SECT_X - 1) limitInt(yi, 0, NUM_SECT_Y - 1) sector(xi, yi).add(i) Next tNow(6) = Timer 'spread the virus 'ウイルスが拡散 If sectioning = TRUE Then For xi As Integer = 0 To NUM_SECT_X - 1 For yi As Integer = 0 To NUM_SECT_Y - 1 'loop source in 1 sector For iiSrc As Integer = 0 To sector(xi, yi).numInUse - 1 Dim As Integer iSrc = sector(xi, yi).index(iiSrc) If person(iSrc).state = ST_INFEC Then 'check against targets in near sectors, including this sector 'このセクターを含む近くのセクターの目標をチェック For xdi As Integer = -1 To +1 If xi + xdi < 0 Then Continue For If xi + xdi >= NUM_SECT_X Then Continue For For ydi As Integer = -1 To +1 If yi + ydi < 0 Then Continue For If yi + ydi >= NUM_SECT_Y Then Continue For 'loop targets with 1 (near) sector For iiTar As Integer = 0 To sector(xi + xdi, yi + ydi).numInUse - 1 Dim As Integer iTar = sector(xi + xdi, yi + ydi).index(iiTar) If person(iTar).state = ST_INIT Then If person(iSrc).p.distSqrd(person(iTar).p) < INFEC_DIST_SQRD Then person(iTar).state = ST_INFEC person(iTar).sickEndTime = simulTime _ + rndRangeSgl(SICK_DAYS_MIN, SICK_DAYS_MAX) * SEC_PER_DAY 'person(iTar).v *= SICK_SPEED_FACTOR End If End If Next Next Next End If Next Next Next Else 'case: sectioning = FALSE 'check for disease transmission (iSrc = source, iTar = target) '病気の伝染をチェック (iSrc = source, iTar = target) For iSrc As Integer = 0 To UBound(person) If person(iSrc).state = ST_INFEC Then For iTar As Integer = 0 To UBound(person) If person(iTar).state = ST_INIT Then If person(iSrc).p.distSqrd(person(iTar).p) < INFEC_DIST_SQRD Then person(iTar).state = ST_INFEC person(iTar).sickEndTime = simulTime _ + rndRangeSgl(SICK_DAYS_MIN, SICK_DAYS_MAX) * SEC_PER_DAY 'person(iTar).v *= SICK_SPEED_FACTOR End If End If Next End If Next End If tNow(7) = Timer 'clear stats For i As Integer = 0 To UBound(statCounters) statCounters(i) = 0 Next 'update stats For i As Integer = 0 To UBound(person) statCounters(person(i).state) += 1 Next tNow(8) = Timer 'draw world If (drawUpdate(DRAW_INTERVAL) = TRUE) Then ScreenLock 'sg.clearScreen(WHITE) 'clear part of screen sg.drawRectFilled(sgl2d(MAP_X_MIN - 2, MAP_Y_MIN - 2), _ sgl2d(MAP_X_MAX + 2, MAP_Y_MAX + 2), WHITE) sg.drawLine(sgl2d(MAP_X_MIN, 0), sgl2d(MAP_X_MAX, 0), BLACK) sg.drawLine(sgl2d(0, MAP_Y_MIN), sgl2d(0, MAP_Y_MAX), BLACK) For xi As Integer = 0 To NUM_SECT_X - 1 For yi As Integer = 0 To NUM_SECT_Y - 1 Dim As Single x1 = MAP_W * (xi / NUM_SECT_X) + MAP_X_MIN Dim As Single y1 = MAP_H * (yi / NUM_SECT_Y) + MAP_Y_MIN Dim As Single x2 = MAP_W * ((xi + 1) / NUM_SECT_X) + MAP_X_MIN Dim As Single y2 = MAP_H * ((yi + 1) / NUM_SECT_Y) + MAP_Y_MIN 'sg.drawRect(sgl2d(x1, y1), sgl2d(x2, y2), BLACK) 'grid 'dim as int2d scrnPos = sg.pos2screen(sgl2d(x1, y1)) 'draw string (scrnPos.x + 2, scrnPos.y - 16), str(sector(xi, yi).numInUse), 0 'draw string (scrnPos.x + 2, scrnPos.y - 32), str(sector(xi, yi).numAlloc), 0 Next Next sg.drawCircle(person(0).p, person(0).r * 3, stateColor(person(0).state)) For i As Integer = 0 To UBound(person) Dim As ULong c = stateColor(person(i).state) sg.drawCircleFilled(person(i).p, person(i).r, c) Next Line(0, 0)-(150, 100), WHITE, bf Draw String (10, 10 + 00), "Day: " & Format(simulDays, "0.#0"), BLACK Draw String (10, 10 + 16), "Initial: " & statCounters(ST_INIT), stateColor(ST_INIT) Draw String (10, 10 + 32), "Infected: " & statCounters(ST_INFEC), stateColor(ST_INFEC) Draw String (10, 10 + 48), "Recovered: " & statCounters(ST_RECOV), stateColor(ST_RECOV) Draw String (10, 10 + 64), "Dead: " & statCounters(ST_DEAD), stateColor(ST_DEAD) '~ for i as integer = 1 to 9 '~ draw string (10, 90 + i * 16), "Step: " & i & " = " & format(tAcc(i), "0.#0"), BLACK '~ next For i As Integer = 0 To ST_LAST - 1 statPercentage(i) = 100 * (statCounters(i) / PERSONS) Circle(10 + 4 * simulDays, (SCRN_H - 10) - 3 * statPercentage(i)), 1, stateColor(i),,,,f Next ScreenUnLock Sleep 1,1 'don't sleep every loop End If simulTime += timeStep simulDays = simulTime * DAY_PER_SEC tAcc(9) = 0 'sum other timers For i As Integer = 1 To 8 tAcc(i) += (tNow(i) - tNow(i - 1)) tAcc(9) += tAcc(i) 'sum Next If statCounters(ST_INFEC) = 0 Then Exit While Wend Draw String (10, SCRN_W - 26), "End of simulation", BLACK While InKey = "" : Sleep 1 : Wend End