§ Иллюстрация

Сфера и плоскость с теневой функцией кохлеарной репагулярности биполярной математики

§ Код

SCREEN 13

TYPE vec3
  x AS SINGLE
  y AS SINGLE
  z AS SINGLE
END TYPE

DIM cam AS vec3, ctr AS vec3, ctn AS vec3
DIM lpt AS vec3, lno AS vec3, ltn AS vec3
DIM nor AS vec3, dir AS vec3
DIM ref AS vec3, pln AS vec3

SetPal

' Directional light
dir.x = 2
dir.y = 2
dir.z = 0
normvec3 dir

' Landscape
pln.y = -4

' Center of sphere
ctr.x = 0
ctr.y = 0
ctr.z = 16

r = 3
speed = 1 / 30

WHILE 1

  ' Light point
  lpt.x = 8 * COS(move * speed)
  lpt.y = 1
  lpt.z = 9

  ' Ball position
  ctr.y = ABS(r * COS(move * speed)) + pln.y + r

  FOR y = 100 TO -99 STEP -1
  FOR x = -160 TO 160

    sx = x + 160
    sy = 100 - y

    ' Init cam vector
    cam.x = x / 200
    cam.y = y / 200
    cam.z = 1

    ' Search sphere intersect
    t = intersec(cam, ctr, r)

    ' Found
    IF t > 0 AND cam.y * t > pln.y THEN

      ' Calculate normal and point of intersect
      mul3vec cam, t        ' cam *= t
      sub3vec nor, cam, ctr ' nor = cam - ctr
      sub3vec lno, lpt, cam ' lno = lpt - cam
      mul3vec cam, -1       ' cam = -cam

      ' Normalize vectors
      normvec3 nor
      normvec3 cam
      normvec3 lno

      ' Reflect camera & normal
      refl = 2 * mul3(cam, nor)
      ref.x = refl * nor.x - cam.x
      ref.y = refl * nor.y - cam.y
      ref.z = refl * nor.z - cam.z
      normvec3 ref

      ' Directional and specular
      ldir = mul3(nor, dir): IF ldir < 0 THEN ldir = 0
      lspe = mul3(ref, lno): IF lspe < 0 THEN lspe = 0 ELSE lspe = lspe ^ 7

      ' Total Light
      lv = ldir * .8 + lspe * .5
      IF lv < 0 THEN lv = 0
      IF lv > 1 THEN lv = 1

      PSET (sx, sy), lv * 63 + 64

    ELSE

      ' Only floor
      IF y < 0 THEN

        IF cam.y = 0 THEN cam.y = 1

        ' Point of intersection of floor
        pln.z = pln.y / cam.y
        pln.x = cam.x * pln.z

        u = INT(pln.x)
        v = INT(pln.z)
        c = ((v + move) XOR (u + 16)) AND 63

        c = 16 * c / pln.z
        IF c > 63 THEN c = 63

        ' Search intersection of ball, light and floor
        sub3vec ctn, ctr, pln
        sub3vec ltn, lpt, pln

        ' --------------------------------------
        ' LTN = LPT (Light Pointer) - Plane(XYZ)
        ' CTN = CTR (Center Sphere) - Plane(XYZ)
        ' --------------------------------------

        t = intersec(ltn, ctn, r)
        IF t > 0 THEN c = c \ 2

        PSET (sx, sy), 64 + c

      ELSE

        PSET (sx, sy), 0

      END IF

    END IF

  NEXT
  NEXT

  ' I like'd moved moved!
  move = move + 1

WEND

FUNCTION intersec (cam AS vec3, ctr AS vec3, r AS SINGLE)

  a = mul3(cam, cam)
  b = -mul3(cam, ctr) * 2
  c = mul3(ctr, ctr) - r ^ 2
  d = b ^ 2 - 4 * a * c
  t = 0

  IF d >= 0 THEN

    d = SQR(d)
    t1 = (-b - d) / (2 * a)
    t2 = (-b + d) / (2 * a)

    IF t1 < 0 AND t2 < 0 THEN t = -1
    IF t1 < 0 AND t2 > 0 THEN t = t2
    IF t1 > 0 AND t2 < 0 THEN t = t1
    IF t1 > 0 AND t2 > 0 THEN
      IF t1 < t2 THEN t = t1 ELSE t = t2
    END IF

  END IF

  intersec = t

END FUNCTION

FUNCTION length (a AS vec3)
  length = SQR(mul3(a, a))
END FUNCTION

FUNCTION mul3 (a AS vec3, b AS vec3)
  mul3 = a.x * b.x + a.y * b.y + a.z * b.z
END FUNCTION

SUB mul3vec (v AS vec3, k AS SINGLE)
  v.x = v.x * k
  v.y = v.y * k
  v.z = v.z * k
END SUB

SUB sub3vec (c AS vec3, a AS vec3, b AS vec3)
  c.x = a.x - b.x
  c.y = a.y - b.y
  c.z = a.z - b.z
END SUB

SUB normvec3 (v AS vec3)
  mul3vec v, 1 / length(v)
END SUB

SUB SetPal
FOR i = 0 TO 63
  OUT 968, i + 64
  OUT 969, i
  OUT 969, i
  OUT 969, i
NEXT
END SUB