Article View: alt.lang.basic
Article #179Xswarm.bas
From: kwj
Date: Sat, 29 Aug 1992 17:12
Date: Sat, 29 Aug 1992 17:12
196 lines
4767 bytes
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!kwjShow 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