Koodit: QB: Raytracer

TYPE object
 obj AS INTEGER ' type
 x AS SINGLE
 y AS SINGLE
 z AS SINGLE
 radius AS SINGLE ' jos se on pallo
 r AS SINGLE
 g AS SINGLE
 b AS SINGLE
END TYPE

TYPE vector
 x AS SINGLE
 y AS SINGLE
 z AS SINGLE
END TYPE

DIM inv AS SINGLE ' Jokin käänteisluku

Ball = 0
Plane = 1

objects = 4

DIM object(objects) AS object

object(1).obj = Ball
object(1).x = 8
object(1).y = 2
object(1).z = 15
object(1).radius = 6
object(1).r = 1
object(1).g = 1
object(1).b = .5

object(2).obj = Ball
object(2).x = -6
object(2).y = 6
object(2).z = 18
object(2).radius = 7
object(2).r = 1
object(2).g = .5
object(2).b = .5

object(3).obj = Ball
object(3).x = 0
object(3).y = 7
object(3).z = 18
object(3).radius = 4
object(3).r = .7
object(3).g = .7
object(3).b = 1

object(4).obj = Plane
object(4).x = 0
object(4).y = -7
object(4).z = 0
object(4).r = 1
object(4).g = 1
object(4).b = 1

CLS

INPUT "Leveys, korkeus (reso on 320,400): ", w, h
uudestaan:
INPUT "1) 332 paletti 2) Se toinen, värit vierekkäin: ", v
IF NOT (v = 1 OR v = 2) THEN GOTO uudestaan
IF v = 2 THEN h = h / 3

DIM ray AS vector
DIM light AS vector
DIM lightn AS vector
DIM hitpos AS vector

DEF SEG = &HA000

SCREEN 13

OUT &H3D4, 9
OUT &H3D5, &H40

OUT &H3D4, 20
OUT &H3D5, 0

OUT &H3D4, 23
OUT &H3D5, &HE3

OUT &H3C4, 4
OUT &H3C5, &H6

CLS

OUT &H3C4, 2
OUT &H3C5, 1

IF v = 1 THEN
 OUT &H3C8, 0
 FOR r = 0 TO 7
  FOR g = 0 TO 7
   FOR b = 0 TO 3
    OUT &H3C9, r / 7 * 63
    OUT &H3C9, g / 7 * 63
    OUT &H3C9, b / 3 * 63
   NEXT b
  NEXT g
 NEXT r
END IF

IF v = 2 THEN
 OUT &H3C8, 0
 FOR i = 0 TO 63
  OUT &H3C9, i: OUT &H3C9, 0: OUT &H3C9, 0
 NEXT i
 FOR i = 0 TO 63
  OUT &H3C9, 0: OUT &H3C9, i: OUT &H3C9, 0
 NEXT i
 FOR i = 0 TO 63
  OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, i
 NEXT i
END IF

light.x = 50
light.y = 50
light.z = -20

FOR py = 0 TO h - 1
 FOR px = 0 TO w - 1
  ray.x = (px - (w / 2)) / (w / 2)
  ray.y = ((h - py) - (h / 2)) / (h / 2)
  ray.z = .8
  invl = 1 / SQR(ray.x * ray.x + ray.y * ray.y + ray.z * ray.z)
  ray.x = ray.x * invl
  ray.y = ray.y * invl
  ray.z = ray.z * invl

  cx = 0
  cy = 0
  cz = 0
  GOSUB rt

  IF NOT no = -1 THEN
   normal2.x = nx
   normal2.y = ny
   normal2.z = nz

' Törmäyskohta
   hitpos.x = nt * ray.x + cx
   hitpos.y = nt * ray.y + cy
   hitpos.z = nt * ray.z + cz

' Varjossa?
   lightn.x = light.x - hitpos.x
   lightn.y = light.y - hitpos.y
   lightn.z = light.z - hitpos.z
   inv = 1 / SQR(lightn.x * lightn.x + lightn.y * lightn.y + lightn.z * lightn.z)
   lightn.x = lightn.x * inv
   lightn.y = lightn.y * inv
   lightn.z = lightn.z * inv

   ray.x = -lightn.x
   ray.y = -lightn.y
   ray.z = -lightn.z
   cx = light.x
   cy = light.y
   cz = light.z
   noo = no
   GOSUB rt
   valo = 1
   IF NOT no = -1 AND nt < (length - .1) THEN valo = 0 ' Varjo
   no = noo

' Valon määrä pistetulolla eli vektorien välisellä kulmalla
   st = normal2.x * lightn.x + normal2.y * lightn.y + normal2.z * lightn.z
   st = st * valo
   IF st < 0 THEN st = 0
   IF st > 1 THEN st = 1

' Jutskataan väriä
  r = st * object(no).r
  g = st * object(no).g
  b = st * object(no).b

' Valmistellaan pixelin tökkimistä
   OUT &H3C4, 2
   p = px AND 3
   IF p = 0 THEN OUT &H3C5, 1 ' Oikea pagetus
   IF p = 1 THEN OUT &H3C5, 2
   IF p = 2 THEN OUT &H3C5, 4
   IF p = 3 THEN OUT &H3C5, 8

   IF v = 1 THEN POKE py * 80 + px \ 4, INT(r * 7) * 32 + INT(g * 7) * 4 + INT(b * 3)

   IF v = 2 THEN
    POKE (py * 3) * 80 + px \ 4, r * 63
    POKE (py * 3 + 1) * 80 + px \ 4, g * 63 + 64
    POKE (py * 3 + 2) * 80 + px \ 4, b * 63 + 128
   END IF

  END IF
 NEXT px
NEXT py

END

rt:
 nt = 10000
 no = -1
 FOR i = 1 TO objects
  x = cx - object(i).x
  y = cy - object(i).y
  z = cz - object(i).z

  SELECT CASE object(i).obj
   CASE Ball
    radius = object(i).radius
    GOSUB rtBall
   CASE Plane
    GOSUB rtPlane
  END SELECT

  IF t < nt AND t > 0 THEN
   nt = t
   no = i
   nx = normal.x
   ny = normal.y
   nz = normal.z
  END IF
NEXT i
RETURN

rtBall:
 b = (x * ray.x) + (y * ray.y) + (z * ray.z)
 D = (b * b) - ((x * x) + (y * y) + (z * z) - (radius * radius))
 IF D <= 0 THEN t = -1: RETURN
 t = (-b - SQR(D))
 inv = 1 / radius
 normal.x = (ray.x * t + x) * inv
 normal.y = (ray.y * t + y) * inv
 normal.z = (ray.z * t + z) * inv
RETURN

rtPlane:
 IF ray.y = 0 THEN ray.y = .0001
 t = -y / ray.y
 normal.x = 0
 normal.y = 1
 normal.z = 0
RETURN