🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

1 total messages Started by kwj Sat, 29 Aug 1992 17:12
Xswarm.bas
#179
Author: kwj
Date: Sat, 29 Aug 1992 17:12
196 lines
4767 bytes
Listed below is a program with little to recommend for itself
except that it is fun to watch. Swarm was originally written 
by Jeff Butterworth (7/11/90) and translated to Turbo C++ 
by Werner Keilholtz (10/19/90).

Xswarm.bas uses SCREEN 12 with COLORS 9-14.  I was able to 
run 20 bees using an IBM 55sx (@16 MHz).  You will have to adjust
the variable NoBees to suit your system.  (For example, a Compaq
4/33 can run up to 100 bees.)

Enjoy the program.  Any questions, comments, or snide remarks
are welcome.

kwj

-------------------- CUT HERE -------------------------------
DECLARE SUB wasp (wx%(), wy%())
DECLARE SUB bees (wx%(), wy%(), x%(), y%(), xv%(), yv%(), bcolor%)

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

CLS
SCREEN 12
RANDOMIZE TIMER

NoBees = 20

DIM wx(0 TO 2)
DIM wy(0 TO 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 = 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
bcolor = 9
t1 = TIMER
DO UNTIL INKEY$ <> ""
        
        CALL wasp(wx(), wy())
        CALL bees(wx(), wy(), x(), y(), xv(), yv(), bcolor)

' change bee colors

        IF TIMER - t1 > 2 THEN
                bcolor = bcolor + 1
                        IF bcolor = 14 THEN bcolor = 9
                t1 = TIMER
        END IF
        
LOOP

SCREEN 0
END

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

                x(0, b) = x(1, b) + xv(b)
                y(0, b) = y(1, b) + yv(b)

                LINE (x(1, b), y(1, b))-(x(2, b), y(2, b)), 0
                LINE (x(0, b), y(0, b))-(x(1, b), y(1, b)), bcolor


        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 = 12
        wyv.max = 12
        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


        LINE (wx(1), wy(1))-(wx(2), wy(2)), 0
        LINE (wx(0), wy(0))-(wx(1), wy(1)), 15

END SUB


------------------------- CUT HERE ---------------------------


()  ()
 \oo/       What's for dinner?
 =||=        
 =||=
Thread Navigation

This is a paginated view of messages in the thread with full content displayed inline.

Messages are displayed in chronological order, with the original post highlighted in green.

Use pagination controls to navigate through all messages in large threads.

Back to All Threads