'/////Supporting code for the article at QBCM.Hybd.Net

'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 SUB