Koodit: QB: Harmaasävyisiä efektejä

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