Koodit: QB: Neliöpiirtoefekti

TYPE arpa
  x AS INTEGER
  y AS INTEGER
END TYPE

SCREEN 13
COLOR 6

'esimerkkikuva
DIM t(80 * 10)
PRINT "Esimerkki"
GET (0, 0)-(80, 10), t
CLS
LINE (0, 0)-(320, 200), 8, BF
LINE (50, 50)-(270, 150), 1, BF
LINE (50, 50)-(270, 150), 7, B
PUT (60, 60), t
PSET (2, 2)

'näyttö tallennetaan tiedostoon, koska tarvittavan suuren
'taulukon teko ei ollut mahdollista, ja kahdesta erillisestä
'olisi liikaa vaivaa
OPEN "kuva.tmp" FOR BINARY AS #1
FOR i = 1 TO 319
  FOR j = 1 TO 199
    t$ = CHR$(POINT(i, j))
    PUT #1, (i - 1) * 200 + j, t$
  NEXT
NEXT
CLS

'piirtojärjestyksen arpominen: alussa paikat ovat taulukossa järjestyksessä,
'jonka jälkeen ne sekoitetaan
RANDOMIZE TIMER
DIM arv(80 * 2, 50 * 2) AS arpa
FOR i = 1 TO 50 * 2
  FOR j = 1 TO 80 * 2
       arv(j, i).x = j
       arv(j, i).y = i
  NEXT
NEXT
'mitä suurempi luku on 8:n tilalla, sen perusteellisemmin
'näyttö sekoitetaan
FOR i = 1 TO 50 * 80 * 8
  SWAP arv(INT(RND * 80 * 2) + 1, INT(RND * 50 * 2) + 1), arv(INT(RND * 80 * 2) + 1, INT(RND * 50 * 2) + 1)
NEXT

'näytön uudelleenpiirtäminen
DEF SEG = &HA000
FOR k = 1 TO 200 STEP 2
  FOR h = 1 TO 319 STEP 2
    ix = arv(h \ 2 + 1, k \ 2 + 1).x * 2 - 1
    iy = arv(h \ 2 + 1, k \ 2 + 1).y * 2 - 1
    GOSUB piirrapiste
    'tähän voi laittaa sopivan hidastesilmukan
  NEXT
NEXT
DEF SEG

CLOSE #1

END

'yksittäisen pisteen (2x2) piirtävä aliohjelma
piirrapiste:
  FOR j = ix TO ix + 1
    FOR i = iy TO iy + 1
      GET #1, (j - 1) * 200 + i, t$
      'seuraava tekee saman kuin PSET (j, i), ASC(t$)
      'mutta on nopeampi
      POKE j + (i * 320), ASC(t$)
    NEXT
  NEXT
RETURN