DECLARE SUB Precalc ()
DECLARE SUB SetPalette ()
DECLARE SUB BlobMove ()
DECLARE SUB SetBlobInfo ()
'2DBLOBS4 - 4th optimization of Michael's 2DBLOBS
'           by Toshi Horie
'this probably only run when compiled
'==Further optimization hints from Toshi:====
' You don't need to scan through entire screen
' to determine "active metaball areas."  You can
' instead loop through all the balls, and sum
' up the precalculated field arrays like
' additively blended sprites instead.
DEFINT A-Z
CONST threshold! = .1
CONST MaxBlobs% = 8



TYPE BlobType
		x AS INTEGER
		y AS INTEGER
		oy AS INTEGER 'original y
		radius AS INTEGER
		radius2 AS INTEGER
		strength AS SINGLE
		dx AS INTEGER
		dy AS INTEGER
END TYPE
DIM SHARED blobs(MaxBlobs%) AS BlobType
COMMON SHARED t%
CALL Precalc
DIM pfield2(144, 12) AS SINGLE
FOR r2% = 0 TO 121
	FOR br% = 1 TO 12
		br2% = br% * br%
		pfield! = 1 - (CSNG(r2%) / br2%)
		pfield2!(r2%, br%) = pfield! * pfield!
	NEXT
NEXT
DIM SHARED sine(127)
FOR t% = 0 TO 127
	sine(t%) = CINT(10 * SIN(t * 3.14159 / 64))
NEXT t%


SCREEN 0

SCREEN 13
DIM vs(0 TO 16001)
GET (0, 0)-(159, 149), vs

CALL SetBlobInfo
CALL SetPalette
t% = 0

s% = VARSEG(vs(2))
DEF SEG = s%
CONST ymin = 35
t1! = TIMER
DO
   t% = t% + 1
	'Yes, the VARPTR IS REQUIRED HERE,
	'--it is nonzero when compiled!!!
	  p% = VARPTR(vs(2)) + ymin * 320
	  FOR y% = ymin TO 100
		
		 FOR x% = 0 TO 159
			fieldd! = 0
			FOR k% = 0 TO MaxBlobs%
			   dx% = x% - blobs(k%).x
			   dy% = y% - blobs(k%).y
			   ' fast bounding box check
			   IF (ABS(dx%) <= blobs(k%).radius) THEN
			   br% = blobs(k%).radius
			   IF (ABS(dy%) <= br%) THEN
				  r2% = dx% * dx% + dy% * dy%
				  ' stricter radius check
				  IF r2% <= blobs(k%).radius2 THEN
					 'sum field contribution at point (x,y) from this blob
					 fieldd! = fieldd! + (blobs(k%).strength * pfield2!(r2%, br%))
				  END IF
			   END IF
			   END IF
			NEXT k%

			IF fieldd! > threshold! THEN
			   c% = 255 * fieldd!
			   IF c% > 255 THEN c% = 255
			   POKE p%, c%
			ELSE
			   POKE p%, 0
			END IF
			p% = p% + 1
		 NEXT x%
	  NEXT y%
  WAIT &H3DA, 8
   PUT (30, 0), vs, PSET
   CALL BlobMove
   'LOCATE 1, 1: COLOR 255: PRINT t%
   IF LEN(INKEY$) THEN EXIT DO
LOOP UNTIL t% = 300
elapsed! = TIMER - t1!
DEF SEG
SCREEN 0: WIDTH 80: CLS
PALETTE
PRINT "2dblobs4x by Toshi"
PRINT t% / elapsed!; "fps"
END
	 'x, y, r,strength,dx,dy
DATA 100,58,10,1,0,0
DATA 60,55,12,2,0,0
DATA 90,60,8,1,1,0
DATA 120,52,9,1,0,0
DATA 150,60,8,1,-3,0
DATA 80,56,8,1,0,0

DATA 110,60,10,1,-2,0
DATA 103,53,4,1,2,0
DATA 100,57,11,1,1,0

SUB BlobMove

FOR k% = 0 TO MaxBlobs%
IF (blobs(k%).x > 159) THEN blobs(k%).dx = -blobs(k%).dx
IF (blobs(k%).x < 0) THEN blobs(k%).dx = -blobs(k%).dx
blobs(k%).x = blobs(k%).x + blobs(k%).dx
blobs(k%).y = blobs(k%).oy + sine(t% * k% AND 127)
NEXT

END SUB

SUB Precalc
END SUB

SUB SetBlobInfo

RESTORE
FOR k% = 0 TO MaxBlobs%
	READ a%, b%, c%, d%, e%, f%
	blobs(k%).x = a%
	blobs(k%).y = b%
	blobs(k%).oy = b%
	blobs(k%).radius = c%
	blobs(k%).radius2 = c% * c%
	blobs(k%).strength = d%
	blobs(k%).dx = e%
	blobs(k%).dy = f%
NEXT


END SUB

SUB SetPalette

OUT &H3C8, 0
FOR i% = 0 TO 255
IF i% > 192 THEN e% = e% + 2
OUT &H3C9, e% \ 4
OUT &H3C9, e% \ 4
OUT &H3C9, i% \ 4
NEXT

END SUB