REM. Direct3D Rotating Globe in BBC BASIC for Windows
      REM (C) R.T.Russell 2013, http://www.rtrussell.co.uk/

      MODE 8 : OFF
      DIM l%(0), b%(0), n%(0), f%(0), s%(0), m%(0), t%(0), y(0), p(0), r(0), X(0), Y(0), Z(0), e(2), a(2)

      INSTALL @lib$+"D3DLIB"

      ON CLOSE PROCcleanup:QUIT
      ON ERROR PROCcleanup:PRINT REPORT$:END

      d% = FN_initd3d(@hwnd%, 1, 1)
      IF d% = 0 ERROR 100, "Can't initialise Direct3D"

      file% = OPENOUT(@tmp$+"SPHERE.B3D")
      PROC4(file%, 6144) : REM vertex count
      PROC4(file%, &00240152) : REM vertex format and size
      PROCtriangulate(5, file%,  1,  0,  0,   0,  0,  1,   0,  1,  0)
      PROCtriangulate(5, file%,  0,  1,  0,   0,  0,  1,  -1,  0,  0)
      PROCtriangulate(5, file%, -1,  0,  0,   0,  0,  1,   0, -1,  0)
      PROCtriangulate(5, file%,  0, -1,  0,   0,  0,  1,   1,  0,  0)
      PROCtriangulate(5, file%,  1,  0,  0,   0,  1,  0,   0,  0, -1)
      PROCtriangulate(5, file%,  0,  1,  0,  -1,  0,  0,   0,  0, -1)
      PROCtriangulate(5, file%, -1,  0,  0,   0, -1,  0,   0,  0, -1)
      PROCtriangulate(5, file%,  0, -1,  0,   1,  0,  0,   0,  0, -1)
      CLOSE #file%

      b%(0) = FN_load3d(d%, @tmp$+"SPHERE.B3D", n%(0), f%(0), s%(0))
      IF b%(0) = 0 ERROR 100, "Can't load SPHERE.B3D"

      t%(0) = FN_loadtexture(d%, @dir$+"WORLD.JPG")
      IF t%(0) = 0 ERROR 100, "Can't load WORLD.JPG"

      DIM D3Dlight8{Type%, Diffuse{r%,g%,b%,a%}, Specular{r%,g%,b%,a%}, \
      \ Ambient{r%,g%,b%,a%}, Position{x%,y%,z%}, Direction{x%,y%,z%}, \
      \ Range%, Falloff%, Attenuation0%, Attenuation1%, Attenuation2%, \
      \ Theta%, Phi% }
      D3Dlight8.Type% = 1 : REM point source
      D3Dlight8.Diffuse.r% = FN_f4(1)
      D3Dlight8.Diffuse.g% = FN_f4(1)
      D3Dlight8.Diffuse.b% = FN_f4(1)
      D3Dlight8.Position.x% = FN_f4(-20)
      D3Dlight8.Position.z% = FN_f4(-20)
      D3Dlight8.Range% = FN_f4(200)
      D3Dlight8.Attenuation0% = FN_f4(0.2)
      l%(0) = D3Dlight8{}

      e() = 0, 0, -9
      a() = 0, 0, 0
      REPEAT
        y() = -TIME/200
        r() = -0.4 * COS(y(0))
        p() = 0.4 * SIN(y(0))
        PROC_render(d%, &00000030, 1, l%(), 1, m%(), t%(), b%(), n%(), f%(), s%(), y(), p(), r(), X(), Y(), Z(), e(), a(), 0.4, 5/4, 1, 1000)
      UNTIL INKEY(1)=0
      END

      DEF PROCcleanup
      b%(0) += 0:IF b%(0) PROC_release(b%(0))
      d% += 0   :IF d%    PROC_release(d%)
      ENDPROC

      DEF PROCtriangulate(L%, F%, x0, y0, z0, x1, y1, z1, x2, y2, z2)
      L% -= 1
      IF L% THEN
        LOCAL a(), b(), c() : DIM a(2), b(2), c(2)
        a(0) = x0 + x2 : a(1) = y0 + y2 : a(2) = z0 + z2 : a() /= MOD(a())
        b(0) = x0 + x1 : b(1) = y0 + y1 : b(2) = z0 + z1 : b() /= MOD(b())
        c(0) = x1 + x2 : c(1) = y1 + y2 : c(2) = z1 + z2 : c() /= MOD(c())
        PROCtriangulate(L%, F%, x0, y0, z0, b(0), b(1), b(2), a(0), a(1), a(2))
        PROCtriangulate(L%, F%, b(0), b(1), b(2), x1, y1, z1, c(0), c(1), c(2))
        PROCtriangulate(L%, F%, a(0), a(1), a(2), b(0), b(1), b(2), c(0), c(1), c(2))
        PROCtriangulate(L%, F%, a(0), a(1), a(2), c(0), c(1), c(2), x2, y2, z2)
      ELSE
        LOCAL u0, u1, u2, v0, v1, v2
        PROCvertex(x0, y0, z0, u0, v0)
        PROCvertex(x1, y1, z1, u1, v1)
        PROCvertex(x2, y2, z2, u2, v2)
        IF (u1 - u0) > 0.5 u0 += 1.0
        IF (u0 - u1) > 0.5 u1 += 1.0
        IF (u2 - u1) > 0.5 u1 += 1.0
        IF (u1 - u2) > 0.5 u2 += 1.0
        IF (u0 - u2) > 0.5 u2 += 1.0
        IF (u2 - u0) > 0.5 u0 += 1.0
        PROC4(F%, FN_f4(-x0)) : PROC4(F%, FN_f4(z0)) : PROC4(F%, FN_f4(y0))
        PROC4(F%, FN_f4(-x0)) : PROC4(F%, FN_f4(z0)) : PROC4(F%, FN_f4(y0))
        PROC4(F%, &FFFFFF)    : PROC4(F%, FN_f4(u0)) : PROC4(F%, FN_f4(v0))
        PROC4(F%, FN_f4(-x1)) : PROC4(F%, FN_f4(z1)) : PROC4(F%, FN_f4(y1))
        PROC4(F%, FN_f4(-x1)) : PROC4(F%, FN_f4(z1)) : PROC4(F%, FN_f4(y1))
        PROC4(F%, &FFFFFF)    : PROC4(F%, FN_f4(u1)) : PROC4(F%, FN_f4(v1))
        PROC4(F%, FN_f4(-x2)) : PROC4(F%, FN_f4(z2)) : PROC4(F%, FN_f4(y2))
        PROC4(F%, FN_f4(-x2)) : PROC4(F%, FN_f4(z2)) : PROC4(F%, FN_f4(y2))
        PROC4(F%, &FFFFFF)    : PROC4(F%, FN_f4(u2)) : PROC4(F%, FN_f4(v2))
      ENDIF
      ENDPROC

      DEF PROCvertex(x, y, z, RETURN u, RETURN v)
      u = FNatan2(x, y) / PI / 2 + 0.5
      v = FNatan2(z, SQR(x^2 + y^2)) / PI + 0.5
      IF u < 0 OR v < 0 OR u > 1 OR v > 1 STOP
      ENDPROC

      DEF FNatan2(y,x) : ON ERROR LOCAL = SGN(y)*PI/2
      IF x>0 THEN = ATN(y/x) ELSE IF y>0 THEN = ATN(y/x)+PI ELSE = ATN(y/x)-PI

      DEF PROC4(F%, A%)
      BPUT#F%,A% : BPUT#F%,A%>>8 : BPUT#F%,A%>>16 : BPUT#F%,A%>>24
      ENDPROC