BBC BASIC for Windows
Programming >> Graphics and Games >> Direct3D Rotating Globe
http://bb4w.conforums.com/index.cgi?board=graphics&action=display&num=1384006328
Direct3D Rotating Globe
Post by admin on Nov 9th, 2013, 1:12pm

I was requested to do this by the Liberty BASIC folks, so it's only fair to do a BBC BASIC version too (it's much simpler, because it can call upon the D3DLIB library). You will need to download bbcworld.zip which contains the image world.jpg and the data file sphere.b3d used by the program:

User Image

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

      MODE 8
      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, 0)
      IF d% = 0 ERROR 100, "Can't initialise Direct3D"

      b%(0) = FN_load3d(d%, @dir$+"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"

      e() = 0, 0, -9
      a() = 0, 0, 0
      REPEAT
        y() = -TIME/200
        PROC_render(d%, &FF000040, 0, 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

Richard.
Re: Direct3D Rotating Globe
Post by admin on Nov 10th, 2013, 2:44pm

Adding a directional light, and tilting the earth's axis of rotation, gives a more interesting (and accurate) result. To ensure the 'terminator' (transition from light to shadow) is acceptably smooth I have increased the number of triangles from 512 to 2048:

Code:
      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

Richard.