Kirjautuminen

Haku

Tehtävät

Koodit: QB: Revontulet

Kirjoittaja: hunajavohveli

Kirjoitettu: 17.06.2004 – 17.06.2004

Tagit: grafiikka, koodi näytille, vinkki

Revontulia esittävä efekti. Revontulet muodostuvat 320 peräkkäisestä ylhäältä alas kulkevasta viivasta, joiden väri liukuu tummasta vaaleaan ylhäältä alas. Viivat liikkuvat animaation aikana satunnaisesti ylös ja alas. Samalla vaihdetaan palettia, joka määrää revontulien sävyn. Viivojen korkeutta voi säätää muokkamalla Korkeus-muuttujaa alkumäärittelyissä.

DECLARE SUB VaihdaPaletti (Red AS SINGLE, Green AS SINGLE, Blue AS SINGLE)

'Revontulet 17.6.2004 by Hunajavohveli
'(aloitettu kenties pari vuotta sitten julkaisup?iv?st?, unohtui kaiketi
'johonkin kovalevyn syrj?iseen nurkkaan p?ly? ker??m??n)

DEFINT A-Z       'eik? mit??n desimaaleja...

DIM Red AS SINGLE
DIM Green AS SINGLE
DIM Blue AS SINGLE
DIM RedC AS SINGLE
DIM GreenC AS SINGLE
DIM BlueC AS SINGLE    '...paitsi n?iss? kuudessa

DIM H(-1 TO 319, 1 TO 2) AS INTEGER      'taulukko johon voidaan tallentaan
                                        'edellisten revontuliviivojen
                                       'korkeudet (kumitusta varten)

'alkuasetukset: (kannattaa kokeilla eri arvoja)

CONST Korkeus = 25        'revontuliviivojen korkeus

'v?riarvot v?lilt? 0-10, yli 10 kiepauttaisi paletin ymp?ri (ei hieno)
Red = 5          'punainen
Green = 5        'vihre?
Blue = 5         'sininen    (niin kuin kukaan ei tiet?isi)

RedC = .1      'v?rien vaihtumismuuttujat
GreenC = .1
BlueC = .1

'alkuarvot loppuvat t?h?n

SCREEN 13        'hm...?
VaihdaPaletti Red, Green, Blue    'vaihdetaan paletti v?riarvojen mukaan

RANDOMIZE TIMER     'satunnaislukugeneraattori

H(-1, 1) = 100     'jokaisella on oltava 'naapuriviiva' vasemmalla puolella
H(0, 1) = 100
FOR i = 1 TO 319
  H(i, 1) = H(i - 1, 1) - 4 + INT(RND * 9)    'alkukorkeuksien arvonta
NEXT i


'p??luuppi

DO
  FOR x = 0 TO 319                'silmukka

    LINE (x, H(x, 2) + 1)-(x, H(x, 2) + Korkeus), 0   'kumitetaan vanha viiva

    FOR b = 1 TO Korkeus
      PSET (x, H(x, 1) + b), Savy + b     'piirrett?n uusi viiva
    NEXT b

    H(x, 2) = H(x, 1)                       'tallennetaan nykyinen viiva kumitustaulukkoon (ks. 6 rivi? taaksep?in)
    H(x, 1) = H(x, 1) - 1 + CINT(RND) * 2           'siirret??n seuraavaa viivaa uuteen paikkaan...
    IF H(x, 1) - H(x - 1, 1) > 2 THEN H(x, 1) = H(x, 1) - 1   'ei sent??n liikaa suhteessa 'naapuriviivaan'
    IF H(x, 1) - H(x - 1, 1) < -2 THEN H(x, 1) = H(x, 1) + 1  '...

  NEXT x


Red = Red + RedC         'vaihdetaan s?vy?
Green = Green + GreenC
Blue = Blue + BlueC

IF Red > 10 THEN Red = 10: RedC = -RND / 10        'ei saa menn? yli...
IF Green > 10 THEN Green = 10: GreenC = -RND / 10
IF Blue > 10 THEN Blue = 10: BlueC = -RND / 10

IF Red < 0 THEN Red = 0: RedC = RND / 10          'eik? ali...
IF Green < 0 THEN Green = 0: GreenC = RND / 10
IF Blue < 0 THEN Blue = 0: BlueC = RND / 10

VaihdaPaletti Red, Green, Blue     'uusi paletti

WAIT &H3DA, 8      'pient? hidastusta (poista jos haluat)

LOOP UNTIL INKEY$ = CHR$(27)    'Escist? pois
SUB VaihdaPaletti (Red AS SINGLE, Green AS SINGLE, Blue AS SINGLE)

'paletinvaihtoaliohjelma

FOR i = 1 TO Korkeus
  OUT &H3C8, i
  OUT &H3C9, i * Red * 6.3 / Korkeus
  OUT &H3C9, i * Green * 6.3 / Korkeus
  OUT &H3C9, i * Blue * 6.3 / Korkeus
NEXT i

END SUB

Kommentit

Latska [17.06.2004 17:21:57]

#

Wou...

hunajavohveli [17.06.2004 17:33:32]

#

Pistäkääs joku binaryy jos viitsitte, kun multa se ei luonnistu. Tai sitten Gwaur voisi hankkia QBasicille kääntäjän.

Gwaur [17.06.2004 17:56:23]

#

Mikset itse hanki? :P

Juice [17.06.2004 18:25:05]

#

Hieno, mitä nyt kommenttien ä-kysymysmerkit hämäsivät alkuun :)

peki [17.06.2004 19:03:36]

#

Tosi upee...

hunajavohveli [17.06.2004 19:10:43]

#

lainaus:

Mikset itse hanki? :P

No koska minulla on jo. :)

Bill Keltanen [18.06.2004 08:19:00]

#

Ihan kiva... :D

sooda [18.06.2004 09:18:47]

#

Vovvaavuuu! Hieno kun mikä! Binaryy: http://koti.mbnet.fi/koodaaja/jotaki/REPOTULI.EXE

tomaattigeeni [21.06.2004 02:37:05]

#

QB efektiksi varsin nätti. Tosin toimi järjettömän hitaasti Linuxin alla dosboxilla.

miiro [23.07.2004 12:19:20]

#

aika hieno nopeutettu versio :PP

hunajavohveli [05.08.2004 19:41:26]

#

Nyt sain viimein kotisivutilaa, joten tuolta voi ladata toisen exen. Tuossa paketissa tulee tosin mukana muitakin efektejä.
http://koodaa.mine.nu/~vohveli/QB efekt pak.zip

Kaape [08.10.2006 10:12:40]

#

Onhan toi hieno, mut tota alareunaa voisit tasottaa, kun en ite jaksa.

Kirjoita kommentti

Muista lukea kirjoitusohjeet.
Tietoa sivustosta