Keskustelu: Koodit: QB: Manuaalisesti ohjattava 3D-Starfield

TYPE star
   x AS INTEGER
   y AS INTEGER
   z AS INTEGER
   sx AS INTEGER
   sy AS INTEGER
END TYPE

SCREEN 13

'Tehdään paletti
OUT &H3C8, 0
FOR c = 0 TO 255
  OUT &H3C9, INT(c / 4)
  OUT &H3C9, INT(c / 4)
  OUT &H3C9, INT(c / 4)
NEXT

nopeus = .1 'mitä suurempi, sen hitaampi
s = 25
cx = 160 '2D-ruudun keskikohta x-suunnassa
cy = 100 '---------''--------- y-suunnassa
tahtia = 200 'tähtien määrä. 200 toimii hyvin P133MHz-koneella

DIM tahti(1 TO tahtia) AS star

DO
   b = b + 1 'jos b > 1 niin uusi tähti ilmestyy mahdollisimman kauas
             'jos ei niin uusi tähti voi yhtäkkiä ilmestyä kameran eteen :D

   'reunojen koordinaatioviivojen tyhjennys (voi poistaa)
   'jos poistat, kannattaa myös SELECT CASE:n jälkeisetkin
   'poistaa

   LINE (cx - 25, 1)-(cx + 25, 1), 0
   LINE (cx, 1)-(cx, 25), 0

   LINE (cx - 25, 199)-(cx + 25, 199), 0
   LINE (cx, 199)-(cx, 199 - 25), 0

   LINE (1, cy)-(25, cy), 0
   LINE (1, cy - 25)-(1, cy + 25), 0

   LINE (319 - 25, cy)-(319, cy), 0
   LINE (319, cy - 25)-(319, cy + 25), 0


   SELECT CASE INKEY$    'Tunnistetaan näppäinpainallukset
      CASE CHR$(0) + "K" 'vasemmalle
         cx = cx + 1
      CASE CHR$(0) + "M" 'oikealle
         cx = cx - 1
      CASE CHR$(0) + "P" 'alas
         cy = cy - 1
      CASE CHR$(0) + "H" 'ylös
         cy = cy + 1
      CASE CHR$(27)      'ESC
         END
   END SELECT

   'Jos poistit ennen SELECT CASE:a olevat viivahommelit,
   'kannattaa nämäkin poistaa!
   'Nämä viivat siis näyttävät minnepäin lennetään. Lento
   'ei siis tapahdu sinnepäin minne kamera osoittaa, vaan
   'kokoajan samaan suuntaan.

   LINE (cx - 25, 1)-(cx + 25, 1), 255
   LINE (cx, 1)-(cx, 25), 255

   LINE (cx - 25, 199)-(cx + 25, 199), 255
   LINE (cx, 199)-(cx, 199 - 25), 255

   LINE (1, cy)-(25, cy), 255
   LINE (1, cy - 25)-(1, cy + 25), 255

   LINE (319 - 25, cy)-(319, cy), 255
   LINE (319, cy - 25)-(319, cy + 25), 255

   FOR I = 1 TO tahtia
      IF tahti(I).z <= 3 THEN 'jos tähti on tarpeeksi lähellä
         PSET (tahti(I).sx, tahti(I).sy), 0     'tähden poistaminen
         PSET (tahti(I).sx + 1, tahti(I).sy), 0
         PSET (tahti(I).sx - 1, tahti(I).sy), 0
         PSET (tahti(I).sx, tahti(I).sy + 1), 0
         PSET (tahti(I).sx, tahti(I).sy - 1), 0

         tahti(I).x = INT(RND * 1000) 'arvotaan tähdelle uudet koordit
         tahti(I).y = INT(RND * 600)

         IF b < 2 THEN tahti(I).z = INT(RND * 255) + 1 ELSE tahti(I).z = 255

         IF (INT(RND * 2) = 0) THEN tahti(I).x = -tahti(I).x 'saa tähdet tulla
         IF (INT(RND * 2) = 0) THEN tahti(I).y = -tahti(I).y 'myös vasemmalle ja
       	                                                     'ylöskin :>

         tahti(I).sx = tahti(I).x * s / tahti(I).z + cx 'lasketaan tähden paikka
         tahti(I).sy = tahti(I).y * s / tahti(I).z + cy '2D-ruutuun

         PSET (tahti(I).sx, tahti(I).sy), 255 - tahti(I).z           'piirretään
         PSET (tahti(I).sx + 1, tahti(I).sy), (255 - tahti(I).z) / 2 'tähti
         PSET (tahti(I).sx - 1, tahti(I).sy), (255 - tahti(I).z) / 2
         PSET (tahti(I).sx, tahti(I).sy + 1), (255 - tahti(I).z) / 2
         PSET (tahti(I).sx, tahti(I).sy - 1), (255 - tahti(I).z) / 2

      ELSE 'jos tähti ei ole vielä tarpeeksi lähellä

         PSET (tahti(I).sx, tahti(I).sy), 0     'tähden poisto
         PSET (tahti(I).sx + 1, tahti(I).sy), 0
         PSET (tahti(I).sx - 1, tahti(I).sy), 0
         PSET (tahti(I).sx, tahti(I).sy + 1), 0
         PSET (tahti(I).sx, tahti(I).sy - 1), 0

         tahti(I).z = tahti(I).z - 1 'siirretään tähti lähemmäksi

         tahti(I).sx = tahti(I).x * s / tahti(I).z + cx 'lasketaan tähen paikka
         tahti(I).sy = tahti(I).y * s / tahti(I).z + cy '2D-ruutuun

         PSET (tahti(I).sx, tahti(I).sy), 255 - tahti(I).z           'piirretään tähti
         PSET (tahti(I).sx + 1, tahti(I).sy), (255 - tahti(I).z) / 2 'lähemmäksi kameraa
         PSET (tahti(I).sx - 1, tahti(I).sy), (255 - tahti(I).z) / 2
         PSET (tahti(I).sx, tahti(I).sy + 1), (255 - tahti(I).z) / 2
         PSET (tahti(I).sx, tahti(I).sy - 1), (255 - tahti(I).z) / 2

      END IF
   NEXT I
   alkuaika = TIMER
   DO: LOOP UNTIL TIMER - alkuaika >= nopeus / 100 'hidastus
LOOP