Koodit: QB: Tekstuurimappaus

Kirjoitettu: 19.03.2002 – 19.03.2002

Tagit: grafiikka, koodi näytille, vinkki

Tekstuurimappaus ei välttämättä ole kaikkein korrekteinta suomea, mutta kuitenkin sana on tärkeä 3d-pelien ym. teossa. Kuvaa siis venytetään haluttuun muotoon, ja sillä voi päällystää muuten yksivärisiä pintoja. QBasic ei välttämättä ole paras kieli tällaisten pelien tekoon, mutta tässä on kuitenkin yksi yritys.

Ohjelma näyttää ensin kirjaimet Q, B, a, s, i ja c zoomaten ja sitten pyörittää ja zoomaa tekstiä QBasic.

Nopeus riippuu tietenkin koneen nopeudesta, joten nopeasta koneesta ei suuremmin haittaa ole.

Pääohjelma

DECLARE SUB TexMap (kuva() AS INTEGER, paikat AS ANY, l AS INTEGER, k AS INTEGER, moodi AS INTEGER)

'uudet paikat sisältävä tyyppi
TYPE tpaikat
  x1 AS SINGLE
  y1 AS SINGLE
  x2 AS SINGLE
  y2 AS SINGLE
  x3 AS SINGLE
  y3 AS SINGLE
  x4 AS SINGLE
  y4 AS SINGLE
END TYPE

TYPE tkohta
  X AS SINGLE
  Y AS SINGLE
END TYPE

'taulukot kuville
DIM Q(9, 15) AS INTEGER
DIM b(9, 15) AS INTEGER
DIM a(9, 15) AS INTEGER
DIM s(9, 15) AS INTEGER
DIM i(9, 15) AS INTEGER
DIM c(9, 15) AS INTEGER
DIM kuva(60, 25) AS INTEGER

SCREEN 13

COLOR 1: PRINT "Q";
COLOR 2: PRINT "B";
COLOR 3: PRINT "a";
COLOR 4: PRINT "s";
COLOR 5: PRINT "i";
COLOR 6: PRINT "c";


'luetaan kirjaimet
FOR i = 0 TO 7
  FOR j = 0 TO 13
    Q(i + 1, j + 1) = POINT(i, j)
    b(i + 1, j + 1) = POINT(i + 8, j)
    a(i + 1, j + 1) = POINT(i + 16, j)
    s(i + 1, j + 1) = POINT(i + 24, j)
    i(i + 1, j + 1) = POINT(i + 32, j)
    c(i + 1, j + 1) = POINT(i + 40, j)
  NEXT
NEXT
'luetaan koko teksti
FOR i = 0 TO 47
  FOR j = 0 TO 13
    kuva(i + 5, j + 5) = POINT(i, j)
  NEXT
NEXT

DIM paikat AS tpaikat

'kukin kirjain näytetään vuorollaan
FOR h = 1 TO 6
  'aloituspaikat
  paikat.x1 = 160 - 2
  paikat.y1 = 100 - 2
  paikat.x2 = 160 + 2
  paikat.y2 = 100 - 2
  paikat.x3 = 160 - 2
  paikat.y3 = 100 + 2
  paikat.x4 = 160 + 2
  paikat.y4 = 100 + 2
  CLS
  FOR i = 1 TO 35
    'uudet paikat
    paikat.x1 = paikat.x1 - 2
    paikat.x2 = paikat.x2 + 4
    paikat.x3 = paikat.x3 - 2
    paikat.x4 = paikat.x4 + 4
    paikat.y1 = paikat.y1 - 2
    paikat.y2 = paikat.y2 - 2
    paikat.y3 = paikat.y3 + 4
    paikat.y4 = paikat.y4 + 4
    'mikä kirjain?
    SELECT CASE h
    CASE 1
      TexMap Q(), paikat, 8, 15, 2
    CASE 2
      TexMap b(), paikat, 8, 15, 2
    CASE 3
      TexMap a(), paikat, 8, 15, 2
    CASE 4
      TexMap s(), paikat, 8, 15, 2
    CASE 5
      TexMap i(), paikat, 8, 15, 2
    CASE 6
      TexMap c(), paikat, 8, 15, 2
    END SELECT
    'hidaste
    WAIT &H3DA, 8
  NEXT
NEXT
CLS

'koko tekstin pyöritys+zoomaus
pii = 4 * ATN(1)
'aloituskohdat
ak = 0
bk = pii / 2
ck = pii
dk = pii + pii / 2
keskix = 160 - 50 / 2
keskiy = 100 - 15 / 2
koko = 1
FOR i = 0 TO 275
  'pyörittäminen
  ak = ak + .2: IF ak >= 2 * pii THEN ak = 0
  bk = bk + .2: IF bk >= 2 * pii THEN bk = 0
  ck = ck + .2: IF ck >= 2 * pii THEN ck = 0
  dk = dk + .2: IF dk >= 2 * pii THEN dk = 0
  'koon lisäys
  koko = koko + .5
  'uusien paikkojen laskenta
  paikat.x1 = keskix + koko * SIN(ak)
  paikat.y1 = keskiy + koko * COS(ak)
  paikat.x3 = keskix + koko * SIN(bk)
  paikat.y3 = keskiy + koko * COS(bk)
  paikat.x4 = keskix + koko * SIN(ck)
  paikat.y4 = keskiy + koko * COS(ck)
  paikat.x2 = keskix + koko * SIN(dk)
  paikat.y2 = keskiy + koko * COS(dk)
  'piirtäminen
  TexMap kuva(), paikat, 60, 25, 2
NEXT

Aliohjelma TexMap

SUB TexMap (kuva() AS INTEGER, paikat AS tpaikat, l AS INTEGER, k AS INTEGER, moodi AS INTEGER)
  DIM uudet(l + 1, k + 1) AS tkohta

  'uusien x-arvojen laskeminen
  XVK = ((paikat.x3 - paikat.x1) / k)
  XOK = ((paikat.x4 - paikat.x2) / k)
  XV = paikat.x1
  XO = paikat.x2
  FOR i = 1 TO k
    XV = XV + XVK
    XO = XO + XOK
    Askel = ((XO - XV) / l)
    FOR j = 1 TO l
      uudet(j, i).X = XV + j * Askel
    NEXT
  NEXT

  'uusien y-arvojen laskeminen
  YYK = ((paikat.y2 - paikat.y1) / l)
  YAK = ((paikat.y4 - paikat.y3) / l)
  YY = paikat.y1
  YA = paikat.y3
  FOR i = 1 TO l
    YY = YY + YYK
    YA = YA + YAK
    Askel = ((YA - YY) / k)
     FOR j = 1 TO k
      uudet(i, j).Y = YY + j * Askel
    NEXT
  NEXT

  'moodi1=piirto ilman taustaa
  'moodi2=piirto taustan kanssa
  'moodi0=vanhan kuvan pyyhkiminen
  IF moodi = 1 THEN
    FOR i = 1 TO l - 1
      FOR j = 1 TO k - 1
        IF kuva(i, j) <> 0 THEN LINE (uudet(i, j).X, uudet(i, j).Y)-(uudet(i + 1, j + 1).X, uudet(i + 1, j + 1).Y), kuva(i, j), BF
      NEXT
    NEXT
  ELSEIF moodi = 2 THEN
    FOR i = 1 TO l - 1
      FOR j = 1 TO k - 1
        LINE (uudet(i, j).X, uudet(i, j).Y)-(uudet(i + 1, j + 1).X, uudet(i + 1, j + 1).Y), kuva(i, j), BF
      NEXT
    NEXT
  ELSEIF moodi = 0 THEN
    FOR i = 1 TO l - 1
      FOR j = 1 TO k - 1
        LINE (uudet(i, j).X, uudet(i, j).Y)-(uudet(i + 1, j + 1).X, uudet(i + 1, j + 1).Y), 0, BF
      NEXT
    NEXT
  END IF
END SUB