07-08-2022, 09:50 PM
I can't get this compiled with QB64. Too many errors and too complicated for me. 
The Pyramide with BBC-Basic.
The Pyramide with BBC-Basic.
Code: (Select All)
' Program to demonstrate the use of 3D graphics
' INSTALL @lib$+"d3dliba"
INSTALL "d3dliba.BBC"
DIM b%(1), t%(1)
ON CLOSE PROCcleanup : QUIT
ON ERROR PROCcleanup : MODE 3 : PRINT REPORT$ : END
ON MOVE IF @msg% <> 5 RETURN ELSE PROCcleanup : CLEAR
VDU 20,26,12
DIM l%(0), b%(1), n%(1), f%(1), s%(1), m%(1), t%(1), y(1), p(1), r(1), X(1), Y(1), Z(1), e(2), a(2)
*REFRESH OFF
d% = FN_initd3d(@hwnd%, 1, 0)
IF d% = 0 ERROR 100, "Can't initialise 3D library"
' Create top four triangular faces, coloured:
F% = OPENOUT(@tmp$+"pyramid.fvf")
BPUT #F%,12 : BPUT#F%,0 : BPUT #F%,0 : BPUT#F%,0 : REM Vertex count
BPUT #F%,&42 : BPUT #F%,0 : BPUT#F%,16 : BPUT#F%,0 : REM Vertex format and size
FOR V% = 0 TO 3
READ x1, y1, z1, x2, y2, z2, x3, y3, z3, r&, g&, b&
PROC4(F%,x1) : PROC4(F%,y1) : PROC4(F%,z1) : REM xyz coordinates
BPUT #F%,b& : BPUT #F%,g& : BPUT#F%,r& : BPUT#F%,&FF : REM argb diffuse colour
PROC4(F%,x2) : PROC4(F%,y2) : PROC4(F%,z2) : REM xyz coordinates
BPUT #F%,b& : BPUT #F%,g& : BPUT#F%,r& : BPUT#F%,&FF : REM argb diffuse colour
PROC4(F%,x3) : PROC4(F%,y3) : PROC4(F%,z3) : REM xyz coordinates
BPUT #F%,b& : BPUT #F%,g& : BPUT#F%,r& : BPUT#F%,&FF : REM argb diffuse colour
NEXT
CLOSE #F%
' Create base consisting of two triangles with texture coordinates:
F% = OPENOUT(@tmp$+"base.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%
' Load 3D objects:
b%(0) = FN_load3d(d%, @tmp$+"pyramid.fvf", n%(0), f%(0), s%(0))
IF b%(0) = 0 ERROR 100, "Can't load pyramid.fvf"
b%(1) = FN_load3d(d%, @tmp$+"base.fvf", n%(1), f%(1), s%(1))
IF b%(1) = 0 ERROR 100, "Can't load base.fvf"
t%(1) = FN_loadtexture(d%, @dir$+"clock.jpg")
IF t%(1) = 0 ERROR 100, "Can't load clock.jpg"
e() = 0, 0, -6
a() = 0, 0, 0
REPEAT
p() = TIME/100
r() = TIME/40
X() = SIN(TIME/200)
PROC_render(d%, &FF7F7F7F, 0, l%(), 2, m%(), t%(), b%(), n%(), f%(), s%(), \
\ y(), p(), r(), X(), Y(), Z(), e(), a(), PI/4, @vdu%!208/@vdu%!212, 1, 1000, 0)
UNTIL INKEY(1)=0
END
DEF PROCcleanup
t%(1) += 0:IF t%(1) PROC_release(t%(1)) : t%(1) = 0
b%(0) += 0:IF b%(0) PROC_release(b%(0)) : b%(0) = 0
b%(1) += 0:IF b%(1) PROC_release(b%(1)) : b%(1) = 0
d% += 0 :IF d% PROC_release(d%) : d% = 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
' Pyramid top (4 triangles) each x1, y1, z1, x2, y2, z2, x3, y3, z3, r, g, b:
DATA -1, -1, 1, -1, -1, -1, 0, .414, 0, &00, &00, &FF
DATA 1, -1, 1, -1, -1, 1, 0, .414, 0, &00, &FF, &00
DATA 1, -1, -1, 1, -1, 1, 0, .414, 0, &FF, &00, &00
DATA -1, -1, -1, 1, -1, -1, 0, .414, 0, &FF, &FF, &00
' Pyramid base (2 triangles) each three vertices x, y, z, u, v:
DATA 1, -1, -1, 1.0, 1.0, -1, -1, -1, 0.0, 1.0, -1, -1, 1, 0.0, 0.0
DATA -1, -1, 1, 0.0, 0.0, 1, -1, 1, 1.0, 0.0, 1, -1, -1, 1.0, 1.0