🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: alt.lang.basic
Article #179

Xswarm.bas

#179
From: 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?
 =||=        
 =||=
Technical Details
Message-ID: <1992Aug29.171200.501@news.iastate.edu>
Path: arc1-ca.pugleaf.net!sparky!uunet!cs.utexas.edu!sdd.hp.com!ux1.cso.uiuc.edu!news.iastate.edu!kwj

Show Full Headers
Complete Article Headers
Newsgroups: alt.lang.basic
Path: arc1-ca.pugleaf.net!sparky!uunet!cs.utexas.edu!sdd.hp.com!ux1.cso.uiuc.edu!news.iastate.edu!kwj
From: kwj@iastate.edu (kwj)
Subject: Xswarm.bas
Message-ID: <1992Aug29.171200.501@news.iastate.edu>
Sender: news@news.iastate.edu (USENET News System)
Organization: Iowa State University, Ames, IA
Date: Sat, 29 Aug 1992 17:12:00 GMT
Lines: 196