'===========================================================================
' Subject: FLYING BEES #9                    Date: 09-06-96 (12:31)       
' Author:  Ryan White                        Code: QB, QBasic, PDS        
' Origin:  BIGFOOT@SunBelt.Net             Packet: GRAPHICS.ABC
'===========================================================================
DECLARE SUB wasp (wx%(), wy%())
DECLARE SUB bees (wx%(), wy%(), x%(), y%(), xv%(), yv%(), bcolor%)

'Flybees #9
'By Ryan White    Original source by Richard Dale
'This is a sample of my abilities with palettes and wierd designs.
'If you would like to get more of these type programs, write me at
'Bigfoot@Sunbelt.Net  or  Bigfoot@InfoAve.Net
'I have more than 575 Qbasic programs to my name, and it grows daily.
'Ah well, enjoy...

'Just mess with it to learn.  I just thought his was neat enough to maybe be
'cooler.   It was.

DEFINT A-Z
COMMON SHARED winW, winH, winX, winY, border, NoBees, smooth

ON KEY(1) GOSUB cle: KEY(1) ON
ON KEY(2) GOSUB ss: KEY(2) ON
ON KEY(3) GOSUB smoothhuh: KEY(3) ON

DEFLNG T: CLS

NoBees = 1

SCREEN 12: RANDOMIZE TIMER: CLS
GOSUB ss
DIM wx(0 TO 2), wy(0 TO 2), co(15, 2), cn(15, 2)
DIM x(0 TO 2, 1 TO NoBees): DIM y(0 TO 2, 1 TO NoBees)
DIM xv(1 TO NoBees): DIM yv(1 TO NoBees)
winW = 0: winH = 0: winX = 0: winY = 0: maxx = 640: maxy = 480
' wasp will not go closer than this to the edges
    border = INT(RND * 75): winW = maxx: winH = maxy
' Initialize the wasp
    wx(0) = 640 / 2: wy(0) = 480 / 2: wx(1) = wx(0): wy(1) = wy(0)
'Initialize the bees
    FOR b = 1 TO NoBees
        x(0, b) = INT(RND * winW): x(1, b) = x(0, b)
        y(0, b) = INT(RND * winH): y(1, b) = y(0, b)
        xv(b) = 7 * (RND - .5): yv(b) = 7 * (RND - .5)
    NEXT b
    DO UNTIL INKEY$ <> ""
    CALL wasp(wx(), wy()): CALL bees(wx(), wy(), x(), y(), xv(), yv(), bcolor)
    GOSUB din
    bcolor = bcolor + 1
    IF bcolor = 15 THEN bcolor = 1
    LOOP: SCREEN 0
END

cle:
CLS
RETURN

ss:
rr = INT(RND * 5): gr = INT(RND * 5): br = INT(RND * 5)
FOR n = 1 TO 14
OUT &H3C8, n
OUT &H3C9, n * rr + 3
OUT &H3C9, n * gr + 3
OUT &H3C9, n * br + 3
NEXT n
RETURN

din:
FOR n = 14 TO 1 STEP -1: OUT &H3C7, n: FOR m = 0 TO 2: co(n, m) = INP(&H3C9): NEXT m: NEXT n
cn(1, 0) = co(14, 0): cn(1, 1) = co(14, 1): cn(1, 2) = co(14, 2)
FOR n = 14 TO 2 STEP -1: FOR m = 0 TO 2: cn(n, m) = co(n - 1, m): NEXT m: NEXT n
FOR n = 14 TO 1 STEP -1: OUT &H3C8, n: FOR m = 0 TO 2: OUT &H3C9, cn(n, m): NEXT m: NEXT n
RETURN

smoothhuh:
smooth = smooth - 1: IF smooth = -1 THEN smooth = 1
RETURN

DEFINT T
SUB bees (wx(), wy(), x(), y(), xv(), yv(), bcolor)
' Do not let things settle down
    bb = INT(NoBees * RND + 1)
    xv(bb) = xv(bb) + (RND - .5) * 3: yv(bb) = yv(bb) + (RND - .5) * 3
FOR b = 1 TO NoBees
' Age position arrays
    x(2, b) = x(1, b): y(2, b) = y(1, b)
    x(1, b) = x(0, b): y(1, b) = y(0, b)
    dx = wx(1) - x(1, b): dy = wy(1) - y(1, b)
    distance = ABS(dx) + ABS(dy)    ' Approximation
    IF distance = 0 THEN distance = 1
    bee.acc = 3
' Accelerate
    xv(b) = xv(b) + dx * bee.acc / distance
    yv(b) = yv(b) + dy * bee.acc / distance
    bee.vel = 11
' Speed Checks
    IF xv(b) > bee.vel THEN xv(b) = bee.vel
    IF xv(b) < -bee.vel THEN xv(b) = -bee.vel
    IF yv(b) > bee.vel THEN yv(b) = bee.vel
    IF yv(b) < -bee.vel THEN yv(b) = -bee.vel
' Move the bees
   IF smooth = 1 THEN       'non smooth
        x(0, b) = x(1, b) + INT(RND * xv(b) + .25 * xv(b)): y(0, b) = y(1, b) + INT(RND * yv(b) + .25 * yv(b))
   END IF
   IF smooth = 0 THEN      'smooth
       x(0, b) = x(1, b) + xv(b): y(0, b) = y(1, b) + yv(b)
   END IF
    FOR sx = 0 TO 639 STEP 25
    LINE (x(1, b), y(0, b))-(sx, 0), bcolor
    NEXT sx
    FOR sy = 0 TO 479 STEP 25
    LINE (x(1, b), y(0, b))-(639, sy), bcolor
    NEXT sy
    FOR sx = 639 TO 0 STEP -25
    LINE (x(1, b), y(0, b))-(sx, 479), bcolor
    NEXT sx
    FOR sy = 479 TO 0 STEP -25
    LINE (x(1, b), y(0, b))-(0, sy), bcolor
    NEXT sy
 NEXT b
END SUB

SUB wasp (wx(), wy()) STATIC
' Age the arrays
    wx(2) = wx(1): wx(1) = wx(0): wy(2) = wy(1): wy(1) = wy(0)
' Accelerate (bias random variable to ensure wasp convers entire screen)
    wasp.acc = 5
    wxv = wxv + INT((RND - .4) * wasp.acc)
    wyv = wyv + INT((RND - .4) * wasp.acc)
' Speed limit checks
    wxv.max = INT(RND * 30) + 20: wyv.max = INT(RND * 30) + 20
    IF wxv > wxv.max THEN wxv = wxv.max
    IF wxv < -wxv.max THEN wxv = -wxv.max
    IF wyv > wyv.max THEN wyv = wyv.max
    IF wyv < -wyv.max THEN wyv = -wyv.max
' Move wasp
    wx(0) = wx(1) + wxv: wy(0) = wy(1) + wyv
' Bounce checks
    IF wx(0) < border OR wx(0) > winW - border - 1 THEN
        wxv = -wxv: wx(0) = wx(0) + wxv
    END IF
    IF wy(0) < border OR wy(0) > winH - border - 1 THEN
        wyv = -wyv: wy(0) = wy(0) + wyv
    END IF
END SUB