The QBasic / QB64 Discussion Forum      Other Subforums, Links and Downloads
 
 

 Return to Index  

Same without TYPE

October 16 2007 at 9:46 AM
Mac  (Premier Login iorr5t)
Forum Owner


Response to One that works using TYPE

 

DECLARE SUB FillBottom ()
' http://www.network54.com/Forum/190883/message/1192513695
SCREEN 13 '320 by 200
RANDOMIZE TIMER

'==========================================================
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 Xpos(100) AS INTEGER ' all start locations
DIM SHARED x(pMax) AS INTEGER
DIM SHARED y(pMax) AS INTEGER
DIM SHARED yNew(pMax) AS SINGLE
DIM SHARED Delta(pMax) AS SINGLE
DIM SHARED Count(pMax) AS INTEGER

 

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
    yNew(i) = yNew(i) + Delta(i)
    IF INT(yNew(i)) > y(i) THEN GOSUB DropPixel
  NEXT i
LOOP WHILE INKEY$ = ""
SYSTEM

DropPixel:
IF Count(i) = MaxStack THEN
  FOR j = 1 TO pMax
    IF Count(j) < MaxStack THEN EXIT FOR
  NEXT j
  IF j < pMax THEN RETURN ELSE EXIT SUB
END IF
IF POINT(x(i), y(i) + 1) = 0 AND y(i) < StackBottom THEN
  PSET (x(i), y(i)), 0
  y(i) = y(i) + 1
  PSET (x(i), y(i)), 15
ELSE
  PSET (x(i), y(i)), 15
  IF Count(i) < MaxStack THEN
    Count(i) = Count(i) + 1
    IF Count(i) < 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: x(i) = j
Delta(i) = .1 + RND / 10
Count(i) = 0
StartPixel:
y(i) = 1: yNew(i) = .9
RETURN

END SUB

 


 
 Respond to this message   
Response TitleAuthor and Date
Newbie question =(Ty on Oct 16
   DIM SHAREDMac on Oct 17
 Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement  

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