# One that works using TYPE

October 16 2007 at 9:30 AM
Forum Owner

Response to Buggy Pixel Rain program

DECLARE SUB FillBottom ()
' http://www.network54.com/Forum/190883/message/1192513695
SCREEN 13 '320 by 200
RANDOMIZE TIMER
TYPE Pixel
x AS INTEGER
y AS INTEGER
yNew AS SINGLE
Delta AS SINGLE
Count AS INTEGER
END TYPE

'==========================================================
CONST pMax = 20 ' How many pixels in motion at the same time?
CONST MaxStack = 5 ' How high is the stack?
CONST StackBottom = 100' Where is the bottom of the stack?
'==========================================================

DIM SHARED P(pMax) AS Pixel
DIM SHARED Xpos(100) AS INTEGER ' all start locations

LOCATE 10, 5: LINE INPUT "Press ENTER to start"; e\$
CALL FillBottom
LOCATE 10, 1: LINE INPUT "That's all - Press ENTER"; e\$
CLS
SYSTEM

SUB FillBottom

' Determine start for all pMax pixels
DIM i AS INTEGER, j AS INTEGER
FOR i = 1 TO pMax: GOSUB InitPixel: NEXT i

' Fill Bottom
CLS
DO
cc = cc + 1: IF cc > 3 THEN cc = 0: WAIT &H3DA, 8: WAIT &H3DA, 8, 8
FOR i = 1 TO pMax
P(i).yNew = P(i).yNew + P(i).Delta
IF INT(P(i).yNew) > P(i).y THEN GOSUB DropPixel
NEXT i
LOOP WHILE INKEY\$ = ""
SYSTEM

DropPixel:
IF P(i).Count = MaxStack THEN
FOR j = 1 TO pMax
IF P(j).Count < MaxStack THEN EXIT FOR
NEXT j
IF j < pMax THEN RETURN ELSE EXIT SUB
END IF
IF POINT(P(i).x, P(i).y + 1) = 0 AND P(i).y < StackBottom THEN
PSET (P(i).x, P(i).y), 0
P(i).y = P(i).y + 1
PSET (P(i).x, P(i).y), 15
ELSE
PSET (P(i).x, P(i).y), 15
IF P(i).Count < MaxStack THEN
P(i).Count = P(i).Count + 1
IF P(i).Count < MaxStack THEN GOSUB StartPixel ELSE GOSUB InitPixel
END IF
END IF
RETURN

InitPixel:
tCount = tCount + 1
IF tCount > UBOUND(Xpos) THEN RETURN
DO: j = 1 + INT(RND * UBOUND(Xpos)): LOOP UNTIL Xpos(j) = 0
Xpos(j) = 1: P(i).x = j
P(i).Delta = .1 + RND / 10
P(i).Count = 0
StartPixel:
P(i).y = 1: P(i).yNew = .9
RETURN

END SUB

 Respond to this message
 Response Title Author and Date Same without TYPE (View Thread) Mac on Oct 16 Newbie question =( Ty on Oct 16 DIM SHARED Mac on Oct 17 re Rain programs (View Thread) chequer on Oct 19 Re: re Rain programs Mac on Oct 19 LOL he copied the entire message with Select all! Clippy on Oct 26

Newbies usually go to www.qbasic.com and click on The QBasic Forum
Forum regulars have their own ways, which include The QBasic Community Forums