Rendering video onto a 3D model

[Richard Russell]

I've created dozens of 3D animations in BBC BASIC, some incorporating the Box2D physics engine and others synthesised music, but none has previously included any moving textures.

Here's a proof-of-principle demonstration of rendering a short video sequence onto the faces of a rotating cube (BBC BASIC for SDL 2.0 only). It could easily be extended to more complex 3D models.

You can run it in your own browser here.

https://www.youtube.com/watch?v=ut2XZHA_4lc

[Ric]

What method of 3d have you used? Is it the BBC basic library, or some other.
Is it possible to see the code?

[Richard Russell]

Is it possible to see the code?

Of course. It's basically just a mash-up of the existing kcpcube.bbc (which renders still images on the faces of the cube) and video.bbc (which renders the video in a regular 2D window using direct calls to the SDL2 API).

The only complication was that video.bbc uses SDL2's built-in UYVY decoding (that's the video format used in the QuickTime movie) but OpenGL doesn't have UYVY decoding - at least not across the full range of supported platforms.

So I've written a quick-and-dirty Fragment Shader to convert the YUV to RGB. It's a bit of a cheat, because it throws away half the luminance samples, reducing the horizontal resolution and risking aliasing. But it's good enough for the demo.

Here's the code, it's nearly all boilerplate copied from other programs.

Code: Select all

      REM Video played on the faces of a cube, BBC BASIC for SDL 2.0, 27-Jul-2025
      REM This plays only QuickTime (.mov) files with uncompressed UYVY encoding.

      REM. Install and initialise libraries:
      INSTALL @lib$+"stringlib"
      INSTALL @lib$+"webgllib"
      INSTALL @lib$+"socklib"
      PROC_initsockets

      VIDEO$ = "http://www.rtrussell.co.uk/skate.mov"
      SAVED$ = @usr$ + "skate.mov"

      REM. Check if local copy already exists:
      F% = OPENIN(SAVED$)

      REM. If not, download or copy to local file:
      IF F% = 0 THEN
        IF LEFT$(VIDEO$, 5) = "http:" THEN
          PRINT "Downloading " VIDEO$ ;
          PROChttpget(VIDEO$, SAVED$)
        ELSE
          PRINT "Copying " VIDEO$ "..." ;
          OSCLI "COPY """ + VIDEO$ + """ """ + SAVED$ + """"
        ENDIF
        PRINT
      ELSE
        CLOSE #F%
      ENDIF
      PROC_exitsockets

      ON CLOSE PROCcleanup : QUIT
      ON ERROR PROCcleanup : MODE 3 : PRINT REPORT$ : END
      ON MOVE IF @msg% <> 5 RETURN ELSE PROCcleanup : CLEAR : REM CLEAR because ON MOVE may interrupt a FN/PROC
      VDU 20,26,12

      REM Definitions must come after CLEAR:
      SAVED$ = @usr$ + "skate.mov"
      XLEN = 720
      YLEN = 576
      ZLEN = 50
      BORDER = 8
      FPS = 24

      REM We could create the cube as a single 3D object but then the six images on
      REM the faces would have to be tiled as a single texture (only one texture is
      REM allowed per object). So instead we create each face as a separate (plane)
      REM object and the six images can then be imported separately as six textures

      DIM object%(5), nvert%(5), vformat%(5), vsize%(5), material%(5), texture%(5)
      DIM pan(5), tilt(5), roll(5), xpos(5), ypos(5), zpos(5)
      DIM light%(0), camera(2), lookat(2), yuv%(YLEN-1+2*BORDER, XLEN/2-1)

      REM We can make our life easier by choosing our object's coordinate system so
      REM 0,0,0 is in the centre of the cube; that way we need create just one face
      REM with the other five faces simply as copies with different orientations

      REM Square face consisting of two triangles i.e. six vertices x, y, z, u, v:
      DATA  1, -1, -1, 1.0, 0.0
      DATA -1, -1, -1, 0.0, 0.0
      DATA -1, -1,  1, 0.0, 1.0
      DATA -1, -1,  1, 0.0, 1.0
      DATA  1, -1,  1, 1.0, 1.0
      DATA  1, -1, -1, 1.0, 0.0

      REM Create the object as a Flexible Vertex Format file:
      F% = OPENOUT(@tmp$+"face.fvf")
      BPUT #F%,6 : BPUT#F%,0 : BPUT #F%,0 : BPUT#F%,0    : REM Vertex count
      BPUT #F%,&42 : BPUT #F%,1 : BPUT#F%,24 : BPUT#F%,0 : REM Vertex format and size
      FOR V% = 0 TO 1
        READ x1, y1, z1, u1, v1, x2, y2, z2, u2, v2, x3, y3, z3, u3, v3
        PROC4(F%,x1) : PROC4(F%,y1) : PROC4(F%,z1)              : REM xyz coordinates
        BPUT #F%,&FF : BPUT #F%,&FF : BPUT#F%,&FF : BPUT#F%,&FF : REM argb diffuse colour
        PROC4(F%,u1) : PROC4(F%,v1)                             : REM texture uv
        PROC4(F%,x2) : PROC4(F%,y2) : PROC4(F%,z2)              : REM xyz coordinates
        BPUT #F%,&FF : BPUT #F%,&FF : BPUT#F%,&FF : BPUT#F%,&FF : REM argb diffuse colour
        PROC4(F%,u2) : PROC4(F%,v2)                             : REM texture uv
        PROC4(F%,x3) : PROC4(F%,y3) : PROC4(F%,z3)              : REM xyz coordinates
        BPUT #F%,&FF : BPUT #F%,&FF : BPUT#F%,&FF : BPUT#F%,&FF : REM argb diffuse colour
        PROC4(F%,u3) : PROC4(F%,v3)                             : REM texture uv
      NEXT
      CLOSE #F%

      REM Initialise 3D library:
      Device% = FN_initgl(@hwnd%, 1, 0)
      IF Device% = 0 ERROR 100, "Couldn't initialise 3D library"
      PROCyuvshader

      REM Open video file:
      F% = OPENIN(SAVED$)
      IF F% = 0 PRINT "Couldn't open video file" : END

      REM. Get function pointers:
      f%% = @hfile%(F%)
      `SDL_RWread` = SYS("SDL_RWread")
      IF `SDL_RWread` = 0 `SDL_RWread` = f%%!8 : IF @platform% AND &40 `SDL_RWread` = ](f%% + 16)

      REM Load the 3D object:
      Object% = FN_load3d(Device%, @tmp$+"face.fvf", nvert%, vformat%, vsize%)
      IF Object% = 0 ERROR 100, "Couldn't load face.fvf"

      REM Create OpenGL texture to hold the video frames:
      SYS `glGenTextures`,1,^GLtex%,@memhdc%
      SYS `glBindTexture`, GL_TEXTURE_2D, GLtex%, @memhdc%
      SYS `glTexParameteri`,GL_TEXTURE_2D,GL_TEXTURE_MAG_FILTER,GL_LINEAR,@memhdc%
      SYS `glTexParameteri`,GL_TEXTURE_2D,GL_TEXTURE_MIN_FILTER,GL_LINEAR,@memhdc%
      SYS `glTexParameteri`,GL_TEXTURE_2D,GL_TEXTURE_WRAP_S,GL_CLAMP_TO_EDGE,@memhdc%
      SYS `glTexParameteri`,GL_TEXTURE_2D,GL_TEXTURE_WRAP_T,GL_CLAMP_TO_EDGE,@memhdc%

      REM Make six identical copies:
      object%()  = Object%
      nvert%()   = nvert%
      vformat%() = vformat%
      vsize%()   = vsize%
      texture%() = GLtex%

      REM Rotate each face (except the first) so that it has the correct orientation:
      tilt(1) = PI/2
      tilt(2) = PI/2
      tilt(3) = PI/2
      tilt(4) = PI/2
      tilt(5) = PI
      pan(2) = PI/2
      pan(3) = PI
      pan(4) = -PI/2

      REM Render the cube:
      lookat() = 0, 0, 0
      nlights% = 0
      bgcolour% = &FF554642
      nobjects% = 6
      viewangle = PI/5
      aspectratio = @vdu%!208/@vdu%!212
      mindist = 1.0
      maxdist = 1000.0
      cameraroll = 0

      REM. Play and loop video:
      S% = XLEN * YLEN * 2
      yuv%() = &00800080
      TIME = 0
      REPEAT
        frame% = (TIME * FPS / 100 + 0.5) MOD ZLEN
        PTR#F% = frame% * S% + &30
        SYS `SDL_RWread`, @hfile%(F%), ^yuv%(BORDER,0), S%, 1
        SYS `glBindTexture`, GL_TEXTURE_2D, GLtex%, @memhdc%
        SYS `glTexImage2D`, GL_TEXTURE_2D, 0, GL_RGBA, XLEN DIV 2, YLEN + 2 * BORDER, \
        \                   0, GL_RGBA, GL_UNSIGNED_BYTE, ^yuv%(0,0), @memhdc%
        SYS `glBindTexture`, GL_TEXTURE_2D, 0, @memhdc%

        camy = 4*COS(TIME/500)
        camera() = SQR(36-camy^2)*COS(TIME/300), camy, -SQR(36-camy^2)*SIN(TIME/300)
        PROC_render(Device%, bgcolour%, nlights%, light%(), nobjects%, material%(), texture%(), \
        \ object%(), nvert%(), vformat%(), vsize%(), pan(), tilt(), roll(), xpos(), ypos(), zpos(), \
        \ camera(), lookat(), viewangle, aspectratio, mindist, maxdist, cameraroll)
      UNTIL INKEY(1)=0
      END

      DEF PROCcleanup
      Object% += 0 : IF Object% PROC_release(Object%) : Object% = 0
      GLtex% += 0  : IF GLtex%  PROC_release(GLtex%)  : GLtex% = 0
      Device% += 0 : IF Device% PROC_release(Device%) : Device% = 0
      *REFRESH ON
      ENDPROC

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

      DEF PROChttpget(url$, file$)
      ON TIME LOCAL PRINT "."; : RETURN
      IF (@platform% AND &F) = 5 PROChttpget_wasm(url$, file$) : ENDPROC
      PROChttpget_sock(url$, file$)
      ENDPROC

      DEF PROChttpget_sock(url$, file$)
      LOCAL b$, F%, I%, J%, S%, host$, path$, ret$
      b$ = STRING$(&1000, CHR$0)
      S% = INSTR(url$,"//")
      I% = INSTR(url$,"/",S%+2)
      host$ = MID$(url$,S%+2,I%-S%-2)
      path$ = MID$(url$,I%)
      S% = FN_tcpconnect(host$, "80")
      IF S% = FALSE OR S% = TRUE THEN ENDPROC
      I% = FN_writelinesocket(S%,"GET "+path$+" HTTP/1.0")
      I% = FN_writelinesocket(S%,"Host: "+host$)
      I% = FN_writelinesocket(S%,"User-agent: BBC BASIC")
      I% = FN_writelinesocket(S%,"Accept: */*")
      I% = FN_writelinesocket(S%,"")
      F% = OPENOUT(file$)
      REPEAT
        I% = FN_readsocket(S%,PTR(b$),&1000)
        IF I% = 0 WAIT 1
        IF I% > 0 ret$ += LEFT$(b$,I%)
        IF I% < 0 OR LENret$ > &3FFF THEN
          IF PTR#F% = 0 THEN
            CASE VALMID$(ret$,9,255) OF
              WHEN 200:
                J% = INSTR(ret$,CHR$&D+CHR$&A+CHR$&D+CHR$&A)
                IF J% ret$ = MID$(ret$,J%+4)
              WHEN 301:
                J% = INSTR(ret$,"Location:")
                IF J% = 0 J% = INSTR(ret$,"location:")
                IF J% CLOSE #F% : PROChttpget("http://"+host$+$(PTR(ret$)+J%+9), file$)
            ENDCASE
          ENDIF
          BPUT#F%,ret$;
          ret$ = ""
        ENDIF
      UNTIL I% < 0
      CLOSE #F%
      PROC_closesocket(S%)
      ENDPROC

      DEF PROChttpget_wasm(url$, file$)
      LOCAL F%
      SYS "emscripten_async_wget", "https://bbcbasic.co.uk/bbcsdl/wasm/proxy/"+url$, file$
      REPEAT
        WAIT 10
        F% = OPENIN(file$)
      UNTIL F%
      CLOSE #F%
      ENDPROC

      DEF PROCyuvshader
      LOCAL fragment$() : DIM fragment$(24)
      RESTORE +1 : PROC_readshader(fragment$())
      SYS `glDeleteShader`,oFragment@webgl%,@memhdc%
      SYS `glCreateShader`,GL_FRAGMENT_SHADER,@memhdc% TO oFragment@webgl%
      PROC_compilewebgl(oFragment@webgl%, fragment$(), "Fragment")
      SYS `glDeleteProgram`,oProgram@webgl%,@memhdc%
      oProgram@webgl% = FN_usewebgl(oVertex@webgl%, oFragment@webgl%)
      SYS `glGetUniformLocation`,oProgram@webgl%,"mViewProjection",@memhdc% TO mViewProj@webgl%
      SYS `glGetUniformLocation`,oProgram@webgl%,"mModel",@memhdc% TO mModel@webgl%
      SYS `glGetUniformLocation`,oProgram@webgl%,"sTexture",@memhdc% TO sTexture@webgl%
      SYS `glGetAttribLocation`,oProgram@webgl%,"vPosition",@memhdc% TO vPosition@webgl%
      SYS `glGetAttribLocation`,oProgram@webgl%,"vTexCoord",@memhdc% TO vTexCoord@webgl%
      SYS `glGetAttribLocation`,oProgram@webgl%,"vColour",@memhdc% TO vColour@webgl%
      SYS `glGetAttribLocation`,oProgram@webgl%,"vNormal",@memhdc% TO vNormal@webgl%
      SYS `glGetUniformLocation`,oProgram@webgl%,"nLights",@memhdc% TO uLights@webgl%
      SYS `glGetUniformLocation`,oProgram@webgl%,"vCamera",@memhdc% TO vCamera@webgl%
      ENDPROC

      REM Fragment Shader (no lighting):
      DATA "varying vec4 fragmentColor;"
      DATA "varying vec2 fragmentUV;"
      DATA "uniform sampler2D sTexture;"
      DATA "void main()"
      DATA "{"
      DATA "if ((fragmentUV.x == 0.0) && (fragmentUV.y == 0.0))"
      DATA "  gl_FragColor=fragmentColor;"
      DATA "else"
      DATA "  {"
      DATA "  vec4 pixel = texture2D(sTexture, fragmentUV);"
      DATA "  float u = pixel.r - 0.5;"
      DATA "  float y = pixel.g;"
      DATA "  float v = pixel.b - 0.5;"
      DATA "  float r = y + 1.402 * v;"
      DATA "  float g = y - 0.344136 * u - 0.714136 * v;"
      DATA "  float b = y + 1.772 * u;"
      DATA "  gl_FragColor = vec4(r, g, b, 1.0);"
      DATA "  }"
      DATA "}"
      DATA ""

[Richard Russell]

Here's a slightly modified version which renders a different video on each face of the cube:

https://youtu.be/HrzSQRU1SzE