' a porting to QB64 of Mitosis simulation as showed in this video
'[youtube]https://www.youtube.com/watch?v=jxGS3fKPKJA[/youtube]
CONST Hscreen
= 700, Wscreen
= 800, StartRadius
= 60, MaxCells
= 1000 CONST True
= -1, False
= NOT True
, MinRadius
= 3 'CONST Blu = _RGB32(0, 0, 255): CONST Black = _RGB32(0, 0, 0)
'CONST Red = _RGB32(255, 0, 0): CONST Green = _RGB32(0, 255, 0)
'CONST White = _RGB(255, 255, 255)
F = CellClicked
'clear buffer of mouse input
PRINT "LeftClick on cell "; F
IF NumActiveCell
< MaxCells
AND (NOT DuplicateCell
(F
)) THEN PRINT "Error in Duplicatecell" PRINT "LeftClick out of cells"
'Setup = False
NumActiveCell = 10
FNameOn = False
FOR b
= 1 TO NumActiveCell
Cells(b).x = MinMax(5, Wscreen - 5)
Cells(b).y = MinMax(5, Hscreen - 5)
Cells(b).Radius = StartRadius
Cells(b).Colors = NewColor
'ELSE
' Cells(b).x = 0
' Cells(b).y = 0
' Cells(b).Radius = 0
' Cells(b).Colors = 0
Setup = True
'DuplicateCell = False
IF INT(Cells
(Index
).Radius
/ 2) > MinRadius
THEN NumActiveCell = NumActiveCell + 1
Cells(NumActiveCell).y = Cells(Index).y
Cells(NumActiveCell).Colors = Cells(Index).Colors
Cells
(NumActiveCell
).Radius
= INT(Cells
(Index
).Radius
/ 2) Cells(Index).Radius = Cells(NumActiveCell).Radius
Cells(NumActiveCell).x = Cells(Index).x + MinMax(-Cells(Index).Radius, Cells(Index).Radius)
Cells(Index).x = Cells(Index).x + MinMax(-Cells(Index).Radius, Cells(Index).Radius)
DuplicateCell = True
'MousePressed = False
'IsInTheRange = False
IF What
> Min
AND What
< Max
THEN IsInTheRange
= True
'CellClicked = False
'IF IsInTheRange(_MOUSEX, Cells(b).x - Cells(b).Radius, Cells(b).x + Cells(b).Radius) THEN
' IF IsInTheRange(_MOUSEY, Cells(b).y - Cells(b).Radius, Cells(b).y + Cells(b).Radius) THEN
' CellClicked = b
' EXIT FUNCTION
' END IF
'END IF
'InTheRange = False
IF What
>= Min
AND What
<= Max
THEN InTheRange
= True
'MinMax = False
MinMax
= INT(RND * (Max
- Min
+ 1)) + Min
'Draws = False
FOR b
= 1 TO NumActiveCell
IF NOT ShowCell
THEN PRINT "Error in Showcell with value "; Cells
(b
).x;
" "; Cells
(b
).y
Draws = True
'MoveCell = False
Cells(b).x = Cells(b).x + MinMax(-3, 3)
Cells(b).y = Cells(b).y + MinMax(-3, 3)
IF NOT InTheRange
(Cells
(b
).x
, 5, Wscreen
- 5) THEN PRINT "Error IntheRange X" IF NOT InTheRange
(Cells
(b
).y
, 5, Hscreen
- 5) THEN PRINT "Error IntheRange Y" MoveCell = True
'NewColor~& = False
c
= _RGB32(MinMax
(100, 255), MinMax
(100, 255), MinMax
(100, 255), 20) NewColor~& = c
'ShowCell = False
fcirc Cells(b).x, Cells(b).y, Cells(b).Radius, Cells(b).Colors
'PAINT STEP(0, 0), Cells(b).Colors, Cells(b).Colors
ShowCell = True
'from Steve Gold standard, >>> add for Circle Fills
RadiusError = -Radius
X = Radius
Y = 0
' Draw the middle span here so we don't draw it twice in the main loop,
' which would be a problem with blending turned on.
LINE (CX
- X
, CY
)-(CX
+ X
, CY
), C
, BF
RadiusError = RadiusError + Y * 2 + 1
LINE (CX
- Y
, CY
- X
)-(CX
+ Y
, CY
- X
), C
, BF
LINE (CX
- Y
, CY
+ X
)-(CX
+ Y
, CY
+ X
), C
, BF
X = X - 1
RadiusError = RadiusError - X * 2
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