Copy Link
Add to Bookmark
Report
Metaballs? I'd call them "Blobs"
QB Express Issue #1
Tutorial by Relsoft
People emailed me to write a tutorial about stuff/effects they saw in my "mono and disco" QB demo. Most of which regarding Plasmas, 3d and Blobs. As I've already finished writing the plasma article, and discussing 3d in layman's tern would involve me dicussing polar coordinates and Trig Identities, I am writing a tutorial on how to model 2d blobs as it would require less space. ;*)
I. Illumination
Illumination is how light behaves proportional to its distance from the center.
ie: Intensity=1/distance²
Which means that the Intensity of light is *inversely* proportional to its distance from the lightsource. So the farther the coordinate from the center of the lightsource the darker it gets. If you don't believe me, try to point a flashlight on a dark area. ;*)
II. Preparing the LightMap
First you have to make a lightmap. A lightmap is a map/table of illumination. We should use the above formula in making the lightmap. Say we want to have a 64*64 Lightmap (you could use an size that will fit your purpose), we wan't to fill that table with values derived from our illumination formula. As we are using screen 13, which has 256 colors (0-255), our value for MAXCOLOR would be 255. You'll notice that the image of the Lightmap is curved/quadratic:
This is what our lightmap would look like if plotted on the screen. But this lightmap, although mathematically sound, won't look very good for our blobs. What we wan't is a more linear lightmap like this:
Trust me on this, the second one would look way cooler. You could develop your own formula if you want, as long as it follows the concept of inverse proportion.
Here's the QB code to generate both Lightmaps:
'LightMap tester
'Relsoft 2003
'SetvideoSeg by Plasma357
DEFINT A-Z
CONST PI = 3.141593
DIM SHARED Light%(64, 64) 'Our LightMap
CLS
SCREEN 13
RANDOMIZE TIMER
'////==============Grey Scaled Pal
FOR i = 0 TO 255
OUT &H3C8, i
OUT &H3C9, i \ 4
OUT &H3C9, i \ 4
OUT &H3C9, i \ 4
NEXT i
'////==============Generate our LightMap
'Illumination formula:
'"Distance is inversly propotional to illumination
'i = 1 / (d ^ 2)
'/////=======Standard formula
MAXCOLOR = 255
FOR x% = -32 TO 31
FOR y% = -32 TO 31
Dist! = SQR(x ^ 2 + y ^ 2)
IF x% = 0 AND y% = 0 THEN 'check for center
c% = 255
ELSE
c% = Dist! ^ 2
c% = MAXCOLOR - c%
END IF
IF c% < 0 THEN c% = 0 'Check if it's out of bounds
IF c% > 255 THEN c% = 255
Light%(x% + 32, y% + 32) = c% 'save it
NEXT y%
NEXT x%
'////==============Test to see out lightmap in action
FOR y = 0 TO 64
FOR x = 0 TO 64
PSET (70 + x, 70 + y), Light%(x, y)
NEXT x
NEXT y
'/////=======Better looking formula
'Our own way...
'i = (Strength / Distance * MAXCOLOR) - MAXCOLOR
Strength% = 32
MAXCOLOR = 255
FOR x% = -32 TO 31
FOR y% = -32 TO 31
Dist! = SQR(x ^ 2 + y ^ 2)
IF x% = 0 AND y% = 0 THEN 'check for center
c% = 255
ELSE
c% = Strength% / Dist! * MAXCOLOR
c% = c% - MAXCOLOR
END IF
IF c% < 0 THEN c% = 0 'Check if it's out of bounds
IF c% > 255 THEN c% = 255
Light%(x% + 32, y% + 32) = c% 'save it
NEXT y%
NEXT x%
'////==============Test to see out lightmap in action
FOR y = 0 TO 64
FOR x = 0 TO 64
PSET (180 + x, 70 + y), Light%(x, y)
NEXT x
NEXT y
END
SUB SetVideoSeg (Segment) STATIC
DEF SEG
IF VideoAddrOff& = 0 THEN ' First time the sub is called
' We need to find the location of b$AddrC, which holds the graphics
' offset (b$OffC) and segment (b$SegC). Since b$AddrC is in the default
' segment, we can find it by setting it to a certain value, and then
' searching for that value.
SCREEN 13 ' Set b$SegC to A000 (00A0 in memory)
PSET (160, 100), 0 ' Set b$OffC to 7DA0 (not needed in the IDE)
FOR offset& = 0 TO 32764 ' Search for b$AddrC, which is
IF PEEK(offset&) = &HA0 THEN ' in the default segment and
IF PEEK(offset& + 1) = &H7D THEN ' should have a value of
IF PEEK(offset& + 2) = &H0 THEN ' A0 7D 00 A0.
IF PEEK(offset& + 3) = &HA0 THEN
VideoAddrOff& = offset& + 2 ' If we found it, record the
EXIT FOR ' offset of b$SegC and quit
END IF ' looking. (Oddly, changing
END IF ' the b$OffC doesn't seem to
END IF ' do anything, so this is why
END IF ' this sub only changes b$SegC)
NEXT
END IF
' Change b$SegC to the specified Segment
POKE VideoAddrOff&, Segment AND &HFF
POKE VideoAddrOff& + 1, (Segment AND &HFF00&) \ &H100
END SUBIII. The Algorithm
Now that we have decided what lightMap to use, we can start making our blob render. The algo is actually very simple it hurts. ;*) Blobs are made when lightmaps "overlap".
[Pseudo code}
1. Decide where you want to put a
blob.
2. Read your lightmap sequentially
3. Check if the lightmap contains a
color.
3. If it contains a color other than
0, Check the color of the
the particular pixel on the
screen.
4. Add both colors together
5. Limit the color to the maximum
color.
6. Plot the summed-up colors to
screen.
[end pseudo code]
See, pretty elementary. If you want QB code here it is:
SUB DrawBlob (bx%, by%)
FOR y% = 0 TO 64
FOR x% = 0 TO 64
c% = Light%(x%, y%)
IF c% THEN
oc% = POINT(x% + bx%, y% + by%)
occ% = c% + oc%
IF occ% > 255 THEN
occ% = 255
END IF
PSET (x% + bx%, y% + by%), occ%
END IF
NEXT x
NEXT y
END SUBIt is very important that you clear the screen to blank after every frame to make the display right. Now that we know how to generate blobs, we would want to see it in action. To do those cool movements, use what you have learned in HighSchool algebra/Trig. Ie. Polar coordinates or vectors.
Here's the complete commented code:
'How to generate Blobs(also called MetaBalls)
'Relsoft 2003
'SetvideoSeg by Plasma357
DECLARE SUB DrawBlob (bx%, by%)
DECLARE SUB SetVideoSeg (Segment%)
DEFINT A-Z
CONST PI = 3.141593
DIM SHARED Light%(64, 64) 'Our LightMap
REDIM SHARED Vpage(32009) AS INTEGER 'SetVideoSeg Buffer
Vpage(6) = 2560 'Width 320*8
Vpage(7) = 200 'Height
Layer = VARSEG(Vpage(0)) + 1 'Buffer Seg(Ask Plasma)
CLS
SCREEN 13
RANDOMIZE TIMER
'////==============Grey Scaled Pal
FOR i = 0 TO 255
OUT &H3C8, i
OUT &H3C9, i \ 4
OUT &H3C9, i \ 4
OUT &H3C9, i \ 4
NEXT i
'////==============Generate our LightMap
'Illumination formula:
'"Distance is inversly propotional to illumination
'i = 1 / (d ^ 2)
'Our own way...
'i = (Strength / Distance * MAXCOLOR) - MAXCOLOR
Strength% = 32
MAXCOLOR = 255
FOR x% = -32 TO 31
FOR y% = -32 TO 31
dist! = SQR(x ^ 2 + y ^ 2)
IF x% = 0 AND y% = 0 THEN 'check for center
c% = 255
ELSE
c% = (Strength / dist!) * MAXCOLOR
c% = c% - MAXCOLOR
END IF
IF c% < 0 THEN c% = 0 'Check if it's out of bounds
IF c% > 255 THEN c% = 255
Light%(x% + 32, y% + 32) = c% 'save it
NEXT y%
NEXT x%
'////==============Test to see out lightmap in action
FOR y = 0 TO 64
FOR x = 0 TO 64
PSET (130 + x, 70 + y), Light%(x, y)
NEXT x
NEXT y
COLOR 255
LOCATE 1, 1
PRINT "This is our LightMap"
PRINT "Press any key..."
c$ = INPUT$(1)
'//////============TYPE 1
'//////============TYPE 1
'//////============TYPE 1
F& = 0 'Frame counter
DO
F& = F& + 1
SetVideoSeg Layer 'Set draw to buffer
LINE (0, 0)-(319, 199), 0, BF 'Clear the screen
FOR i% = 1 TO 6
bx% = SIN(F& / 30 * .8 * i%) * (i% * 20) + 110 'Move the balls
by% = COS(F& / 25 * .9 * i%) * (i% * 15) + 70
DrawBlob bx%, by% 'Draw the balls
NEXT i%
SetVideoSeg &HA000 'set draw to screen
WAIT &H3DA, 8 'vsynch
PUT (0, 0), Vpage(6), PSET 'Display the screen
LOOP UNTIL INKEY$ <> ""
'//////============TYPE 2
'//////============TYPE 2
'//////============TYPE 2
DO
F& = F& + 1
SetVideoSeg Layer
LINE (0, 0)-(319, 199), 0, BF
FOR i% = 1 TO 6
bx% = SIN(F& / 30 * .8 * i%) * (i% * 20) + 110
by% = COS(F& / 25 * .9 * i%) * (i% * 15) + 70
DrawBlob bx%, by%
NEXT i%
'Scan the whole screen
FOR y = 0 TO 199
FOR x = 0 TO 319
c% = POINT(x, y) 'get pixel
IF c% > 80 THEN 'if > 80 plot the color
PSET (x, y), x XOR y
ELSEIF c% < 80 AND c% > 0 THEN 'if <80 then don't plot
PSET (x, y), 0
ELSEIF c% = 80 THEN 'border color of 5
PSET (x, y), 5
END IF
NEXT x
NEXT y
SetVideoSeg &HA000
WAIT &H3DA, 8
PUT (0, 0), Vpage(6), PSET 'Pcopy the buffer
LOOP UNTIL INKEY$ <> ""
'//////============TYPE 3
'//////============TYPE 3
'//////============TYPE 3
'Brutalizing the Palette ;*)
j! = 255 / 360 * 6
k! = 255 / 360 * 2
l! = 255 / 360 * 6
FOR i% = 0 TO 255
OUT &H3C8, i%
m% = INT(a!)
n% = INT(b!)
o% = INT(c!)
r% = 63 * ABS(SIN(m% * PI / 180))
g% = 63 * ABS(SIN(n% * PI / 180))
b% = 63 * ABS(SIN(o% * PI / 180))
a! = a! + j!
b! = b! + k!
c! = c! + l!
OUT &H3C9, r%
OUT &H3C9, g%
OUT &H3C9, b%
NEXT
DO
F& = F& + 1
SetVideoSeg Layer
LINE (0, 0)-(319, 199), 0, BF
FOR i% = 1 TO 6
bx% = SIN(F& / 30 * .8 * i%) * (i% * 20) + 110
by% = COS(F& / 25 * .9 * i%) * (i% * 15) + 70
DrawBlob bx%, by%
NEXT i%
SetVideoSeg &HA000
WAIT &H3DA, 8
PUT (0, 0), Vpage(6), PSET 'Pcopy the buffer
LOOP UNTIL INKEY$ <> ""
END
SUB DrawBlob (bx%, by%)
FOR y% = 0 TO 64
FOR x% = 0 TO 64
c% = Light%(x%, y%)
IF c% THEN
oc% = POINT(x% + bx%, y% + by%)
occ% = c% + oc%
IF occ% > 255 THEN
occ% = 255
END IF
PSET (x% + bx%, y% + by%), occ%
END IF
NEXT x
NEXT y
END SUB
SUB SetVideoSeg (Segment) STATIC
DEF SEG
IF VideoAddrOff& = 0 THEN ' First time the sub is called
' We need to find the location of b$AddrC, which holds the graphics
' offset (b$OffC) and segment (b$SegC). Since b$AddrC is in the default
' segment, we can find it by setting it to a certain value, and then
' searching for that value.
SCREEN 13 ' Set b$SegC to A000 (00A0 in memory)
PSET (160, 100), 0 ' Set b$OffC to 7DA0 (not needed in the IDE)
FOR offset& = 0 TO 32764 ' Search for b$AddrC, which is
IF PEEK(offset&) = &HA0 THEN ' in the default segment and
IF PEEK(offset& + 1) = &H7D THEN ' should have a value of
IF PEEK(offset& + 2) = &H0 THEN ' A0 7D 00 A0.
IF PEEK(offset& + 3) = &HA0 THEN
VideoAddrOff& = offset& + 2 ' If we found it, record the
EXIT FOR ' offset of b$SegC and quit
END IF ' looking. (Oddly, changing
END IF ' the b$OffC doesn't seem to
END IF ' do anything, so this is why
END IF ' this sub only changes b$SegC)
NEXT
END IF
' Change b$SegC to the specified Segment
POKE VideoAddrOff&, Segment AND &HFF
POKE VideoAddrOff& + 1, (Segment AND &HFF00&) \ &H100
END SUBThese are the blobs created by Blob.bas:
Type 1
Type 2
Type 3
IV. Appendix
Yes, I got mine removed already. Oops!!!! If you already have read my articles on QBCM issues prior to this, you already know how to generate realtime plasmas and you could combine both effects in one as in this example:
'Blobs on Plasma in translucent mode!!!
'I intentionally used long integers so that this would
'run inside the IDE.
'Relsoft 2003
DECLARE SUB DrawBlob (bx%, by%)
DECLARE SUB Blobs (Fps%, Vsynch%, MaxFrame%, Intensity%)
DEFINT A-Z
TYPE PartType
x AS INTEGER
y AS INTEGER
xv AS INTEGER
yv AS INTEGER
tx AS INTEGER
ty AS INTEGER
Angle AS INTEGER
newtarget AS INTEGER
END TYPE
RANDOMIZE TIMER
CONST PI = 3.14151693#
CONST FALSE = 0, TRUE = NOT FALSE
'$DYNAMIC
DIM SHARED Vpage1%(0 TO 32001) 'our Buffer
'$STATIC
DIM SHARED Lsin1%(-1024 TO 1024) 'some sinus precalcs
DIM SHARED Lsin2%(-1024 TO 1024) 'to speed things up
DIM SHARED Lsin3%(-1024 TO 1024) 'used for Plasma
DIM SHARED Lsin!(-10 TO 370) 'ditto but single
DIM SHARED Lcos!(-10 TO 370) 'used for Particles
DIM SHARED Ly&(0 TO 199) 'y lookuptable
DIM SHARED Light%(127, 127) 'the lightmap
DIM SHARED Layer1%, Offs1% 'Easy reference of
'our Buffer
Vpage1%(0) = 320 * 8 'PUT/GET stuff
Vpage1%(1) = 200
Layer1% = VARSEG(Vpage1%(2)) ';*)
Offs1% = VARPTR(Vpage1%(2))
FOR i% = 0 TO 199 'Prefcalc Y lookup
Ly&(i%) = i% * 320&
NEXT i%
FOR i% = 0 TO 359 'Cosine/Sine LUT
RA! = i% * (3.141593 / 180)
Lcos!(i%) = COS(RA!)
Lsin!(i%) = SIN(RA!)
NEXT i%
CLS
SCREEN 13
Vsynch% = FALSE 'No WAIT
Blobs Fps%, Vsynch%, MaxFrame%, 512
CLS
SCREEN 0
WIDTH 80
PRINT "FPS:"; Fps%
c$ = INPUT$(1)
END
SUB Blobs (Fps%, Vsynch%, MaxFrame%, Intensity%)
Numblobs = 20 'Number of particles
DIM blob(Numblobs) AS PartType
FOR i% = 0 TO UBOUND(blob) 'Init
blob(i%).x = 160
blob(i%).y = 100
blob(i%).Angle = 0
NEXT i%
FOR x% = -64 TO 63 'Calc lightmap
FOR y% = -64 TO 63
IF x% = 0 AND y% = 0 THEN
c% = 255
ELSE
c% = ((8 / SQR((x% * x%) + (y% * y%))) * Intensity%) - ...
(SQR((x% * x%) + (y% * y%)) * 2)
END IF
IF c% < 0 THEN c% = 0
IF c% > 255 THEN c% = 255
Light%(x% + 64, y% + 64) = c%
NEXT y%
NEXT x%
FOR i% = -1024 TO 1024
Lsin1%(i%) = SIN(i% * PI / (128)) * 16 'Precalc x,y,z
Lsin2%(i%) = SIN(i% * PI / (64)) * 32 'and scale factor
Lsin3%(i%) = SIN(i% * PI / (32)) * 16
NEXT i%
j! = 255 / 360 * 3 'Sinus interpolation of our palette
k! = 255 / 360 * 2
l! = 255 / 360 * 5
FOR i% = 0 TO 255
OUT &H3C8, i%
m% = INT(a!)
n% = INT(b!)
o% = INT(c!)
r% = 63 * ABS(SIN(m% * PI / 180))
g% = 63 * ABS(SIN(n% * PI / 180))
b% = 63 * ABS(SIN(o% * PI / 180))
a! = a! + j!
b! = b! + k!
c! = c! + l!
OUT &H3C9, r%
OUT &H3C9, g%
OUT &H3C9, b%
NEXT
F& = 0
Tim# = TIMER
DEF SEG = Layer1%
countdir% = -1
switch& = 1
DO
F& = (F& + 1) AND &H7FFFFFFF
REDIM Vpage1%(0 TO 32001) 'CLS
Vpage1%(0) = 320 * 8
Vpage1%(1) = 200
FOR i% = 0 TO UBOUND(blob)
GOSUB DoBlobs 'Move Particles
NEXT i%
FOR i% = 0 TO UBOUND(blob)
bx% = blob(i%).x
by% = blob(i%).y
DrawBlob bx%, by% 'Draw
NEXT i%
counter% = (counter% + countdir%)
IF counter% < -700 THEN
countdir% = -countdir%
ELSEIF counter% > 400 THEN
countdir% = -countdir%
END IF
offset& = Offs1%
FOR ya% = 0 TO 199
ysin% = Lsin1%(ya% - counter%)
FOR xa% = 0 TO 319
dc% = PEEK(offset&)
IF dc% > 40 AND dc% <= 84 THEN
c% = Lsin1%(xa% - counter%) + Lsin1%(ya% - ...
counter%) + ya%
c% = Lsin3%(c% + Lsin2%(x% - counter%) - ya% + counter%) ...
+ xa%
c% = c% + Lsin2%(xa% - ya% + counter%) + Lsin1%(ya% - ...
Lsin2%(xa% - counter% + c%))
c% = c% + Lsin3%(c% + Lsin1%(x% - counter%) - ya% + counter%)...
+ xa%
ELSEIF dc% > 84 AND (switch& AND 1) THEN 'alternate it
c% = Lsin1%(xa% - counter%) + Lsin1%(ya% - counter%) + ya%
c% = Lsin3%(c% + Lsin2%(x% - counter%) - ya% + counter%) + xa%
c% = c% + Lsin2%(xa% - ya% + counter%) + Lsin1%(ya% - ...
Lsin2%(xa% - counter% + c%))
c% = c% + Lsin3%(c% + Lsin1%(x% - counter%) - ya% + counter%) + xa%
ELSE
c% = Lsin3%(xa% - counter%) + ysin% + Lsin2%(ya% + xa%) ...
+ Lsin3%(ysin%)
c% = Lsin1%(Lsin2%(Lsin3%(c% + ysin% + xa% + counter%))) + ...
Lsin3%(Lsin2%(Lsin1%(c% + ysin% + xa% + counter%)))
c% = c% + Lsin1%(Lsin2%(Lsin3%(c% + ysin% + xa% + counter%))) ...
+ Lsin3%(Lsin2%(Lsin1%(c% + ysin% + xa% + counter%)))
END IF
POKE offset&, c%
offset& = offset& + 1
switch& = switch& + 1
NEXT xa%
switch& = switch& - 1 'move 1 pixel back
NEXT ya%
IF Vsynch% THEN WAIT &H3DA, 8
PUT (0, 0), Vpage1%(0), PSET 'Blit
LOOP UNTIL INKEY$ <> ""
Fps% = F& / (TIMER - Tim#)
ERASE blob
EXIT SUB
DoBlobs:
IF blob(i%).newtarget THEN
blob(i%).tx = INT(RND * 320)
blob(i%).ty = INT(RND * 200)
blob(i%).newtarget = FALSE
END IF
'move the blobs
blob(i%).xv = (Lcos!(blob(i%).Angle)) * 3
blob(i%).yv = (Lsin!(blob(i%).Angle)) * 3
blob(i%).x = blob(i%).x + blob(i%).xv
blob(i%).y = blob(i%).y + blob(i%).yv
'Check proximity
IF ABS(blob(i%).tx - blob(i%).x) AND ABS(blob(i%).ty - ...
blob(i%).y) < 5 THEN
blob(i%).newtarget = TRUE
END IF
'Modified DOT product.
'Check if Result>0 then Dec else Inc
'the actual angle is not important
Dot = ((blob(i%).yv * (blob(i%).tx - blob(i%).x)) - ...
(blob(i%).xv * (blob(i%).ty - blob(i%).y)))
IF Dot > 0 THEN
blob(i%).Angle = (blob(i%).Angle - 3)
IF blob(i%).Angle < 0 THEN blob(i%).Angle = ...
blob(i%).Angle + 360
ELSE
blob(i%).Angle = (blob(i%).Angle + 3) MOD 360
END IF
RETURN
END SUB
SUB DrawBlob (bx%, by%)
'Draws a blob using a lightmap
'Bx=Blobx coord
x% = bx% - 64 'Restore coord to new coord
y% = by% - 64 'correct center offset
xsize% = 128
ysize% = 128
newx% = x% 'get coords
newy% = y%
minx% = 0 'Lightmap offset correctors
miny% = 0
'Clip/Crop it
IF newy% < 0 THEN
CY = -newy%
ysize% = ysize% - CY
newy% = 0
miny% = CY
ELSEIF newy% > 199 THEN
EXIT SUB
ELSE
Ndy = newy% + ysize%
IF Ndy > 199 THEN
ysize% = ysize% - (Ndy - (200))
END IF
END IF
IF newx% < 0 THEN
CX = -newx%
xsize% = xsize% - CX
newx% = 0
minx% = CX
ELSEIF newx% > 319 THEN
EXIT SUB
ELSE
Ndx = newx% + xsize%
IF Ndx > 319 THEN
xsize% = xsize% - (Ndx - 320)
END IF
END IF
'Draw
offset& = Offs1% + Ly&(newy%) + newx% 'Start offset
FOR y% = 0 TO ysize% - 1
FOR x% = 0 TO xsize% - 1
c% = Light%(x% + minx%, y% + miny%) 'Correct Light offset
IF c% THEN
oc% = PEEK(offset& + x%)
occ% = c% + oc% 'Combine colors
IF occ% > 255 THEN
occ% = 255
END IF
POKE offset& + x%, occ%
END IF
NEXT x
offset& = offset& + 320
NEXT y
END SUBBlobPlas.Bas creates the following effect:
V. Disclaimer
Who cares? ;*) I want to have some feedback regarding this article or the others that I have written. I'm accepting requests as to what to write next. And remember. You are only limited by your imagination. ;*)
