Port Mitosis simulation demo following that fine and clever coder in Java and JS

[TempodiBasic]

Hi guys

following a video demo that explains some ideas in JAVA e Javascript I love to port this to QB64

here a first result
(PS I have build a different FUNCTION to get collision result between cell and mouse)

Code: QB64: [Select]

1. ' a porting to QB64 of Mitosis simulation as showed in this video
2. '[youtube]https://www.youtube.com/watch?v=jxGS3fKPKJA[/youtube]
3. TYPE Cell
4.     x AS INTEGER
5.     y AS INTEGER
6.     Radius AS INTEGER
7.     Colors AS _UNSIGNED LONG
8. END TYPE
9.  
10. CONST Hscreen = 400, Wscreen = 400, StartRadius = 20, MaxCells = 1000
11. CONST True = -1, False = NOT True, MinRadius = 5
12. CONST Blu = _RGB32(0, 0, 255): CONST Black = _RGB32(0, 0, 0)
13. CONST Red = _RGB32(255, 0, 0): CONST Green = _RGB32(0, 255, 0)
14. CONST White = _RGB(255, 255, 255)
15. DIM SHARED A AS LONG, Cells(1 TO MaxCells) AS Cell, NumActiveCell AS INTEGER
16. DIM SHARED FNameOn AS INTEGER, KeyS AS INTEGER
17. RANDOMIZE TIMER
18.  
19. IF NOT Setup THEN PRINT "Error in Setup"
20. DO
21.     IF NOT Draws THEN PRINT "Error in Draws"
22.     IF NOT MoveCell THEN PRINT "Error in movecell"
23.     IF MousePressed THEN
24.         F = CellClicked
25.         'clear buffer of mouse input
26.         WHILE _MOUSEBUTTON(1)
27.             IF _MOUSEINPUT THEN REM
28.         WEND
29.  
30.         IF F <> False THEN
31.             PRINT "LeftClick on cell "; F
32.             IF NumActiveCell < MaxCells AND (NOT DuplicateCell(F)) THEN PRINT "Error in Duplicatecell"
33.         ELSE
34.             PRINT "LeftClick out of cells"
35.         END IF
36.     END IF
37.     KeyS = _KEYHIT
38.     IF KeyS = 78 OR KeyS = 110 THEN FNameOn = NOT FNameOn
39.     _LIMIT 10
40. LOOP UNTIL KeyS = 32
41. END
42.  
43.  
44. FUNCTION Setup
45.     Setup = False
46.     DIM b AS INTEGER
47.     A = _NEWIMAGE(Wscreen, Hscreen, 32)
48.     IF A < -1 THEN SCREEN A ELSE PRINT "Image handle for Screen not valid"
49.     _TITLE "Mitosis Simulation"
50.     _SCREENMOVE 10, 10
51.     NumActiveCell = 10
52.     FNameOn = False
53.     FOR b = 1 TO NumActiveCell
54.         IF b < 11 THEN
55.             Cells(b).x = MinMax(5, Wscreen - 5)
56.             Cells(b).y = MinMax(5, Hscreen - 5)
57.             Cells(b).Radius = StartRadius
58.             Cells(b).Colors = NewColor
59.         ELSE
60.             Cells(b).x = 0
61.             Cells(b).y = 0
62.             Cells(b).Radius = 0
63.             Cells(b).Colors = 0
64.         END IF
65.     NEXT b
66.     Setup = True
67. END FUNCTION
68.  
69. FUNCTION DuplicateCell (Index AS INTEGER)
70.     DuplicateCell = False
71.     NumActiveCell = NumActiveCell + 1
72.     Cells(NumActiveCell).y = Cells(Index).y
73.     Cells(NumActiveCell).Colors = Cells(Index).Colors
74.     IF INT(Cells(Index).Radius / 2) > MinRadius THEN Cells(NumActiveCell).Radius = INT(Cells(Index).Radius / 2) ELSE Cells(NumActiveCell).Radius = MinRadius
75.     Cells(Index).Radius = Cells(NumActiveCell).Radius
76.     Cells(NumActiveCell).x = Cells(Index).x + MinMax(-Cells(Index).Radius, Cells(Index).Radius)
77.     Cells(Index).x = Cells(Index).x + MinMax(-Cells(Index).Radius, Cells(Index).Radius)
78.     DuplicateCell = True
79. END FUNCTION
80.  
81. FUNCTION MousePressed
82.     MousePressed = False
83.     WHILE _MOUSEINPUT
84.         IF _MOUSEBUTTON(1) = True THEN MousePressed = True
85.     WEND
86. END FUNCTION
87.  
88. FUNCTION IsInTheRange (What AS INTEGER, Min AS INTEGER, Max AS INTEGER)
89.     IsInTheRange = False
90.     IF What > Min AND What < Max THEN IsInTheRange = True
91. END FUNCTION
92.  
93. FUNCTION CellClicked
94.     CellClicked = False
95.     DIM b AS INTEGER
96.     FOR b = 1 TO NumActiveCell STEP 1
97.         IF IsInTheRange(_MOUSEX, Cells(b).x - Cells(b).Radius, Cells(b).x + Cells(b).Radius) THEN
98.             IF IsInTheRange(_MOUSEY, Cells(b).y - Cells(b).Radius, Cells(b).y + Cells(b).Radius) THEN
99.                 CellClicked = b
100.                 EXIT FUNCTION
101.             END IF
102.         END IF
103.     NEXT b
104. END FUNCTION
105.  
106. FUNCTION InTheRange (What AS INTEGER, Min AS INTEGER, Max AS INTEGER)
107.     InTheRange = False
108.     IF What < Min THEN What = Min
109.     IF What > Max THEN What = Max
110.     InTheRange = True
111. END FUNCTION
112.  
113. FUNCTION MinMax (Min AS INTEGER, Max AS INTEGER)
114.     MinMax = False
115.     IF Min < Max THEN SWAP Min, Max
116.     MinMax = INT(RND * (Max - Min + 1)) + Min
117. END FUNCTION
118.  
119. FUNCTION Draws
120.     Draws = False
121.     DIM b AS INTEGER
122.     CLS , Black
123.     FOR b = 1 TO NumActiveCell
124.         IF NOT ShowCell THEN PRINT "Error in Showcell with value "; Cells(b).x; " "; Cells(b).y
125.     NEXT b
126.     Draws = True
127. END FUNCTION
128.  
129. FUNCTION MoveCell
130.     MoveCell = False
131.     DIM b AS INTEGER
132.     FOR b = 1 TO NumActiveCell STEP 1
133.         Cells(b).x = Cells(b).x + MinMax(-2, 2)
134.         Cells(b).y = Cells(b).y + MinMax(-2, 2)
135.         IF NOT InTheRange(Cells(b).x, 5, Wscreen - 5) THEN PRINT "Error IntheRange X"
136.         IF NOT InTheRange(Cells(b).y, 5, Hscreen - 5) THEN PRINT "Error IntheRange Y"
137.     NEXT b
138.     MoveCell = True
139. END FUNCTION
140.  
141. FUNCTION NewColor
142.     NewColor = False
143.     DIM c AS _UNSIGNED LONG
144.     c = _RGB32(MinMax(1, 255), MinMax(1, 255), MinMax(1, 255))
145.     IF c < 0 THEN
146.         PRINT "Error in NewColor "; c: EXIT FUNCTION
147.     ELSE
148.         NewColor = c
149.     END IF
150. END FUNCTION
151.  
152. FUNCTION ShowCell
153.     ShowCell = False
154.     DIM b AS INTEGER
155.     FOR b = 1 TO NumActiveCell STEP 1
156.         CIRCLE (Cells(b).x, Cells(b).y), Cells(b).Radius, Cells(b).Colors
157.         PAINT STEP(0, 0), Cells(b).Colors, Cells(b).Colors
158.         IF FNameOn THEN _PRINTSTRING (Cells(b).x, Cells(b).y), LTRIM$(STR$(b))
159.     NEXT b
160.     ShowCell = True
161. END FUNCTION

Little Help
run the code
click on a cell to duplicate it with mitosis (it divides volume of cell parent)
if you want to recognize the cell press N or n to switch to vision of number name of each cell.
Good Luck with your colture of bacterias

[bplus]

If you click a cell overlapping another, should both cells divide?

I tried to split just one but sometimes...

Code: QB64: [Select]

1. _TITLE "Click cell for two smaller"
2. CONST xmax = 800, ymax = 600
3. TYPE cellType
4.     x AS SINGLE
5.     y AS SINGLE
6.     r AS SINGLE
7.     c AS _UNSIGNED LONG
8. END TYPE
9. DIM cellIndex AS INTEGER
10. DIM cells(1000) AS cellType
11. SCREEN _NEWIMAGE(xmax, ymax, 32)
12. _SCREENMOVE _MIDDLE
13. 'get some cells started
14. FOR i = 1 TO 10
15.     cells(i).x = RND * (xmax - 80) + 40
16.     cells(i).y = RND * (ymax - 80) + 40
17.     cells(i).r = 80
18.     cells(i).c = _RGB32(100 + RND * 155, 100 + RND * 155, 100 + RND * 155)
19. NEXT
20. cellIndex = 10
21. WHILE _KEYDOWN(27) = 0
22.     CLS
23.     FOR i = 1 TO cellIndex
24.         CIRCLE (cells(i).x, cells(i).y), cells(i).r, cells(i).c
25.     NEXT
26.     WHILE _MOUSEINPUT: WEND
27.     mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
28.     IF mb THEN
29.         'clear mb or get multiple click results
30.         WHILE _MOUSEINPUT AND mb: mb = _MOUSEBUTTON(1): WEND
31.         FOR i = cellIndex TO 1 STEP -1
32.             IF (((mx - cells(i).x) ^ 2 + (my - cells(i).y) ^ 2) ^ .5 <= cells(i).r) THEN
33.                 'divide cell if big enough
34.                 IF cells(i).r > 5 THEN
35.                     cells(i).x = cells(i).x - cells(i).r / 2: cells(i).r = cells(i).r / 2
36.                     'new cell
37.                     cellIndex = cellIndex + 1
38.                     IF cellIndex > UBOUND(cells) THEN REDIM _PRESERVE cells(UBOUND(cells) + 1000) AS cellType
39.                     cells(cellIndex).x = cells(i).x + 2 * cells(i).r: cells(cellIndex).y = cells(i).y
40.                     cells(cellIndex).r = cells(i).r: cells(cellIndex).c = cells(i).c
41.                     EXIT FOR
42.                 END IF
43.             END IF
44.         NEXT
45.     END IF
46.     'jiggle cells but keep them on the slide
47.     FOR i = 1 TO cellIndex
48.         cells(i).x = cells(i).x + RND * 7 - 3.5
49.         IF cells(i).x < 10 THEN cells(i).x = 10
50.         IF cells(i).x > xmax - 10 THEN cells(i).x = xmax - 10
51.         cells(i).y = cells(i).y + RND * 7 - 3.5
52.         IF cells(i).y < 10 THEN cells(i).y = 10
53.         IF cells(i).y > ymax - 10 THEN cells(i).y = ymax - 10
54.     NEXT
55.     _DISPLAY
56.     _LIMIT 10
57. WEND
58.  

[TempodiBasic]

Hi Bplus

1.

If you click a cell overlapping another, should both cells divide?

about your question I must admit that in the original video it will duplicate only a cell.
What is the criteria to choose the cell that goes to duplication and the cell that is not, it is not clear for me.

In my demo I use a numeric ascendent criteria, so if there are the cells named 3 and 13 overlapping when the user click on the overlapping area he will get the duplication of cell named 3. But, as you already know, it is possible to get double duplications, programming this kind of feature.
From a point of view logic and structural I don't know what is correct criteria, also because IMHO the contact between/among cells result in an inibition of duplication for our human type of cell.
Moreover there is no 3D space in this demo so Zorder is not useful to solve the issue.

2.
Fine your demo and fine your shrinking of features in one third of lines of code.

3.
A point to thinking:
in the original demo if the two cells are not totally overlapped  they are fullfilled by inner color. To get this in BASIC I must workaround  with the localization of the point (pixel) where to PAINT. But also so I can see only the exposed part of cell, while in the original video you can see the whole cell, in other words you can see also the covered part of cell.
I'm thinking that to get this in BASIC I must do more work like 1. make the circle (border of cell) 2. fill the cell with its color using an ALPHA channel not so opaque 3. GET or COPY the image on the canvas showed to user for all cells--> but how many lines of code must I  add?  :-(

[bplus]

How many lines to allow Circle fills and have transparent cells?

Here only lines to do the Circle Fill were added and 2 lines to color and draw cells were changed:

Code: QB64: [Select]

1. _TITLE "Click cell for two smaller" 'B+ 2019-05-14 with cell fill
2. CONST xmax = 800, ymax = 600
3. TYPE cellType
4.     x AS SINGLE
5.     y AS SINGLE
6.     r AS SINGLE
7.     c AS _UNSIGNED LONG
8. END TYPE
9. DIM cellIndex AS INTEGER
10. DIM cells(1000) AS cellType
11. SCREEN _NEWIMAGE(xmax, ymax, 32)
12. _SCREENMOVE _MIDDLE
13. 'get some cells started
14. FOR i = 1 TO 10
15.     cells(i).x = RND * (xmax - 80) + 40
16.     cells(i).y = RND * (ymax - 80) + 40
17.     cells(i).r = 80
18.     cells(i).c = _RGB32(100 + RND * 155, 100 + RND * 155, 100 + RND * 155, 80) '<< change for circle fill
19. NEXT
20. cellIndex = 10
21. WHILE _KEYDOWN(27) = 0
22.     CLS
23.     FOR i = 1 TO cellIndex
24.         fcirc cells(i).x, cells(i).y, cells(i).r, cells(i).c '<< chamge for circle fill
25.     NEXT
26.     WHILE _MOUSEINPUT: WEND
27.     mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY
28.     IF mb THEN
29.         'clear mb or get multiple click results
30.         WHILE _MOUSEINPUT AND mb: mb = _MOUSEBUTTON(1): WEND
31.         FOR i = cellIndex TO 1 STEP -1
32.             IF (((mx - cells(i).x) ^ 2 + (my - cells(i).y) ^ 2) ^ .5 <= cells(i).r) THEN
33.                 'divide cell if big enough
34.                 IF cells(i).r > 5 THEN
35.                     cells(i).x = cells(i).x - cells(i).r / 2: cells(i).r = cells(i).r / 2
36.                     'new cell
37.                     cellIndex = cellIndex + 1
38.                     IF cellIndex > UBOUND(cells) THEN REDIM _PRESERVE cells(UBOUND(cells) + 1000) AS cellType
39.                     cells(cellIndex).x = cells(i).x + 2 * cells(i).r: cells(cellIndex).y = cells(i).y
40.                     cells(cellIndex).r = cells(i).r: cells(cellIndex).c = cells(i).c
41.                     EXIT FOR
42.                 END IF
43.             END IF
44.         NEXT
45.     END IF
46.     'jiggle cells but keep them on the slide
47.     FOR i = 1 TO cellIndex
48.         cells(i).x = cells(i).x + RND * 7 - 3.5
49.         IF cells(i).x < 10 THEN cells(i).x = 10
50.         IF cells(i).x > xmax - 10 THEN cells(i).x = xmax - 10
51.         cells(i).y = cells(i).y + RND * 7 - 3.5
52.         IF cells(i).y < 10 THEN cells(i).y = 10
53.         IF cells(i).y > ymax - 10 THEN cells(i).y = ymax - 10
54.     NEXT
55.     _DISPLAY
56.     _LIMIT 10
57. WEND
58.  
59. 'from Steve Gold standard, >>> add for Circle Fills
60. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
61.     DIM Radius AS INTEGER, RadiusError AS INTEGER
62.     DIM X AS INTEGER, Y AS INTEGER
63.  
64.     Radius = ABS(R)
65.     RadiusError = -Radius
66.     X = Radius
67.     Y = 0
68.  
69.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
70.  
71.     ' Draw the middle span here so we don't draw it twice in the main loop,
72.     ' which would be a problem with blending turned on.
73.     LINE (CX - X, CY)-(CX + X, CY), C, BF
74.  
75.     WHILE X > Y
76.         RadiusError = RadiusError + Y * 2 + 1
77.         IF RadiusError >= 0 THEN
78.             IF X <> Y + 1 THEN
79.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
80.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
81.             END IF
82.             X = X - 1
83.             RadiusError = RadiusError - X * 2
84.         END IF
85.         Y = Y + 1
86.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
87.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
88.     WEND
89. END SUB
90.  
91.  

Notice I use the newer way with _RGB32() that allows Alpha without need of saying _RGBA32().

Also notice I am getting 16 cells for each original cell but some of TempodiBasic's cells refuse to divide (exactly half of them) after first division.

Also notice, if I hold the mouse button down and drag it all around the screen, I get all the cells divided to their smallest size very quickly which I can't do with TempodiBasic code.
     Is it a feature or a bug?
This is odd because I was expecting nothing to happen until _MOUSEBUTTON(1) was released???
So I guess I still misunderstand how the mouse works. :P

[bplus]

OK I compared TempodiBasic's Mouser with my own and trained the rodent to do as I had expected:

Code: QB64: [Select]

1. _TITLE "Click cell for two smaller" 'B+ 2019-05-14 with cell fill and MousePressed Function
2. CONST xmax = 800, ymax = 600
3. TYPE cellType
4.     x AS SINGLE
5.     y AS SINGLE
6.     r AS SINGLE
7.     c AS _UNSIGNED LONG
8. END TYPE
9. DIM SHARED mx, my '<<<<<<<<<<<<<<<<<<<<<<<< changed
10. DIM cellIndex AS INTEGER
11. DIM cells(1000) AS cellType
12. SCREEN _NEWIMAGE(xmax, ymax, 32)
13. _SCREENMOVE _MIDDLE
14. 'get some cells started
15. FOR i = 1 TO 10
16.     cells(i).x = RND * (xmax - 80) + 40
17.     cells(i).y = RND * (ymax - 80) + 40
18.     cells(i).r = 80
19.     cells(i).c = _RGB32(100 + RND * 155, 100 + RND * 155, 100 + RND * 155, 80) '<< change for circle fill
20. NEXT
21. cellIndex = 10
22. WHILE _KEYDOWN(27) = 0
23.     CLS
24.     FOR i = 1 TO cellIndex
25.         fcirc cells(i).x, cells(i).y, cells(i).r, cells(i).c '<< chamge for circle fill
26.     NEXT
27.     'WHILE _MOUSEINPUT: WEND
28.     mb = MousePressed '<<<<<<<<<<<<<<<<<<<<<<<<<<<< TempodiBasic's method
29.     IF mb THEN
30.         'mx = _MOUSEX: my = _MOUSEY
31.         'clear mb or get multiple click results
32.         'WHILE (_MOUSEINPUT AND mb = -1): mb = _MOUSEBUTTON(1): WEND
33.         FOR i = cellIndex TO 1 STEP -1
34.             IF (((mx - cells(i).x) ^ 2 + (my - cells(i).y) ^ 2) ^ .5 <= cells(i).r) THEN
35.                 'divide cell if big enough
36.                 IF cells(i).r > 5 THEN
37.                     cells(i).x = cells(i).x - cells(i).r / 2: cells(i).r = cells(i).r / 2
38.                     'new cell
39.                     cellIndex = cellIndex + 1
40.                     IF cellIndex > UBOUND(cells) THEN REDIM _PRESERVE cells(UBOUND(cells) + 1000) AS cellType
41.                     cells(cellIndex).x = cells(i).x + 2 * cells(i).r: cells(cellIndex).y = cells(i).y
42.                     cells(cellIndex).r = cells(i).r: cells(cellIndex).c = cells(i).c
43.                     EXIT FOR
44.                 END IF
45.             END IF
46.         NEXT
47.     END IF
48.     'jiggle cells but keep them on the slide
49.     FOR i = 1 TO cellIndex
50.         cells(i).x = cells(i).x + RND * 7 - 3.5
51.         IF cells(i).x < 10 THEN cells(i).x = 10
52.         IF cells(i).x > xmax - 10 THEN cells(i).x = xmax - 10
53.         cells(i).y = cells(i).y + RND * 7 - 3.5
54.         IF cells(i).y < 10 THEN cells(i).y = 10
55.         IF cells(i).y > ymax - 10 THEN cells(i).y = ymax - 10
56.     NEXT
57.     _DISPLAY
58.     _LIMIT 10
59. WEND
60.  
61. 'from Steve Gold standard, add for Circle Fills
62. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
63.     DIM Radius AS INTEGER, RadiusError AS INTEGER
64.     DIM X AS INTEGER, Y AS INTEGER
65.  
66.     Radius = ABS(R)
67.     RadiusError = -Radius
68.     X = Radius
69.     Y = 0
70.  
71.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
72.  
73.     ' Draw the middle span here so we don't draw it twice in the main loop,
74.     ' which would be a problem with blending turned on.
75.     LINE (CX - X, CY)-(CX + X, CY), C, BF
76.  
77.     WHILE X > Y
78.         RadiusError = RadiusError + Y * 2 + 1
79.         IF RadiusError >= 0 THEN
80.             IF X <> Y + 1 THEN
81.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
82.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
83.             END IF
84.             X = X - 1
85.             RadiusError = RadiusError - X * 2
86.         END IF
87.         Y = Y + 1
88.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
89.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
90.     WEND
91. END SUB
92.  
93. 'I modified TempodiBasic MousePressed to wait until the _MOUSEBUTTON(1) is released before acting
94. 'Note: DIM SHARED mx, my
95. FUNCTION MousePressed
96.     WHILE _MOUSEINPUT
97.         IF _MOUSEBUTTON(1) THEN
98.             MousePressed = -1: mx = _MOUSEX: my = _MOUSEY: mb = -1
99.             WHILE mb
100.                 WHILE _MOUSEINPUT AND mb: mb = _MOUSEBUTTON(1): WEND
101.             WEND
102.         END IF
103.     WEND
104. END FUNCTION
105.  
106.  

Now if you click overlapping cells only one or the other will divide until the generation can not divide anymore then the other cell divides. (And now, the whole thing freezes until you do release the mouse button!) Note: this is setup so that the last created cells are checked first when there is a click ie, so checks the new smaller cells first, then the cells made smaller by previous clicks then finally the original cells still whole.

[TempodiBasic]

Hi Bplus
about indivisible cells here my findings:


well now we must understand why it happens in my code?
:-(

[bplus]

well now we must understand why it happens in my code?

Aha! This was wrong!

Code: QB64: [Select]

1. FUNCTION MinMax (Min AS INTEGER, Max AS INTEGER)
2.     MinMax = False
3.     IF Min < Max THEN SWAP Min, Max
4.     MinMax = INT(RND * (Max - Min + 1)) + Min
5. END FUNCTION
6.  

Should be IF Min > Max THEN SWAP Min, Max

I can't believe that caused the problem with one cell dividing but the other wouldn't divide, but it did!

BTW, your cells keep dividing on and on creating mass out of nothing. They should not be allowed to divide unless they are big enough.

Code: QB64: [Select]

1. FUNCTION DuplicateCell (Index AS INTEGER)
2.     DuplicateCell = False
3.     IF INT(Cells(Index).Radius / 2) > MinRadius THEN
4.         NumActiveCell = NumActiveCell + 1
5.         Cells(NumActiveCell).y = Cells(Index).y
6.         Cells(NumActiveCell).Colors = Cells(Index).Colors
7.         Cells(NumActiveCell).Radius = INT(Cells(Index).Radius / 2)
8.         Cells(Index).Radius = Cells(NumActiveCell).Radius
9.         Cells(NumActiveCell).x = Cells(Index).x + MinMax(-Cells(Index).Radius, Cells(Index).Radius)
10.         Cells(Index).x = Cells(Index).x + MinMax(-Cells(Index).Radius, Cells(Index).Radius)
11.     END IF
12.     DuplicateCell = True
13. END FUNCTION
14.  

This doesn't hurt much but still incorrect:

Code: [Select]

' This is checking the whole square region around cell x, y you can click outside cell in square corner and cell will divide
        '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
'this checks the distance between mouse x, y and cell x, y against the radius of the cell
        IF ((_MOUSEX - Cells(b).x) ^ 2 + (_MOUSEY - Cells(b).y) ^ 2) ^ .5 <= Cells(b).Radius THEN CellClicked = b: EXIT FUNCTION

Wonder why no blue? because NewColor is not returning _UNSIGNED LONG

Code: QB64: [Select]

1. FUNCTION NewColor~&
2.     'NewColor~& = False
3.     DIM c AS _UNSIGNED LONG
4.     c = _RGB32(MinMax(100, 255), MinMax(100, 255), MinMax(100, 255), 20)
5.     IF c < 0 THEN
6.         PRINT "Error in NewColor "; c: EXIT FUNCTION
7.     ELSE
8.         NewColor~& = c
9.     END IF
10. END FUNCTION
11.  

Lets see what's going on behind cells, no PAINT but Circle Fill

Code: QB64: [Select]

1. FUNCTION ShowCell
2.     'ShowCell = False
3.     DIM b AS INTEGER
4.     FOR b = 1 TO NumActiveCell STEP 1
5.         fcirc Cells(b).x, Cells(b).y, Cells(b).Radius, Cells(b).Colors
6.         'PAINT STEP(0, 0), Cells(b).Colors, Cells(b).Colors
7.         IF FNameOn THEN _PRINTSTRING (Cells(b).x, Cells(b).y), LTRIM$(STR$(b))
8.     NEXT b
9.     ShowCell = True
10. END FUNCTION
11.  
12.  
13. 'from Steve Gold standard, >>> add for Circle Fills
14. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
15.     DIM Radius AS INTEGER, RadiusError AS INTEGER
16.     DIM X AS INTEGER, Y AS INTEGER
17.  
18.     Radius = ABS(R)
19.     RadiusError = -Radius
20.     X = Radius
21.     Y = 0
22.  
23.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
24.  
25.     ' Draw the middle span here so we don't draw it twice in the main loop,
26.     ' which would be a problem with blending turned on.
27.     LINE (CX - X, CY)-(CX + X, CY), C, BF
28.  
29.     WHILE X > Y
30.         RadiusError = RadiusError + Y * 2 + 1
31.         IF RadiusError >= 0 THEN
32.             IF X <> Y + 1 THEN
33.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
34.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
35.             END IF
36.             X = X - 1
37.             RadiusError = RadiusError - X * 2
38.         END IF
39.         Y = Y + 1
40.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
41.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
42.     WEND
43. END SUB
44.  

Bigger screen and startRadius:

Code: QB64: [Select]

1. CONST Hscreen = 700, Wscreen = 800, StartRadius = 60, MaxCells = 1000  
2.  

No Flickering:

Code: QB64: [Select]

1. ...
2.     KeyS = _KEYHIT
3.     IF KeyS = 78 OR KeyS = 110 THEN FNameOn = NOT FNameOn
4.     _DISPLAY '<<<<<<<<<<<< prevent flicker
5.     _LIMIT 10
6. LOOP UNTIL KeyS = 32
7.  

What ever I missed:

Code: QB64: [Select]

1. ' a porting to QB64 of Mitosis simulation as showed in this video
2. '[youtube]https://www.youtube.com/watch?v=jxGS3fKPKJA[/youtube]
3. TYPE Cell
4.     x AS INTEGER
5.     y AS INTEGER
6.     Radius AS INTEGER
7.     Colors AS _UNSIGNED LONG
8. END TYPE
9.  
10. CONST Hscreen = 700, Wscreen = 800, StartRadius = 60, MaxCells = 1000
11. CONST True = -1, False = NOT True, MinRadius = 3
12. 'CONST Blu = _RGB32(0, 0, 255): CONST Black = _RGB32(0, 0, 0)
13. 'CONST Red = _RGB32(255, 0, 0): CONST Green = _RGB32(0, 255, 0)
14. 'CONST White = _RGB(255, 255, 255)
15. DIM SHARED A AS LONG, Cells(1 TO MaxCells) AS Cell, NumActiveCell AS INTEGER
16. DIM SHARED FNameOn AS INTEGER, KeyS AS INTEGER
17. RANDOMIZE TIMER
18.  
19. IF NOT Setup THEN PRINT "Error in Setup"
20. DO
21.     IF NOT Draws THEN PRINT "Error in Draws"
22.     IF NOT MoveCell THEN PRINT "Error in movecell"
23.     IF MousePressed THEN
24.         F = CellClicked
25.         'clear buffer of mouse input
26.         WHILE _MOUSEBUTTON(1)
27.             IF _MOUSEINPUT THEN REM
28.         WEND
29.  
30.         IF F <> False THEN
31.             PRINT "LeftClick on cell "; F
32.             IF NumActiveCell < MaxCells AND (NOT DuplicateCell(F)) THEN PRINT "Error in Duplicatecell"
33.         ELSE
34.             PRINT "LeftClick out of cells"
35.         END IF
36.     END IF
37.     KeyS = _KEYHIT
38.     IF KeyS = 78 OR KeyS = 110 THEN FNameOn = NOT FNameOn
39.     _DISPLAY '<<<<<<<<<<<< prevent flicker
40.     _LIMIT 10
41. LOOP UNTIL KeyS = 32
42. END
43.  
44.  
45. FUNCTION Setup
46.     'Setup = False
47.     DIM b AS INTEGER
48.     A = _NEWIMAGE(Wscreen, Hscreen, 32)
49.     IF A < -1 THEN SCREEN A ELSE PRINT "Image handle for Screen not valid"
50.     _TITLE "Mitosis Simulation"
51.     _SCREENMOVE _MIDDLE
52.     NumActiveCell = 10
53.     FNameOn = False
54.     FOR b = 1 TO NumActiveCell
55.         IF b < 11 THEN
56.             Cells(b).x = MinMax(5, Wscreen - 5)
57.             Cells(b).y = MinMax(5, Hscreen - 5)
58.             Cells(b).Radius = StartRadius
59.             Cells(b).Colors = NewColor
60.             'ELSE
61.             '    Cells(b).x = 0
62.             '    Cells(b).y = 0
63.             '    Cells(b).Radius = 0
64.             '    Cells(b).Colors = 0
65.         END IF
66.     NEXT b
67.     Setup = True
68. END FUNCTION
69.  
70. FUNCTION DuplicateCell (Index AS INTEGER)
71.     'DuplicateCell = False
72.     IF INT(Cells(Index).Radius / 2) > MinRadius THEN
73.         NumActiveCell = NumActiveCell + 1
74.         Cells(NumActiveCell).y = Cells(Index).y
75.         Cells(NumActiveCell).Colors = Cells(Index).Colors
76.         Cells(NumActiveCell).Radius = INT(Cells(Index).Radius / 2)
77.         Cells(Index).Radius = Cells(NumActiveCell).Radius
78.         Cells(NumActiveCell).x = Cells(Index).x + MinMax(-Cells(Index).Radius, Cells(Index).Radius)
79.         Cells(Index).x = Cells(Index).x + MinMax(-Cells(Index).Radius, Cells(Index).Radius)
80.     END IF
81.     DuplicateCell = True
82. END FUNCTION
83.  
84. FUNCTION MousePressed
85.     'MousePressed = False
86.     WHILE _MOUSEINPUT
87.         IF _MOUSEBUTTON(1) = True THEN MousePressed = True
88.     WEND
89. END FUNCTION
90.  
91. FUNCTION IsInTheRange (What AS INTEGER, Min AS INTEGER, Max AS INTEGER)
92.     'IsInTheRange = False
93.     IF What > Min AND What < Max THEN IsInTheRange = True
94. END FUNCTION
95.  
96. FUNCTION CellClicked
97.     'CellClicked = False
98.     DIM b AS INTEGER
99.     FOR b = 1 TO NumActiveCell STEP 1
100.         'IF IsInTheRange(_MOUSEX, Cells(b).x - Cells(b).Radius, Cells(b).x + Cells(b).Radius) THEN
101.         '    IF IsInTheRange(_MOUSEY, Cells(b).y - Cells(b).Radius, Cells(b).y + Cells(b).Radius) THEN
102.         '        CellClicked = b
103.         '        EXIT FUNCTION
104.         '    END IF
105.         'END IF
106.         IF ((_MOUSEX - Cells(b).x) ^ 2 + (_MOUSEY - Cells(b).y) ^ 2) ^ .5 <= Cells(b).Radius THEN CellClicked = b: EXIT FUNCTION
107.     NEXT b
108. END FUNCTION
109.  
110. FUNCTION InTheRange (What AS INTEGER, Min AS INTEGER, Max AS INTEGER)
111.     'InTheRange = False
112.     IF What < Min THEN What = Min
113.     IF What > Max THEN What = Max
114.     IF What >= Min AND What <= Max THEN InTheRange = True
115. END FUNCTION
116.  
117. FUNCTION MinMax (Min AS INTEGER, Max AS INTEGER)
118.     'MinMax = False
119.     IF Min > Max THEN SWAP Min, Max
120.     MinMax = INT(RND * (Max - Min + 1)) + Min
121. END FUNCTION
122.  
123. FUNCTION Draws
124.     'Draws = False
125.     DIM b AS INTEGER
126.     CLS , Black
127.     FOR b = 1 TO NumActiveCell
128.         IF NOT ShowCell THEN PRINT "Error in Showcell with value "; Cells(b).x; " "; Cells(b).y
129.     NEXT b
130.     Draws = True
131. END FUNCTION
132.  
133. FUNCTION MoveCell
134.     'MoveCell = False
135.     DIM b AS INTEGER
136.     FOR b = 1 TO NumActiveCell STEP 1
137.         Cells(b).x = Cells(b).x + MinMax(-3, 3)
138.         Cells(b).y = Cells(b).y + MinMax(-3, 3)
139.         IF NOT InTheRange(Cells(b).x, 5, Wscreen - 5) THEN PRINT "Error IntheRange X"
140.         IF NOT InTheRange(Cells(b).y, 5, Hscreen - 5) THEN PRINT "Error IntheRange Y"
141.     NEXT b
142.     MoveCell = True
143. END FUNCTION
144.  
145. FUNCTION NewColor~&
146.     'NewColor~& = False
147.     DIM c AS _UNSIGNED LONG
148.     c = _RGB32(MinMax(100, 255), MinMax(100, 255), MinMax(100, 255), 20)
149.     IF c < 0 THEN
150.         PRINT "Error in NewColor "; c: EXIT FUNCTION
151.     ELSE
152.         NewColor~& = c
153.     END IF
154. END FUNCTION
155.  
156. FUNCTION ShowCell
157.     'ShowCell = False
158.     DIM b AS INTEGER
159.     FOR b = 1 TO NumActiveCell STEP 1
160.         fcirc Cells(b).x, Cells(b).y, Cells(b).Radius, Cells(b).Colors
161.         'PAINT STEP(0, 0), Cells(b).Colors, Cells(b).Colors
162.         IF FNameOn THEN _PRINTSTRING (Cells(b).x, Cells(b).y), LTRIM$(STR$(b))
163.     NEXT b
164.     ShowCell = True
165. END FUNCTION
166.  
167.  
168. 'from Steve Gold standard, >>> add for Circle Fills
169. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
170.     DIM Radius AS INTEGER, RadiusError AS INTEGER
171.     DIM X AS INTEGER, Y AS INTEGER
172.  
173.     Radius = ABS(R)
174.     RadiusError = -Radius
175.     X = Radius
176.     Y = 0
177.  
178.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
179.  
180.     ' Draw the middle span here so we don't draw it twice in the main loop,
181.     ' which would be a problem with blending turned on.
182.     LINE (CX - X, CY)-(CX + X, CY), C, BF
183.  
184.     WHILE X > Y
185.         RadiusError = RadiusError + Y * 2 + 1
186.         IF RadiusError >= 0 THEN
187.             IF X <> Y + 1 THEN
188.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
189.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
190.             END IF
191.             X = X - 1
192.             RadiusError = RadiusError - X * 2
193.         END IF
194.         Y = Y + 1
195.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
196.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
197.     WEND
198. END SUB
199.  
200.  
201.  

[TempodiBasic]

Hi Bplus
WOW I like all these feedbacks!
Thanks


Errors:
Why do you think that it is a very showed mistake only after the mistake is pointed out?
:-((

1. NewColor~&
all that time spent on the _RGB  &co and then I cut off value with a function that return a single value and not a _Unsigned Long....
LOL

2. Min>Max
A mistype (< at place of >) that covers itself in a very original bug

3. area of the circle is not the whole area of the square with side the diameter of the circle
I know this bit mistake...but I hate too many math so at start time I use the simple area of the square. ( odi et amo te oh mia Matematica just to remember Catullo)

4. no flickering
Yes I must remember that it is possible that the screen shows flickering and not that my eyes are too tired

my habit in coding:

1. bad CONST color not used
Ok remmed

2. initialization to False at start of a FUNCTION
do you find it bad or verbose?

3. initialization of void variables
do you find it bad or verbose?

4. STEP 1 in the NEXT
do you find it bad or verbose?

5. NEXT nameVariable in a single FOR NEXT
do you find it bad or verbose?


Feature and goals behind the actual demo:
1.

your cells keep dividing on and on creating mass out of nothing. They should not be allowed to divide unless they are big enough

in the original demo the division of cells is infinite... I find it so bad that I put a lower cutoff to divide cell volume. This cutoff is the point of ready to duplicate for the cell, putting out the cicle of gain energy and volume to duplicate again that I would develope after this actual point.

[bplus]

Hi TempodiBasic,

In your habit of coding, the points you bring up are verbose, not bad as far as communication goes because adds to clarity but NOT really necessary.

What I do find bad is making a natural SUB an unnatural FUNCTION.

Look at your main loop:

Code: QB64: [Select]

1. IF NOT Setup THEN PRINT "Error in Setup"
2. DO
3.     IF NOT Draws THEN PRINT "Error in Draws"
4.     IF NOT MoveCell THEN PRINT "Error in movecell"
5.     IF MousePressed THEN
6.         F = CellClicked
7.         'clear buffer of mouse input
8.         WHILE _MOUSEBUTTON(1)
9.             IF _MOUSEINPUT THEN REM
10.         WEND
11.  
12.         IF F <> False THEN
13.             PRINT "LeftClick on cell "; F
14.             IF NumActiveCell < MaxCells AND (NOT DuplicateCell(F)) THEN PRINT "Error in Duplicatecell"
15.         ELSE
16.             PRINT "LeftClick out of cells"
17.         END IF
18.     END IF
19.     KeyS = _KEYHIT
20.     IF KeyS = 78 OR KeyS = 110 THEN FNameOn = NOT FNameOn
21.     _LIMIT 10
22. LOOP UNTIL KeyS = 32
23.  

Wouldn't it be clearer to just do this:

Code: QB64: [Select]

1. Setup
2. DO
3.     Draws
4.     MoveCell
5.     IF MousePressed THEN  '<< clear the mouse button in the MousePressed code
6.         DuplicateCell CellClicked
7.     END IF
8.     KeyS = _KEYHIT
9.     IF KeyS = 78 OR KeyS = 110 THEN FNameOn = NOT FNameOn
10.     _LIMIT 10
11. LOOP UNTIL KeyS = 32
12.  

Here is a natural SUB turned into an unnatural FUNCTION:

Code: QB64: [Select]

1. FUNCTION ShowCell
2.     'ShowCell = False '<<<<<<<<<< ShowCell as a function will automatically return 0.0000 unless otherwise reset
3.     DIM b AS INTEGER
4.     FOR b = 1 TO NumActiveCell STEP 1
5.         fcirc Cells(b).x, Cells(b).y, Cells(b).Radius, Cells(b).Colors
6.         'PAINT STEP(0, 0), Cells(b).Colors, Cells(b).Colors
7.         IF FNameOn THEN _PRINTSTRING (Cells(b).x, Cells(b).y), LTRIM$(STR$(b))
8.     NEXT b
9.     ShowCell = True  
10. END FUNCTION
11.  

Setting ShowCell = False at start and then to True at end of "function" adds no useful information to code and is just clutter. This example code is never going to catch a useful error to report.

BTW ShowCell is default Type Single unless you change name to ShowCell%.

[TempodiBasic]

Hi Bplus

Thanks
I can only be totally agreed with your suggestions

the unnatural FUNCTION
Initialization Verbose not adding value

I must admit that I have bad translated in QB64 style the Java demo...
BASIC is more free and less restrictive!
Free Spirit in digit world.

[bplus]

Hi TempodiBasic,

Thanks back to you! The mystery of why one divided cell was dividing and the other was not was a real stumper!

It was fun tracking down the culprit and what a surprise when found.