Koodit: QB: Veden virtaus -efekti

SCREEN 13

TYPE kohta
  x AS INTEGER
  y AS INTEGER
  s AS INTEGER
END TYPE

'pisaroita yhteensä
max = 5000

'pisarataulukko
DIM vesi(1 TO max) AS kohta

'pisaroiden alkukohdat
RANDOMIZE TIMER
vkohta = 0
FOR i = 1 TO max
  vesi(i).x = 8 + INT(RND * 3) + 1
  vkohta = vkohta - .6 'mitä pienempi, sen vuolaampi
  vesi(i).y = vkohta
NEXT


'maaston piirtäminen
pii = 4 * ATN(1)
LINE (5, 50)-(100, 70)
LINE (101, 80)-(81, 100)
LINE (101, 80)-(141, 120)
LINE (70, 100)-(70, 120)
LINE (90, 100)-(90, 120)
LINE (70, 120)-(90, 120)
CIRCLE (135, 140), 10
CIRCLE (135, 140), 14, 15, pii, 2 * pii - pii / 1.5
LINE (135, 140)-(135, 130), 0
LINE (135, 140)-(120, 140), 0
LINE (136, 130)-(170, 100)
PSET (70, 114), 0
LINE (50, 130)-(100, 150)
CIRCLE (110, 100), 118, , pii, 2 * pii

DO
  FOR i = 1 TO max
    'vanha pisara pois
    PSET (vesi(i).x, vesi(i).y), 0
    vx = vesi(i).x: vy = vesi(i).y
    IF POINT(vesi(i).x, vesi(i).y + 1) <= 0 THEN
      vesi(i).y = vesi(i).y + 1 'jos alhaalla on tyhjää
    ELSE
      'vasemman ja oikean puolen tilan laskeminen
      av% = 0: ao% = 0
      FOR j = vesi(i).y TO 320
        IF POINT(vesi(i).x - 1, j) <= 0 THEN
          av% = av% + 1
        ELSE
          EXIT FOR
        END IF
      NEXT
      FOR j = vesi(i).y TO 320
        IF POINT(vesi(i).x + 1, j) <= 0 THEN
          ao% = ao% + 1
        ELSE
          EXIT FOR
        END IF
      NEXT
      IF av% = 0 AND ao% = 0 THEN
        'pisara ei pääse liikkumaan
      ELSEIF av% >= 1 AND ao% = 0 THEN
        vesi(i).x = vesi(i).x - 1 'oikealle ei pääse: siis vasemmalle
      ELSEIF ao% >= 1 AND av% = 0 THEN
        vesi(i).x = vesi(i).x + 1 'vasemmalle ei pääse: siis oikealle
      ELSE 'molemmat suunnat mahdollisia
        IF vesi(i).s = 0 THEN 'vesi on tulossa ylhäältä, suunta arvotaan
          vesi(i).x = vesi(i).x + (-1 + INT(RND * 3))
        ELSEIF vesi(i).s = 1 THEN 'vesi on tulossa oikealta: siis vasemmalle
          vesi(i).x = vesi(i).x - 1
        ELSEIF vesi(i).s = 2 THEN 'vesi on tulossa vasemmalta: siis oikealle
          vesi(i).x = vesi(i).x + 1
        END IF
      END IF
    END IF
    'uuden suunnan laskeminen
    IF vy <> vesi(i).x THEN vesi(i).s = 0
    IF vx < vesi(i).x THEN vesi(i).s = 2
    IF vx > vesi(i).x THEN vesi(i).s = 1
    'uuden pisaran piirtäminen
    PSET (vesi(i).x, vesi(i).y), 1
  NEXT
LOOP WHILE INKEY$ <> CHR$(27)