Keskustelu: Koodit: QB: Aaltoilevat kirjaimet -efekti

TYPE kirjain 'tyyppi piirrettäville kirjaimille
  merkki AS STRING * 1
  x AS SINGLE
  y AS SINGLE
  suunta AS SINGLE
END TYPE

DIM taulu(64) AS INTEGER 'käsiteltävän merkin kuvataulukko ja
DIM tyhja(64) AS INTEGER 'tyhjä taulukko vanhan merkin tyhjennykseen

DIM kirjaimet(200) AS kirjain 'taulukko kirjaimille, jos tekstiä on
                              'enemmän, nosta ylärajaa

pii = 4 * ATN(1)
osat = 4 'DATA-rivien määrä
vari = 9 'väri, jolla kirjaimet piirretään
snopeus = .08 'mitä suurempi, sen jyrkemmin kirjainten paikat muuttuvat

'luetaan kirjaimet taulukkoon DATAsta ja
'määritetään niille lähtöarvot
FOR i = 1 TO osat
  READ datat$
  FOR j = 1 TO LEN(datat$)
    kirjaini = kirjaini + 1
    kirjaimet(kirjaini).merkki = MID$(datat$, j, 1)
    kirjaimet(kirjaini).x = 304 + kirjaini * 8
    kirjaimet(kirjaini).y = 160
    kirjaimet(kirjaini).suunta = ABS(kirjaini MOD 2) * pii * 2
  NEXT
NEXT

'määritetään näyttötila ja kirjainten väri
SCREEN 13
COLOR vari

'otetaan tyhjää tyhja-taulukkoon
GET (0, 0)-STEP(8, 8), tyhja

'tulostetaan ensimmäinen merkki
LOCATE 21, 40: PRINT kirjaimet(1).merkki
DO
  FOR i = 1 TO kirjaini
    'jos kirjain on juuri tullut näytölle...
    IF kirjaimet(i).x = 312 THEN
      '...tulostetaan se
      LOCATE 21, 40: PRINT kirjaimet(i).merkki
    END IF

    'jos kirjain on näytön ulkopuolella...
    IF kirjaimet(i).x > 312 THEN
      '...siirretään sitä pikselin verran vasemmalle
      kirjaimet(i).x = kirjaimet(i).x - 1
    'jos kirjain on näytöllä...
    ELSEIF kirjaimet(i).x > 8 THEN
      '...otetaan se muistiin...
      GET (kirjaimet(i).x, kirjaimet(i).y)-STEP(8, 8), taulu
      '...tyhjennetään sen vanha paikka...
      PUT (kirjaimet(i).x - 1, kirjaimet(i).y - 1), tyhja, PSET
      '...lasketaan uusi x ja y...
      kirjaimet(i).x = kirjaimet(i).x - 1
      kirjaimet(i).suunta = kirjaimet(i).suunta + snopeus
      IF kirjaimet(i).suunta > 2 * pii THEN kirjaimet(i).suunta = 0
      kirjaimet(i).y = kirjaimet(i).y + COS(kirjaimet(i).suunta)
      '...ja piirretään kirjain uuteen paikkaansa
      PUT (kirjaimet(i).x, kirjaimet(i).y), taulu, PSET
    END IF
    'jos viimeinen kirjain on mennyt, poistutaan silmukasta
    IF kirjaimet(kirjaini).x = 8 THEN EXIT DO
  NEXT
  'pieni viive
  WAIT &H3DA, 8
LOOP WHILE INKEY$ <> CHR$(27)

'näytettävä teksti, DATA-rivien määrä on ilmoitettava muuttujassa 'osat'
DATA "Tämä efekti näyttää halutun tekstipätkän niin, että "
DATA "kirjaimet kulkevat aaltoillen oikealta vasemmalle "
DATA "näytön alaosassa *** (C) Antti Laaksonen 2002 *** "
DATA "www.ohjelmointiputka.net "
'                             ^viimeisen merkin tulee olla välilyönti