'===========================================================================
' Subject: FOUNTAIN PARTICLE SIMULATION      Date: 05-24-97 (15:20)       
' Author:  Daniel Davies                     Code: QB, QBasic, PDS        
' Origin:  ia53@rapid.co.uk                Packet: GRAPHICS.ABC
'===========================================================================
'FOUNTAIN PARTICLE SIMULATION
'keys are
'+ to increase gravity
'- to reduce gravity
'x to increase wind speed
'z to decrease wind speed
'if wind speed is below zero then the wind is blowing left instead of right
'if you want to use this code, you may, but please give me credit, and tell
'me about.
'you can e-mail me at ia53@rapid.co.uk

SCREEN 13

TYPE particle
x AS DOUBLE
y AS DOUBLE
xm AS DOUBLE
ym AS DOUBLE
END TYPE

num% = 200
DIM objs(num%) AS particle
DIM new(num%) AS particle
RANDOMIZE TIMER
FOR x% = 1 TO num%
objs(x%).x = INT((RND * 20) + 150)
objs(x%).y = 0
objs(x%).xm = (RND * 1.25) - .625
objs(x%).ym = (RND * 3) + 2
NEXT x%
wind# = 0
GRAV# = .1
st# = TIMER
DO
Z$ = UCASE$(INKEY$)
IF Z$ = "Z" THEN wind# = wind# - .01
IF Z$ = "X" THEN wind# = wind# + .01
IF Z$ = "-" THEN GRAV# = GRAV# - .01
IF Z$ = "+" THEN GRAV# = GRAV# + .01
FOR x% = 1 TO num%

IF objs(x%).y > 200 THEN GOTO skip:
        PSET (new(x%).x, new(x%).y), 0
        PSET (objs(x%).x, 199 - objs(x%).y), 15
        new(x%).x = objs(x%).x
        new(x%).y = 199 - objs(x%).y
skip:
        objs(x%).x = objs(x%).x + objs(x%).xm
        objs(x%).y = objs(x%).y + objs(x%).ym
        objs(x%).ym = objs(x%).ym - GRAV#
        objs(x%).xm = objs(x%).xm + wind#

IF objs(x%).y <= 0 OR objs(x%).x > 320 OR objs(x%).x < 0 THEN
objs(x%).x = INT((RND * 20) + 150): objs(x%).y = 0
objs(x%).xm = (RND * 1.25) - .625: objs(x%).ym = (RND * 3) + 2
END IF

NEXT x%
LOCATE 1, 1
PRINT USING "##.##"; wind#
PRINT USING "##.##"; GRAV#
p% = 0
f% = f% + 1
PRINT ABS(INT(f% / (st# - TIMER))); "fps"
LOOP WHILE Z$ <> "Q"