Keskustelu: Koodit: QB: Pyörivä planeetta

'Planeetta-animaatio
' Perustuu eräänlaisen kartan valmiiksi laskemiseen. Planeettaa piirrettäessä
' katsotaan kartasta, mikä kohta pintakuvioinnista piirretään.
'
' Versio:    2.1                                  y |
' Tekijä:    Teppo Niinimäki                        |
' Päiväys:   30.7.2003                              |________ x
'                                                  /
'                                                / z
'---------------------------------------------------------------------------

planeetta% = 1           '1 = kuu tms.
                         '2 = neptunus tms.

sade% = 64               'planeetan säde (leveyssuunnassa)

tahdet% = 1              'piirretäänkö tähdet? (0/1)
valaistus% = 1           'onko valaistus päällä? (0/1)
taustavalo% = 1          'onko taustavalo? (0/1)  (0 on aidomman näköinen)
reunapehmennys% = 1      'suoritetaanko planeetan reunojen pehmennys? (0/1)

keskusX% = 160           'planeetan keskikohta ruudulla
keskusY% = 100

kuvanLeveys% = 256       'pintakuvioinnin koko
kuvanKorkeus% = 128

puorimisnopeus! = 16     'nopeus, jolla planeetta pyörii akselinsa ympäri

tahtia% = 200            'tähtien määrä

valoX! = -2              'valon suunta vektorina
valoY! = -1              '(kokeile valoZ!=-1 kun planeetta%=1 ja taustavalo%=0
valoZ! = 1               '    -> kuun sirppi)

valo% = 100              'valon voimakkuus
tvalo% = 40              'taustavalon voimakkuus

suhde! = 200 / 240       'pikselit SCREEN 13 :ssa korkeampia kuin leveitä
                         '    -> korjataan vääristymä
                         'muuttamalla saa planeetasta hassun muotoisen

IF planeetta% = 1 THEN
 kallistus1! = 0         'planeetan kallistuminen vasemmalle
 kallistus2! = 0         'planeetan kallistuminen ruutua kohti
ELSEIF planeetta% = 2 THEN
 kallistus1! = 10
 kallistus2! = 40
END IF

pehmennyksia% = 5        'paljonko pintatekstuuria pehmennetään



'----- Alkuarvojen asetus päättyy ja koodi alkaa ----

SCREEN 13

leveys% = sade% * 2
korkeus% = sade% * 2 * suhde!
puolileveys% = leveys% \ 2
puolikorkeus% = korkeus% \ 2

CONST PI = 3.14159

RANDOMIZE TIMER

DIM imgx(leveys% - 1, korkeus% - 1) AS INTEGER
DIM imgy(leveys% - 1, korkeus% - 1) AS INTEGER
DIM valoisuus(leveys% - 1, korkeus% - 1) AS INTEGER

DIM vari(kuvanLeveys% - 1, kuvanKorkeus% - 1) AS INTEGER


' Vaihdetaan paletti
FOR i% = 0 TO 63
 PALETTE i%, i% + i% * 256 + i% * 256 ^ 2
 PALETTE i% + 64, i% \ 4 + i% * 256 + i% * 256 ^ 2
NEXT i%

COLOR 60



'----- Esilaskenta alkaa -----

' Piirretään karkea pintakuviointi
PRINT "Pintakuviointi.";
FOR y% = 0 TO kuvanKorkeus% - 1
 IF planeetta% = 1 THEN
  'w% = 4 * SQR((kuvanKorkeus% / 2) ^ 2 - (y% - kuvanKorkeus% / 2 + .5) ^ 2)
  w% = kuvanLeveys% * SIN((y% + .5) * PI / kuvanKorkeus%)
 ELSEIF planeetta% = 2 THEN
  w% = kuvanLeveys% / (RND * 20 + 10)
 END IF
 FOR x% = 0 TO w% - 1
  IF planeetta% = 1 THEN
   v% = INT(RND * 20 + 20)
  ELSEIF planeetta% = 2 THEN
   v% = INT(RND * 10 + 30) + 64
  END IF
  ax& = x%
  akL& = kuvanLeveys%
  FOR xx& = ax& * akL& \ w% TO (ax& + 1) * akL& \ w% - 1
   vari(xx&, y%) = v%
   'PSET (xx&, y%), vari(xx&, y%)
  NEXT xx&
 NEXT x%
 IF y% MOD 20 = 0 THEN PRINT ".";
NEXT y%
PRINT "OK"

' Pehmennetään pintakuviointi
PRINT "Pehmennys.";
FOR i% = 1 TO pehmennyksia%
 FOR x% = 0 TO kuvanLeveys% - 1
  FOR y% = 0 TO kuvanKorkeus% - 1
   v1% = vari(x%, y%)
   v2% = vari((x% + 1) MOD kuvanLeveys%, y%)
   v3% = vari((x% - 1 + kuvanLeveys%) MOD kuvanLeveys%, y%)
   v4% = vari(x%, (y% + 1) MOD kuvanKorkeus%)
   v5% = vari(x%, (y% - 1 + kuvanKorkeus%) MOD kuvanKorkeus%)
   vari(x%, y%) = CINT((v1% + v2% + v3% + v4% + v5%) / 5)
   'PSET (x%, y%), vari(x%, y%)
  NEXT y%
  IF x% MOD (20 * pehmennyksia%) = 0 THEN PRINT ".";
 NEXT x%
NEXT i%
PRINT "OK"

'CLS

PRINT "Pintakartta.";


' Lasketaan kartta ja valaistus
FOR x% = 0 TO leveys% - 1
 FOR y% = 0 TO korkeus% - 1
  xx! = x% - sade% + .5
  yy! = y% / suhde! - sade% + .5
  dxy! = SQR(xx! ^ 2 + yy! ^ 2)
  IF dxy! > sade% THEN
   ' Pikseli planeetan ulkopuolella
   imgx(x%, y%) = -1
   imgy(x%, y%) = -1
  ELSE
   ' Pikseli planeetan sisäpuolella
   zz! = SQR(sade% ^ 2 - dxy! ^ 2)

   ' Kallistetaan sivusuunnassa
   IF xx! <> 0 THEN
    k1! = ATN(yy! / xx!)
   ELSE
    k1! = 0
   END IF
   IF xx! < 0 OR (k1! = 0 AND xx! > 0) THEN k1! = k1! + PI
   k1! = k1! + kallistus1! * PI / 180
   xxx! = dxy! * COS(k1! + PI * 2)
   yyy! = dxy! * SIN(k1! + PI * 2)
   zzz! = zz!

   ' Kallistetaan syvyyssuunnassa
   dyz! = SQR(yyy! ^ 2 + zzz! ^ 2)
   IF zzz! <> 0 THEN
    k2! = ATN(yyy! / zzz!)
   ELSE
    k2! = 0
   END IF
   IF zzz! < 0 OR (k2! = 0 AND zzz! > 0) THEN k2! = k2! + PI
   k2! = k2! - kallistus2! * PI / 180
   yyy! = dyz! * SIN(k2! + PI * 2)
   zzz! = dyz! * COS(k2! + PI * 2)

   ' Lasketaan, millä "leveyspiirillä" pikseli sijaitsee
   IF zzz! <> 0 AND xxx! <> 0 THEN
    kulma1! = ATN(yyy! / SQR(zzz! ^ 2 + xxx! ^ 2))
   ELSE
    kulma1! = 0
   END IF
   IF zzz! < 0 OR (kulma1! = 0 AND yyy! > 0) THEN kulma1! = kulma1 + PI

   ' Lasketaan, millä "pituuspiirillä" pikseli sijaitsee
   IF zzz! <> 0 THEN
    kulma2! = ATN(xxx! / zzz!)
   ELSE
    kulma2! = 0
   END IF
   IF zzz! < 0 OR (kulma2! = 0 AND xxx! > 0) THEN kulma2! = kulma2 + PI

   imgy(x%, y%) = INT((kulma1! + PI / 2) * kuvanKorkeus% / PI)
   imgx(x%, y%) = INT((kulma2! + PI / 2) * kuvanLeveys% * 8 / PI)

   ' Valaistus
   IF valaistus% = 1 THEN
    ' Lasketaan valon määrä pistetulolla:
    valo1% = (xx! * valoX! + yy! * valoY! + zz! * valoZ!) * valo% / SQR(valoX! ^ 2 + valoY! ^ 2 + valoZ! ^ 2) / sade%
    IF valo1% < 0 THEN valo1% = 0
    ' "Taustavalo" myös pistetulolla (valo tulee kameran/ruudun suunnasta):
    IF taustavalo% = 1 THEN
     valo2% = zz! * tvalo% / sade%
     IF valo2% < 0 THEN valo2% = 0
    ELSE
     valo2% = 0
    END IF
    valoisuus(x%, y%) = valo1% + valo2%
   ELSE
    valoisuus(x%, y%) = 100
   END IF

   ' Pehmennetään planeetan reunoja
   IF reunapehmennys% = 1 THEN
    IF zz! * 5 < sade% THEN valoisuus(x%, y%) = valoisuus(x%, y%) * zz! * 5 / sade%
   END IF
  END IF
 NEXT y%
 IF x% MOD 10 = 0 THEN PRINT ".";
NEXT x%
PRINT "OK"

'DO: LOOP UNTIL INKEY$ <> ""

CLS

' Piirretään tähdet
IF tahdet% = 1 THEN
 FOR i% = 1 TO tahtia%
  PSET (INT(RND * 320), INT(RND * 200)), INT(RND * RND * 50)
 NEXT i%
END IF



'----- Esilaskenta päättyy ja pääsilmukka alkaa -----

' Piirtosilmukka
i! = 0
t# = TIMER
DO
 ' Hidastus
 t# = t# + 0.05
 WHILE TIMER < t#: WAIT &h3da, &h8: WEND

 ' Pyöritetään
 i! = i! + puorimisnopeus!
 IF CINT(i!) >= kuvanLeveys% * 16 THEN i! = i! MOD kuvanLeveys%
 i% = CINT(i!)

 ' Piirretään
 FOR x% = 0 TO leveys% - 1
  FOR y% = 0 TO korkeus% - 1
   IF imgx(x%, y%) <> -1 THEN
    v% = vari((imgx(x%, y%) + i%) \ 16 MOD kuvanLeveys%, (imgy(x%, y%)) MOD kuvanKorkeus%)
    va% = (v% MOD 64) * valoisuus(x%, y%) \ 100
    IF va% > 63 THEN va% = 63
    PSET (x% + 160 - puolileveys%, y% + 100 - puolikorkeus%), (v% \ 64) * 64 + va%
   END IF
  NEXT y%
 NEXT x%
LOOP UNTIL INKEY$ = CHR$(27)
END