'===========================================================================
' Subject: WATER SIMULATION                  Date: 08-19-98 (13:57)       
' Author:  Joe Huber, Jr.                    Code: QB, QBasic, PDS        
' Origin:  huberjjr@nicom.com              Packet: GRAPHICS.ABC
'===========================================================================
' WATER.BAS, a particle sim by
' Hit 'A' to pull the plug, ESC to exit

' If anybody has any ideas about how to implement pressure, please email me

' please send any comments, questions, ect. to huberjjr@nicom.com

DEFINT A-Z   ' Increases speed considerablely

TYPE Drop
 X AS INTEGER
 Y AS INTEGER
 FreeTime AS INTEGER       ' Number of cycles of free fall
 LastDir AS INTEGER
END TYPE

CONST MaxDrops = 6000    ' less=faster.  On my P133, I can get
CONST MaxX = 320         ' about 33 fps compiled with 6000 drops
CONST MaxY = 200         ' and 20 fps in QBasic w/1000 drops

CONST SpreadChance = .1       ' try 1 or 0 for interesting effects
CONST SpreadTime = 3         ' how many cycles of free-fall it takes
                             ' the water to spread

RANDOMIZE TIMER

DIM Water(MaxDrops) AS Drop        ' the bucket :)

FOR I = 1 TO MaxDrops
 Water(I).X = MaxX \ 2
 Water(I).Y = 1
 Water(I).FreeTime = 0
NEXT I

SCREEN 13

' Draws box at top
LINE ((MaxX \ 2 - 20), 1)-((MaxX \ 2 - 20), 20), 15
LINE ((MaxX \ 2 + 20), 1)-((MaxX \ 2 + 20), 20), 15
LINE ((MaxX \ 2 - 20), 20)-((MaxX \ 2 + 20), 20), 15

' Draws Pipe
LINE ((MaxX \ 2 - 4), 20)-((MaxX \ 2 - 4), 44), 15
LINE ((MaxX \ 2 + 4), 20)-((MaxX \ 2 + 4), 50), 15
LINE ((MaxX \ 2 - 4), 44)-((MaxX \ 2 - 40), 44), 15
LINE ((MaxX \ 2 + 4), 50)-((MaxX \ 2 - 40), 50), 15

'Draws slanted line
LINE (50, 40)-(200, 100), 15
LINE (50, 41)-(200, 101), 15
LINE (50, 42)-(200, 102), 15
LINE (50, 43)-(200, 103), 15

st! = TIMER

DO
 FOR I = 1 TO MaxDrops
 
  OldX = Water(I).X    ' For erase
  OldY = Water(I).Y
  WLeft = Water(I).X - 1     ' Precalcs posision to the left,
  WRight = Water(I).X + 1    ' "                      " right,
  WDown = Water(I).Y + 1     ' And below
 
  PntDown = POINT(Water(I).X, WDown)   ' Check below droplet
  IF PntDown = 0 THEN
   IF Water(I).FreeTime = SpreadTime THEN                ' spread effect
    IF RND < SpreadChance THEN
     IF RND < .5 THEN                                   ' 50-50 chance
      PntRight = POINT(WRight, WDown)   ' confirm that the space
      IF PntRight = 0 THEN              ' to right is free...
       Water(I).X = WRight
      END IF
     ELSE
      PntLeft = POINT(WLeft, WDown)    ' ...or to the left
      IF PntLeft = 0 THEN
       Water(I).X = WLeft
      END IF
     END IF
    END IF
    Water(I).FreeTime = 0
   END IF
   Water(I).Y = WDown
   Water(I).FreeTime = Water(I).FreeTime + 1
   Water(I).LastDir = 0
  ELSE
   PntLeft = POINT(WLeft, Water(I).Y)                   ' can't fall down, so
   PntRight = POINT(WRight, Water(I).Y)                 ' check to right &
   IF PntLeft = 0 AND PntRight = 0 THEN                 ' left
    IF Water(I).LastDir <> 0 THEN
     Water(I).X = Water(I).X + Water(I).LastDir         ' if both directions
    ELSE                                                ' are free, travel
     IF RND < .5 THEN                                   ' in last known dir,
      Water(I).X = WLeft                                ' else pick a new one
      Water(I).LastDir = -1
     ELSE                                               ' (50-50 chance)
      Water(I).X = WRight
      Water(I).LastDir = 1
     END IF
    END IF
   ELSEIF PntLeft = 0 THEN                              ' if the left is open,
    Water(I).X = WLeft                                  ' go there...
    Water(I).LastDir = -1
   ELSEIF PntRight = 0 THEN                             ' ...or else go right
    Water(I).X = WRight
    Water(I).LastDir = 1
   END IF
  END IF
  IF OldX <> Water(I).X OR OldY <> Water(I).Y THEN  ' did it move?
   PSET (OldX, OldY), 0                             ' yes, erase
   PSET (Water(I).X, Water(I).Y), 1                 ' and draw
  END IF
 NEXT I

 I$ = INKEY$
 SELECT CASE UCASE$(I$)
  CASE "A"
   FOR I = 0 TO 3                ' Removes the cork
    PSET (MaxX \ 2 + I, 20), 0
    PSET (MaxX \ 2 - I, 20), 0
   NEXT I
  CASE CHR$(27)   ' Escape
   EXIT DO
 END SELECT

 f% = f% + 1
 IF f% = 24 THEN
  LOCATE 1, 1
  PRINT ABS(INT(f% / ((st! - TIMER) + .0001))); "fps"
  f% = 0
  st! = TIMER
 END IF

LOOP

END