Kirjautuminen

Haku

Tehtävät

Koodivinkit: QB: Harmaasävyisiä efektejä

Kirjoittaja: hunajavohveli; viimeksi muokattu 22.06.2004.

Tagit: grafiikka, omat tuotokset

Joskus vuosi sitten koodasin yhdellä vanhalla 486-koneella noin 25 erilaista harmaasävyistä efektiä. Valikoin niistä kymmenen, tein niihin parannuksia, joita en osannut vuosi sitten, ja koostin ne lyhyeksi demoksi. Osa on minusta todella hienoja, mutta joukossa myös muutama turha, jotka olisi kenties voinut korvata jollain muulla, tai jättää kokonaan pois. Myös efektien järjestystä olisi voinut kenties miettiä kauemmin.
Olen yrittänyt kommentoida koodia sen verran kuin siitä enää tajusin. Olen poistanut kaikki ihmeelliset GOTO-viritelmät, ja sisentänyt, mutta koodi on silti joissain paikoissa aika epäselkeää. Jos tajuaa koodista, kannattaa kokeilla muunnella sitä, niin voi saada aikaan yllättävän hienoja variaatioita. (katso esim. Rings-efektin kommenttit)
Efektien nimiä ei kannata ihmetellä. Ne eivät välttämättä näytä siltä, mitä niiden nimi antaa ymmärtää, eivätkä kaikki nimet johdukaan siitä, miltä efektit näyttävät.
Saatan joskus muokata tätä, kun saan aikaan hienompia variaatioita huonoimpien tilalle.
Efektejä on sitten testattu 600 Megahertsisellä koneella. Ne saattavat pyöriä joillain 3-Gigaisilla koneilla liiankin nopeasti. Speed-muuttujasta voi määrittää eräänlaisen nopeuden kokonaislukuna. 1 on pienin mahdollinen. Tätä kannataa siis muuttaa vain jos efektit ovat liian hitaita.
Jos kommentoit, ja viittaat kommentissa johonkin tiettyyn efektiin, kannattaa pistää eteen efektin numero.

DEFINT A-Z
DECLARE SUB Block (Var AS INTEGER)
DECLARE SUB Lines ()
DECLARE SUB LoadPalette ()
DECLARE SUB Rings ()
DECLARE SUB Snow ()
DECLARE SUB Spread ()
DECLARE SUB StarHaze ()
DECLARE SUB Strings ()
DECLARE SUB Slide ()
COMMON SHARED Speed AS INTEGER

SCREEN 13
RANDOMIZE TIMER

Speed = 1        'S??d? t?st? nopeutta (1 on hienoin mutta vaatii tehoja koneelta)

PRINT "Paina jokaisen efektin aikana Enter kun"
PRINT "haluat siirty? seuraavaan. Paina Enter"
PRINT "aloittaaksesi."
a$ = INPUT$(1)

FOR Mode = 1 TO 10
CLS
COLOR 63
PRINT "Efekti numero"; Mode
a$ = INPUT$(1)
CLS

SELECT CASE Mode
CASE 1
  : Lines: a$ = INPUT$(1)
CASE 2
  Block 0
CASE 3
  Block 1
CASE 4
  Block 2
CASE 5
  Spread
CASE 6
  StarHaze
CASE 7
  Snow
CASE 8
  Rings
CASE 9
  Strings
CASE 10
  Slide
END SELECT

NEXT Mode
SUB LoadPalette

'Luo harmaas?vypaletin

'V?rit 0-63 liukuvat mustasta valkoiseen
'V?rit 64-127 liukuvat valkoisesta mustaan
'V?rit 128-191 liukuvat mustasta valkoiseen
'V?rit 192-255 liukuvat valkoisesta mustaan

FOR i = 0 TO 63
  OUT &H3C8, i: OUT &H3C9, i: OUT &H3C9, i: OUT &H3C9, i
  NEXT i
FOR i = 64 TO 127
  OUT &H3C8, i: OUT &H3C9, 127 - i: OUT &H3C9, 127 - i: OUT &H3C9, 127 - i
  NEXT i
FOR i = 128 TO 191
  OUT &H3C8, i: OUT &H3C9, i - 128: OUT &H3C9, i - 128: OUT &H3C9, i - 128
  NEXT i
FOR i = 192 TO 255
  OUT &H3C8, i: OUT &H3C9, 255 - i: OUT &H3C9, 255 - i: OUT &H3C9, 255 - i
  NEXT i

END SUB

SUB Block (Var AS INTEGER)

'Samalla aliohjelmalla saa 3 variaatiota muuttamalla Var-muuttujaa
'Pohjana Lines-efekti, jonka luomia viivoja muokataan

Lines      'luodaan viivat


'T?m?n efektin toimintaan en juurikaan osaa selitt??. Parhaiten sen kai voi
'ymm?rt?? muuttamalla lausekkeet pseudoksi. Variaatioissa on ideana se, ett?
'kun Var on 1, k?sitell??n molempia kahta ensimm?ist? IF-lauseketta. Kun Var
'on 0, k?sitell??n vai ensimm?ist?, ja kun 2, vain toista.

FOR y = 0 TO 198
FOR x = 0 TO 319

DO
  vari1 = POINT(x, y)
  vari2 = POINT(x, y + 1)
  IF Var < 2 AND vari1 < vari2 THEN vari3 = vari2 - vari1  'ensimm?inen...
  IF Var > 0 AND vari2 < vari1 THEN vari3 = vari1 - vari2  'toinen IF-lauseke

  IF vari3 > 1 THEN
    vari = INT(RND * 16) + 16
    PSET (x, y + 1), vari
  ELSE
    EXIT DO
  END IF
LOOP

NEXT x
NEXT y

a$ = INPUT$(1)

END SUB

SUB Lines

'yksinkertaisia harmaas?vyisi? viivoja

vari = INT(RND * 16) + 16     'arvotaan aloitusv?ri

FOR y = 0 TO 199
FOR x = 0 TO 319
  IF vari < 16 THEN vari = 16      'v?ri ei saa menn? yli
  IF vari > 31 THEN vari = 31
  PSET (x, y), vari
  vari = vari - 1 + INT(RND * 3)    'liu'utetaan v?ri? satunnaiseen suuntaan
NEXT x
NEXT y

END SUB
SUB Rings

'Liikuttaa pistett? trigonometrialla ja piirt?? t?hti? pikselin
'koordinaateista. T?hden koko m??r?ytyy pikselin v?rin mukaan.

STATIC x AS SINGLE, y AS SINGLE
STATIC k AS SINGLE, ks AS SINGLE

LoadPalette

DEF SEG = &HA000     'Suoraa n?ytt?muistin k?sittely?

x = 160: y = 100
s = 1: e = 35      'suunta ja pikselin et?isyys n?yt?n keskipisteest?
ks = .1           'Kokeile t?h?n eri arvoja (py?ritysnopeus)

DO
x = 160 + SIN(k) * e    'liikutetaan pikseli?
y = 100 - COS(k) * e

  k = k + ks
  e = e + s
  IF e > 80 OR e < 35 THEN s = -s     'suunnan vaihto

  vari = POINT(x, y) + Speed * 3    'v?ri

  PSET (x, y), vari

  FOR c = 0 TO vari    't?hden piirto
    IF POINT(x - c, y) < vari - c THEN PSET (x - c, y), vari - c
    IF POINT(x + c, y) < vari - c THEN PSET (x + c, y), vari - c
    IF POINT(x, y - c) < vari - c THEN PSET (x, y - c), vari - c
    IF POINT(x, y + c) < vari - c THEN PSET (x, y + c), vari - c
  NEXT c

LOOP UNTIL INKEY$ <> ""

END SUB

SUB Slide

'Yksinkertainen liukumisefekti. Arvotaan pikseleit? ja piirret??n ne uusilla
'v?reill?. Uusi v?ri on (vasemmanpuoleisen pikselin v?ri + 1).

LoadPalette

DO
  x = INT(RND * 320): y = INT(RND * 199) + 1
  PSET (x, y), POINT(x - 1, y - 1 + INT(RND * 3)) + Speed
  PSET (0, INT(RND * 200)), INT(RND * 16)
LOOP UNTIL INKEY$ <> ""

END SUB

SUB Snow

'Arvotaan kohta ja korostetaan sit? ymp?r?ivien satunnaisten pikselien v?rej?

LoadPalette

DO
x = INT(RND * 320)
y = INT(RND * 200)

vari = POINT(x, y) + Speed * 3

PSET (x, y), vari
  c = 0
WHILE vari - c > 0
  c = c + 1
  FOR kertaus = 1 TO 10
    apu = -c + (RND * (c * 2))
    apu2 = -c + (RND * (c * 2))
    IF POINT(x + apu, y + apu2) < vari - c THEN PSET (x + apu, y + apu2), vari - c
  NEXT kertaus
WEND

LOOP UNTIL INKEY$ <> ""

END SUB
SUB Spread

'Korostetaan v?ris?vy? arvotussa pikseliss? ja sen ymp?rill?.

LoadPalette

DO
x = INT(RND * 320)
y = INT(RND * 200)
  PSET (x, y), POINT(x, y) + Speed
  PSET (x - 1, y), POINT(x, y) + Speed
  PSET (x + 1, y), POINT(x, y) + Speed
  PSET (x, y - 1), POINT(x, y) + Speed
  PSET (x, y + 1), POINT(x, y) + Speed
LOOP UNTIL INKEY$ <> ""

END SUB

SUB StarHaze

'T?htim?isest? efektist? luotu variaatio.

LoadPalette

DO
  x = INT(RND * 320)
  y = INT(RND * 200)

  vari = POINT(x, y) + Speed     'muutetaan v?ri?

    PSET (x, y), vari
  FOR c = 1 TO vari      't?hden piirto
    IF POINT(x - c, y) < vari - c THEN PSET (x - c, y), vari - c
    IF POINT(x + c, y) < vari - c THEN PSET (x + c, y), vari - c
    IF POINT(x, y - c) < vari - c THEN PSET (x, y - c), vari - c
    IF POINT(x, y + c) < vari - c THEN PSET (x, y + c), vari - c
  NEXT c

LOOP UNTIL INKEY$ <> ""

END SUB

SUB Strings

'Py?ritet??n renkaita trigonometrialla.

LoadPalette

DIM rad AS SINGLE
rad = ATN(1) * 4 / 180

DIM x AS SINGLE, y AS SINGLE
DIM k AS SINGLE

k = INT(RND * 360): s = 1
x = 160: y = 100


DO
x = x + SIN(k * rad) * 2
y = y - COS(k * rad) * 2

  k = k + s

  IF RND < .02 AND x < 300 AND y > 20 AND y < 180 AND x > 20 THEN s = -s

  IF x >= 0 AND y >= 0 AND x <= 319 AND y <= 199 THEN
    vari = POINT(x, y) + Speed

    PSET (x, y), vari
      c = 0
    WHILE vari - c > 0
      c = c + 1
      IF POINT(x - c, y) < vari - c THEN PSET (x - c, y), vari - c
      IF POINT(x + c, y) < vari - c THEN PSET (x + c, y), vari - c
      IF POINT(x, y - c) < vari - c THEN PSET (x, y - c), vari - c
      IF POINT(x, y + c) < vari - c THEN PSET (x, y + c), vari - c
    WEND
  END IF

LOOP UNTIL INKEY$ <> ""

END SUB

Kommentit

peki [22.06.2004 22:17:05]

Lainaa #

Älyttömän upeita! (lukuunottamatta muutamaa ekoista)
Muuta ei oikeen voi mykistyneenä sanoa.

Linkku [23.06.2004 14:47:12]

Lainaa #

Binääryä?

Antti Laaksonen [23.06.2004 19:22:40]

Lainaa #

Hienoja efektejä!

herkko [24.06.2004 01:03:17]

Lainaa #

En ole vielä kokeillut, mutta eikö nopeutta kannattaisi säätää seuraavalla koodilla, joka siis hidastaa ohjelmaa:

alkuaika = TIMER
DO
   aika = TIMER
LOOP UNTIL aika >= alkuaika + .1

Tämä siis tekee ohjelmaan aina sekunin sadasosan tauon aina kun koodi suoritetaan. Ei siis tarvitsisi jokaisen käyttäjän kokeilla aina alkuun juuri omalle koneelle sopivaa nopeutta.

herkko [24.06.2004 01:31:11]

Lainaa #

Korjaan, koodini aiheuttaa sekuninkymmenesosan tauon.

Bill Keltanen [24.06.2004 08:22:12]

Lainaa #

Hieno!

sooda [24.06.2004 09:15:51]

Lainaa #

Sä oot ihan sekopää kun tollaisia osaat! :D

hunajavohveli [24.06.2004 11:08:04]

Lainaa #

Herkko: Viestejä voi muokatakin, ettei tarvitse lähettää uutta, jos tekee virheen. TIMER-tarkistus on toki sinänsä hyvä idea, ja olen sitä joskus soveltanutkin, mutta tähän käytän luultavasti pikemminkin koodia: WAIT &H3DA, 8

Edit: Binaryä en voi itse pistää nettiin, mutta jos joku haluaa pistää, niin ihan vapaasti. Huomasin vain, että QB:n exe-kääntö bugittaa taas, ja viimeinen efekti kaatuu aina overflowiin.

moptim [28.01.2007 07:14:32]

Lainaa #

8 on älyttömän hieno. :)

qalle [16.09.2017 07:38:24]

Lainaa #

exe
http://qalle.net/putka/harmefek.zip

Kirjoita kommentti

Muista lukea keskustelun ohjeet.
Tietoa sivustosta