Keskustelu: Koodit: QB: Tippumis efekti

DEFINT A-Z

teksti$ = "www.zacura.tk"
CONST hidastus = .1          'hidastus kerroin kts. ohjelman loppupuolella
CONST ilmavastus = .7        'jarruttava kerroin
CONST varimaa = 2            'maan väri
CONST tekstivari = 15        'tekstin väri
CONST maakorkeus = 160       'maan korkeus

IF LEN(teksti$) >= 40 THEN PRINT "Tekstin pituus pitää olla alle 40 merkkiä": END
SCREEN 13
COLOR 15
PRINT teksti$

tekstiw = 8 * LEN(teksti$)   'merkin koko 8x8 kts. qb:n ohjeet
tekstih = 8

DIM tekstitaulu(tekstiw, tekstih) AS INTEGER      'taulukko tekstille
DIM dummy(tekstiw, tekstih) AS INTEGER            'taulukko tyhjennykselle

GET (0, 0)-(tekstiw, tekstih), tekstitaulu        'teksti taulukkoon

CLS

GET (0, 0)-(tekstiw + 1, tekstih), dummy          'mustaa taulukkoon

LINE (0, maakorkeus)-(320, maakorkeus), varimaa   'piirretään maa
PAINT (0, maakorkeus + 1), varimaa


'vähän muuttujia
liikkuu = 1
keskix = (320 - tekstiw) / 2
y = 0                            'mistä aloitetaan
miny = 0                         'kuinka ylös noustaan
maxy = maakorkeus
dir = 2                          'suunta 1=ylös, 2=alas

DO WHILE liikkuu = 1
 PUT (keskix, CINT(oy)), dummy, PSET         'poistetaan edellinen
 PUT (keskix, CINT(y)), tekstitaulu, PSET    'piirretään uusi

 IF y + tekstih + 1 >= maakorkeus THEN       'jos ollaan maassa
  maxy = ilmavastus * maxy
  miny = maakorkeus - maxy
  dir = 1
 END IF
 IF dir = 1 THEN
  IF CINT(y) <= miny THEN dir = 2            'jos ollaan ylhäällä
  oy = y
  y = y - ((y - miny) / 40) - 1
 ELSE
  oy = y
  y = y + ((y - miny) / 40) + 1
 END IF

 IF (y + tekstih + 1) > maakorkeus THEN y = maakorkeus - tekstih - 1    'tarkistetaan ettei mennä maan alle

 IF miny >= (maakorkeus - tekstih - 1) THEN liikkuu = 0                 'onko pysähtynyt
 SOUND 0, hidastus                                                      'hidastetaan vähän
LOOP