Keskustelu: Koodit: QB: Säätämistä QBasicilla: Kaeppyraeteksi

DECLARE SUB DrawText (x%, y%, c%, s%, txt$)

CONST PI = 3.141592653589793#   ' kulta-into pii

DIM SHARED fontdata%(128 * 8)   ' 128*16 tavua tilaa, joista puolet turhaa %-)

DEF SEG = &HFFA6

FOR i% = 0 TO 127               ' 128 merkkiä (ts. 7bit ascii)
    FOR j% = 0 TO 7             ' 8 riviä per merkki
        fontdata%(i% * 8 + j%) = CVI(CHR$(0) + CHR$(PEEK(&HE + i% * 8 + j%)))
    NEXT j%
NEXT i%

' nyt on 8x8 fontti bitmappina taulukossa

' setuppia
a% = 0: b% = 1
SCREEN 7, , a%, b%

' naseva teksti
teksti$ = "Hei aeiti, olen inte Njetissae"

' muutama maaginen muuttuja
halfx = LEN(teksti$) / 2
phase = 0
amp = 10
freq = 1
tinc = 1 / LEN(teksti$)

' tilastointia
stime = TIMER
frame& = 0

' luupix
WHILE INKEY$ = ""
    dt = TIMER - stime

    CLS

    IF (dt > 0) THEN LOCATE 1, 1: COLOR 8: PRINT USING "FPS: ###.##"; frame& / dt

    t = 0

    ' hilavitu
    FOR i% = 4 TO 7
        ytemp = 100 + COS(2 * i% * phase / 5) * 2 * amp
        LINE (30, ytemp - 2)-(290, ytemp + 2), i%, BF
    NEXT i%

    ' teksti kaeyraellae
    FOR i% = 0 TO LEN(teksti$) - 1
        x = 160 + (i% - halfx) * 8 * COS(phase / 3)
        y = 100 + SIN(phase + (dt + i% * tinc) * 2 * 3.141592653589793# * freq) * amp
        CALL DrawText(INT(x) - 5, INT(y) - 3, 2, 0, MID$(teksti$, i% + 1, 1))
        CALL DrawText(INT(x) - 4, INT(y) - 4, 10, 0, MID$(teksti$, i% + 1, 1))
    NEXT i%
    phase = phase + PI / 100!
    amp = amp + RND * .5 - RND * .5

    SWAP a%, b%                 '
    SCREEN 7, , a%, b%          ' vaihetaan sivut päixeen
    WAIT (&H3DA), 8             ' smoothii

    frame& = frame& + 1
WEND

'
' parametrit:
'   x%, y%  paikka ruudulla, johon teksti tulostetaan
'   c%      väri
'   s%      kirjainten väli pixeleinä
'   txt$    piirrettävä teksti
'
' optimointimahdollisuus:
'   mikäli pidetään kirjainten väli 0:ssa, voidaan piirtää kaksi
'   kirjainta samaan kerralla (16-bittinen maski)
'
SUB DrawText (x%, y%, c%, s%, txt$)
    tx% = x%
    FOR l% = 1 TO LEN(txt$)
        ch% = ASC(MID$(txt$, l%, 1))
        ' whoa. unrollattu. vaikuttaa iha v*tusti
        LINE (tx%, y% + 0)-(tx% + 7, y% + 0), c%, , fontdata%(ch% * 8 + 0)
        LINE (tx%, y% + 1)-(tx% + 7, y% + 1), c%, , fontdata%(ch% * 8 + 1)
        LINE (tx%, y% + 2)-(tx% + 7, y% + 2), c%, , fontdata%(ch% * 8 + 2)
        LINE (tx%, y% + 3)-(tx% + 7, y% + 3), c%, , fontdata%(ch% * 8 + 3)
        LINE (tx%, y% + 4)-(tx% + 7, y% + 4), c%, , fontdata%(ch% * 8 + 4)
        LINE (tx%, y% + 5)-(tx% + 7, y% + 5), c%, , fontdata%(ch% * 8 + 5)
        LINE (tx%, y% + 6)-(tx% + 7, y% + 6), c%, , fontdata%(ch% * 8 + 6)
        LINE (tx%, y% + 7)-(tx% + 7, y% + 7), c%, , fontdata%(ch% * 8 + 7)
        tx% = tx% + 8 + s%
    NEXT l%
END SUB