Mouse school of critters bplus B = B + ... Offline This member has written at least 1,268 posts and created at least 154 threads on this forum since joining inApr 2017. 04-29-2018, 12:04 PM Practice for Boid Watching Code:```_TITLE "Mouse school of critters - Click to toggle Mouse as Predator or Prey    by bplus 2018-04-27" 'QB64 version 2017 1106/82 (the day before they switched to version 1.2) 'from: Mouse school critters separated.txt for JB 2.0 B+ 2018-04-24 '2018-04-27 update for Predator / Prey Toggle with Click CONST xmax = 1200 CONST ymax = 700 SCREEN _NEWIMAGE(xmax, ymax, 32) _SCREENMOVE 100, 40 RANDOMIZE TIMER DIM SHARED qb(15) qb(0) = &HFF000000 qb(1) = &HFF000088 qb(2) = &HFF008800 qb(3) = &HFF008888 qb(4) = &HFF880000 qb(5) = &HFF880088 qb(6) = &HFF888800 qb(7) = &HFFCCCCCC qb(8) = &HFF888888 qb(9) = &HFF0000FF qb(10) = &HFF00FF00 qb(11) = &HFF00FFFF qb(12) = &HFFFF0000 qb(13) = &HFFFF00FF qb(14) = &HFFFFFF00 qb(15) = &HFFFFFFFF na = 50 DIM SHARED x(na), y(na), v(na), r(na), c(na), predator FOR i = 1 TO na     x(i) = rand(0, xmax)     y(i) = rand(0, ymax)     rr = INT(RND * 15)     v(i) = rr * 1     r(i) = rand(10, 30)     c(i) = qb(rr) NEXT WHILE 1     CLS     IF INKEY\$ = "q" THEN END     FOR i = 1 TO na         m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY         IF mb THEN             WHILE mb                 m = _MOUSEINPUT: mb = _MOUSEBUTTON(1): mx = _MOUSEX: my = _MOUSEY                 _LIMIT 200             WEND             IF predator THEN predator = 0 ELSE predator = 1         END IF         'radian angle to mouse         ra = _ATAN2(my - y(i), mx - x(i)) '  + pi kind of interesting too         'draw it         critter i, ra         'separate critters for next frame and further down i line         FOR j = i + 1 TO na             ' The following is STATIC's adjustment of ball positions if overlapping             ' before calcultion of new positions from collision             ' Displacement vector and its magnitude.  Thanks STxAxTIC !             nx = x(j) - x(i)             ny = y(j) - y(i)             nm = SQR(nx ^ 2 + ny ^ 2)             IF nm < 10 + r(i) + r(j) THEN                 nx = nx / nm                 ny = ny / nm                 ' Regardless of momentum exchange, separate the balls along the lone connecting them.                 WHILE nm < 10 + r(i) + r(j)                     flub = 10 '  massively increased for JB to speed up code                     x(j) = x(j) + flub * nx                     y(j) = y(j) + flub * ny                     x(i) = x(i) - flub * nx                     y(i) = y(i) - flub * ny                     nx = x(j) - x(i)                     ny = y(j) - y(i)                     nm = SQR(nx ^ 2 + ny ^ 2)                     nx = nx / nm                     ny = ny / nm                 WEND             END IF         NEXT         IF predator THEN             x(i) = x(i) + v(i) * COS(ra + _PI)             y(i) = y(i) + v(i) * SIN(ra + _PI)         ELSE             x(i) = x(i) + v(i) * COS(ra)             y(i) = y(i) + v(i) * SIN(ra)         END IF     NEXT     _DISPLAY     _LIMIT 20 WEND SUB critter (i, ra)     COLOR c(i)     fcirc x(i), y(i), r(i)     IF predator THEN         x1 = x(i) + .75 * r(i) * COS(ra - _PI(1 / 9) + _PI)         y1 = y(i) + .75 * r(i) * SIN(ra - _PI(1 / 9) + _PI)         x2 = x(i) + .75 * r(i) * COS(ra + _PI(1 / 9) + _PI)         y2 = y(i) + .75 * r(i) * SIN(ra + _PI(1 / 9) + _PI)     ELSE         x1 = x(i) + .75 * r(i) * COS(ra - _PI(1 / 9))         y1 = y(i) + .75 * r(i) * SIN(ra - _PI(1 / 9))         x2 = x(i) + .75 * r(i) * COS(ra + _PI(1 / 9))         y2 = y(i) + .75 * r(i) * SIN(ra + _PI(1 / 9))     END IF     COLOR qb(15)     fcirc x1, y1, .25 * r(i)     fcirc x2, y2, .25 * r(i)     IF predator THEN         x3 = x1 + .125 * r(i) * COS(ra + _PI)         y3 = y1 + .125 * r(i) * SIN(ra + _PI)         x4 = x2 + .125 * r(i) * COS(ra + _PI)         y4 = y2 + .125 * r(i) * SIN(ra + _PI)     ELSE         x3 = x1 + .125 * r(i) * COS(ra)         y3 = y1 + .125 * r(i) * SIN(ra)         x4 = x2 + .125 * r(i) * COS(ra)         y4 = y2 + .125 * r(i) * SIN(ra)     END IF     COLOR qb(0)     fcirc x3, y3, .125 * r(i)     fcirc x4, y4, .125 * r(i) END SUB 'Steve McNeil's  copied from his forum   note: Radius is too common a name SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)     DIM subRadius AS LONG, RadiusError AS LONG     DIM X AS LONG, Y AS LONG     subRadius = ABS(R)     RadiusError = -subRadius     X = subRadius     Y = 0     IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB     ' 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), , 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), , BF                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF             END IF             X = X - 1             RadiusError = RadiusError - X * 2         END IF         Y = Y + 1         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF     WEND END SUB FUNCTION rand% (lo%, hi%)     rand% = INT(RND * (hi% - lo% + 1)) + lo% END FUNCTION``` B += x « Next Oldest | Next Newest » 