Keskustelu: Koodit: QB: Alueen räjäytys

'Funktion esittely
DECLARE SUB explode (sx AS INTEGER, sy AS INTEGER, sw AS INTEGER, sh AS INTEGER)
'Eli: räjäyttää alueen(sx,sy)-(sx+sw,sy+sh)

DEFINT A-Z
'Muutamia vakioita, joita subbi käyttää
CONST GRAVITY = .12, XEFFECT = .2, GRAV.ON = (1 = 1), BOUNCE.ME= .6
'Selitys: gravity = pisteiden kiihtyvyys/hidastuvuus pomppiessa.
'xeffect = miten paljon pisteillä esiintyy max liikettä sivusuunnassa.
'grav.on = on/off, pomppaavatko palat alareunasta (paremman näköistä, jos päällä)
'bounce.me = miten lujaa pixeli kimpoaa maan pinnasta.


SUB explode (sx AS INTEGER, sy AS INTEGER, sw AS INTEGER, sh AS INTEGER)
'lasketaan, montako framea tarvitaan. Tämä on vain purkkaviritelmä omalle koneelle, mutta
'antaa melko oikean määrän eri aloille.
IF GRAV.ON THEN effframe = (.18 / GRAVITY) * sh * 2 ELSE effframe = (.1 / GRAVITY) * sh * 2
'varataan muisti alueelle
DIM poss(sw * sh, 4) AS SINGLE, cols(sw * sh) AS INTEGER, maara AS INTEGER
maara = 0
'optimointia: määritellään, millaisia pixeleitä ei ladata.
'itse skippaan vain mustan värin.
  FOR y = 1 TO sh
  FOR x = 1 TO sw
    IF POINT(x + sx - 1, y + sy - 1) <> 0 THEN
      poss(maara, 0) = x + sx - 1 'x-koordinaatti
      poss(maara, 1) = y + sy - 1 'y- - || -
      poss(maara, 2) = 0  'gravity
      poss(maara, 3) = (RND * 2 - 1) * XEFFECT 'xm
      cols(maara) = POINT(x + sx - 1, y + sy - 1)
      maara = maara + 1
    END IF
  NEXT x, y
'Nyt meillä on muistissa ainoastaan ne pisteet, joita pitääkin liikuttaa.
'Eiköhän siis räjäytetä....
FOR a = 1 TO effframe
  FOR z = 0 TO maara - 1
    'onko piste vielä alueella?
    IF poss(z, 0) >= sx AND poss(z, 0) < sx + sw AND poss(z, 1) >= sy AND poss(z, 1) < sy + sh THEN PSET (poss(z, 0), poss(z, 1)), 0
    poss(z, 0) = poss(z, 0) + poss(z, 3) '<-- ? -->
    poss(z, 1) = poss(z, 1) + poss(z, 2) 'alaspäin-ylöspäin
    IF ABS(poss(z, 2)) >= 0 THEN 'gravitaation vaikutus
      poss(z, 2) = poss(z, 2) + GRAVITY
    END IF
    IF poss(z, 1) >= sy + sh AND GRAV.ON AND RND < .3 THEN poss(z, 2) = -(poss(z, 2) * BOUNCE.ME) 'kimmotus
    'Onko piste vielä alueella?
    IF poss(z, 0) >= sx AND poss(z, 0) < sx + sw AND poss(z, 1) >= sy AND poss(z, 1) < sy + sh THEN PSET (poss(z, 0), poss(z, 1)), cols(z)
  NEXT
NEXT

'lopuksi vielä piilotetaan alueelle mahdollisesti seikkailemaan jääneet pisteet.
FOR z = 0 TO maara - 1
  IF poss(z, 0) >= sx AND poss(z, 0) < sx + sw - 1 AND poss(z, 1) >= sy AND poss(z, 1) < sy + sh THEN PSET (poss(z, 0), poss(z, 1)), 0
NEXT

END SUB