This is something I've been wanting to do for a long time, as a demonstration of what 'modern' BBC BASIC can achieve with relatively little effort (it took me less than three days to write). It's fewer than 300 lines of BBC BASIC code (about 10K) and runs in Windows (both BBC BASIC for Windows and BBC BASIC for SDL 2.0), MacOS, Linux, Raspberry Pi, Android, iOS and in-browser. It uses the Box2D physics engine for the dynamics and OpenGL (WebGL in the browser edition) for the 3D graphics. Can your favourite programming language do that as easily?
https://youtu.be/hh7r7zRAeNw
(credit to David Williams for the video).
3D Pinball (100% BBC BASIC)
Re: 3D Pinball (100% BBC BASIC)
that is fantastic!
Electron (+1, +3, AP5)
Electron (RH +1, Pegasus)
BBC B 1770, boobip, Acorn Speech,Econet)
BBC B+ 128k (Acorn Speech)
Master 512 (ARA III, VideoNuLA, Econet)
PiTubeDirect, RGBtoHDMI, Pi1MHZ
Master Compact (Econet)
Econet: RiscPC 700 / A3020 / A3000
Electron (RH +1, Pegasus)
BBC B 1770, boobip, Acorn Speech,Econet)
BBC B+ 128k (Acorn Speech)
Master 512 (ARA III, VideoNuLA, Econet)
PiTubeDirect, RGBtoHDMI, Pi1MHZ
Master Compact (Econet)
Econet: RiscPC 700 / A3020 / A3000
-
Deleted User 9295
Re: 3D Pinball (100% BBC BASIC)
Here's the entire program. The two 'wrapper' libraries it uses (one for Box2D, the other for 3D graphics) are of course also 100% BBC BASIC code:
Code: Select all
REM. 3D pinball - Demonstrates combining Box2D physics with 3D rendering
REM. v1.1 (C) Richard Russell, http://www.rtrussell.co.uk/, 27-Mar-2021
REM. '3D Low Poly Pinball : Future World' by Bloo3D from turbosquid.com
REM. MODEL MAY NOT BE USED FOR ANOTHER PURPOSE WITHOUT BEING REPURCHASED
VIEW3D = TRUE
VDU 23,22,800;600;8,16,16,128
ENVELOPE 1,1,10,-10,0,3,3,1,126,0,-126,-126,80,0
SOUND 1,0,0,0
title$ = "3D Pinball - Space for plunger, Left and Right Shift for flippers; " + \
\ "PgUp, PgDn and Cursor keys to change viewpoint."
INSTALL @lib$+"box2dlib" : PROC_b2Init
IF INKEY$(-256) = "W" THEN
IF HIMEM > PAGE + 48000 INSTALL @lib$+"box2ddbg"
SYS "SetWindowText", @hwnd%, title$
ELSE
*SYS 2
SYS "SDL_SetWindowTitle", @hwnd%, title$, @memhdc%
ENDIF
ON ERROR PROCcleanup : IF ERR=17 CHAIN @lib$+"../examples/tools/touchide" ELSE ERROR 0,REPORT$
ON CLOSE PROCcleanup : QUIT
ON MOVE IF @msg% <> 5 RETURN ELSE Resize% = TRUE : RETURN
ON MOUSE PROCtouch(@msg%, @lparam%) : RETURN
gravity_x = 0.0
gravity_y = -14
myWorld%% = FN_b2CreateWorld(gravity_x, gravity_y)
IF INKEY$(-256) = "W" IF HIMEM > PAGE + 48000 PROC_b2DebugInit(myWorld%%, %01011, 20)
ground%% = FN_b2StaticBox(myWorld%%, 20.0, 0.4, 0.0, 20.0, 0.1)
REM Static bodies:
gate1%% = FN_b2StaticBox(myWorld%%, 16.3, 29.0, 0.0, 0.2, 0.2)
gate2%% = FN_b2StaticBox(myWorld%%, 23.7, 28.6, 0.0, 0.2, 0.2)
lwall%% = FN_b2BoxFixture(ground%%, -7.5, 7.0, 0, 0.20, 7.0, 0.0, 0, 1.0)
rwall%% = FN_b2BoxFixture(ground%%, +7.2, 11.5, 0, 0.05, 11.5, 0.0, 0, 1.0)
barrier%% = FN_b2BoxFixture(ground%%, +6.1, 7.0, 0, 0.20, 7.0, 0.0, 0, 1.0)
lapron%% = FN_b2BoxFixture(ground%%, -5.0, 5.0, 0.92, 0.05, 3.3, 0.0, 0, 1.0)
rapron%% = FN_b2BoxFixture(ground%%, +3.4, 4.5, -0.92, 0.05, 3.3, 0.0, 0, 1.0)
wire1%% = FN_b2BoxFixture(ground%%, -4.5, 7.0, 0.92, 0.1, 1.4, 0.0, 0, 1.0)
wire2%% = FN_b2BoxFixture(ground%%, +3.4, 7.0, -0.92, 0.1, 1.4, 0.0, 0, 1.0)
wire3%% = FN_b2BoxFixture(ground%%, -5.7, 9.6, 0, 0.1, 1.8, 0.0, 0, 1.0)
wire4%% = FN_b2BoxFixture(ground%%, +4.6, 9.6, 0, 0.1, 1.8, 0.0, 0, 1.0)
peg1%% = FN_b2CircleFixture(ground%%, -1.5, 27.6, 0.2, 0.0, 0, 1.0)
peg2%% = FN_b2CircleFixture(ground%%, 1.5, 27.6, 0.2, 0.0, 0, 1.0)
mushroom1%% = FN_b2CircleFixture(ground%%, -1.4, 23.7, 0.4, 0.0, 1.8, 1.0)
mushroom2%% = FN_b2CircleFixture(ground%%, +2.8, 23.7, 0.4, 0.0, 1.8, 1.0)
mushroom3%% = FN_b2CircleFixture(ground%%, +0.7, 20.6, 0.4, 0.0, 1.8, 1.0)
DIM xc(55), yc(55), bumper%%(10)
REM Bumpers:
FOR b% = 1 TO 10
f% = OPENIN(@dir$ + ".pinball/bumper" + STR$(b%) + ".dat")
IF f% = 0 ERROR 100, "Couldn't load bumper" + STR$(b%) + ".dat"
INPUT #f%, n%
FOR i% = 0 TO n%-1
INPUT #f%, xc(i%), yc(i%)
NEXT
CLOSE #f%
bumper%%(b%) = FN_b2ChainFixture(ground%%, n%, xc(), yc(), 0, -(b% < 3) * 0.9, 1.0, TRUE)
NEXT b%
REM Dynamic bodies:
plunger%% = FN_b2DynamicBody(myWorld%%, 26.7, 3.0, 0, 0, 0, 1.0, 0, 0)
fixture1%% = FN_b2BoxFixture(plunger%%, 0, 0, 0.0, 0.3, 0.6, 1.0, 0.0, 1.0)
slider%% = FN_b2PrismaticJoint(myWorld%%, ground%%, plunger%%, 26.7, 3.0, 0.0, 1.0, -2.0, 0.0)
ball%% = FN_b2DynamicBody(myWorld%%, 26.7, 4.0, 0, 0, 0, 0.1, 0, 0)
fixture2%% = FN_b2CircleFixture(ball%%, 0.0, 0.0, 0.4, 0.0, 0.0, 1.0)
PROC_b2SetBullet(ball%%, TRUE)
xc() = -0.3, +2.3, +2.3, -0.3 : yc() = -0.35, -0.2, +0.2, +0.35
lflipper%% = FN_b2DynamicBody(myWorld%%, 16.8, 6.2, 0, 0, 0, 1.0, 0, 0)
fixture3%% = FN_b2PolygonFixture(lflipper%%, 4, xc(), yc(), 0.0, 0, 1.0)
lpivot%% = FN_b2RevoluteJoint(myWorld%%, ground%%, lflipper%%, 16.8, 6.2, -0.44, 0.44)
rflipper%% = FN_b2DynamicBody(myWorld%%, 22.0, 6.2, PI, 0, 0, 1.0, 0, 0)
fixture4%% = FN_b2PolygonFixture(rflipper%%, 4, xc(), yc(), 0.0, 0, 1.0)
rpivot%% = FN_b2RevoluteJoint(myWorld%%, ground%%, rflipper%%, 22.0, 6.2, -0.44, 0.44)
REPEAT
Resize% = FALSE
Touch% = 0
REM. (Re-)initialise 3D system:
IF VIEW3D THEN
CASE TRUE OF
WHEN INKEY$(-256) = "W": INSTALL @lib$ + "d3dliba"
WHEN (@platform% AND &F) < 3: INSTALL @lib$ + "webgllib"
OTHERWISE: INSTALL @lib$ + "ogllib"
ENDCASE
DIM pVB%(4), nv%(4), vf%(4), vl%(4), l%(4), m%(4), Tex%(4), y(4), p(4), r(4)
DIM X(4), Y(4), Z(4), eye(2), at(2), n(2)
VDU 20,26,12
PRINT "Please wait..."
*REFRESH
REM. Initialise 3D library:
IF INKEY$(-256) = "W" pDevice% = FN_initd3d(@hwnd%, 1, 1) ELSE pDevice% = FN_initgl(@hwnd%, 1, 1)
IF pDevice% = 0 ERROR 100, "Couldn't initialise 3D library"
REM. Load 3D objects:
pVB%(0) = FN_load3d(pDevice%, @dir$+".pinball/pinball.fvf", nv%(0), vf%(0), vl%(0))
IF pVB%(0) = 0 ERROR 101, "Couldn't load 'pinball.fvf'"
pVB%(1) = FN_load3d(pDevice%, @dir$+".pinball/flipper1.fvf", nv%(1), vf%(1), vl%(1))
IF pVB%(1) = 0 ERROR 101, "Couldn't load 'flipper1.fvf'"
pVB%(2) = FN_load3d(pDevice%, @dir$+".pinball/flipper2.fvf", nv%(2), vf%(2), vl%(2))
IF pVB%(2) = 0 ERROR 101, "Couldn't load 'flipper2.fvf'"
pVB%(3) = FN_load3d(pDevice%, @dir$+".pinball/plunger.fvf", nv%(3), vf%(3), vl%(3))
IF pVB%(3) = 0 ERROR 101, "Couldn't load 'plunger.fvf'"
pVB%(4) = FN_load3d(pDevice%, @dir$+".pinball/ball.fvf", nv%(4), vf%(4), vl%(4))
IF pVB%(4) = 0 ERROR 101, "Couldn't load 'ball.fvf'"
REM. Load texture:
Tex%(0) = FN_loadtexture(pDevice%, @dir$+".pinball/pinball.jpg")
Tex%(3) = Tex%(0)
IF Tex%(0) = 0 ERROR 101, "Couldn't load 'pinball.jpg'"
REM. Point-source light:
DIM light{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%}
light.Type% = 1 : REM. point source
light.Diffuse.r% = FN_f4(1.0) : REM. diffuse colour RGB
light.Diffuse.g% = FN_f4(1.0)
light.Diffuse.b% = FN_f4(1.0)
light.Specular.r% = FN_f4(1.0) : REM. specular colour RGB
light.Specular.g% = FN_f4(1.0)
light.Specular.b% = FN_f4(1.0)
light.Ambient.r% = FN_f4(1.0) : REM. ambient colour RGB
light.Ambient.g% = FN_f4(1.0)
light.Ambient.b% = FN_f4(1.0)
light.Position.x% = FN_f4(0) : REM. position XYZ
light.Position.y% = FN_f4(400)
light.Position.z% = FN_f4(200)
light.Range% = FN_f4(1000) : REM. range
light.Attenuation0% = FN_f4(1) : REM. attenuation (constant)
l%(0) = light{} - PAGE + !340
REM. Neutral material:
DIM material{(1)Diffuse{r%,g%,b%,a%}, Ambient{r%,g%,b%,a%}, \
\ Specular{r%,g%,b%,a%}, Emissive{r%,g%,b%,a%}, Power%}
material{(0)}.Diffuse.r% = FN_f4(1.0) : REM. diffuse colour RGB
material{(0)}.Diffuse.g% = FN_f4(1.0)
material{(0)}.Diffuse.b% = FN_f4(1.0)
material{(0)}.Ambient.r% = FN_f4(0.25) : REM. ambient colour RGB
material{(0)}.Ambient.g% = FN_f4(0.25)
material{(0)}.Ambient.b% = FN_f4(0.25)
material{(0)}.Specular.r% = FN_f4(1.0) : REM. specular colour RGB
material{(0)}.Specular.g% = FN_f4(1.0)
material{(0)}.Specular.b% = FN_f4(1.0)
material{(0)}.Power% = FN_f4(100) : REM. specular 'power'
m%() = (material{(0)} - PAGE + !340)
material{(1)} = material{(0)}
material{(1)}.Diffuse.g% = FN_f4(0.0)
material{(1)}.Diffuse.b% = FN_f4(0.0)
m%(1) = (material{(1)} - PAGE + !340)
m%(2) = m%(1)
at() = 0, 100, 8
distance = 220
altitude = ATN(442/342)
azimuth = 0
X(1) = 13.4
X(2) = -8.6
Z(1) = 48.5
Z(2) = 48.5
Y(4) = 110
y() = PI
ENDIF
velIterations% = 6
posIterations% = 3
*REFRESH OFF
IF INKEY$(-256) = "W" SYS "timeGetTime" TO Ticks% ELSE SYS "SDL_GetTicks" TO Ticks%
REPEAT
MOUSE xmouse%,ymouse%,buttons% : IF Touch% buttons% = 0
IF Touch% AND 2 OR buttons% AND 2 OR INKEY(-99) THEN
PROC_b2PrismaticMotorForce(slider%%, 100.0, 1)
PROC_b2PrismaticMotorSpeed(slider%%, -1.0, 1)
PROC_b2SetActive(gate2%%, FALSE)
ELSE
PROC_b2PrismaticMotorForce(slider%%, 350.0, 1)
PROC_b2PrismaticMotorSpeed(slider%%, 200.0, 1)
ENDIF
IF Touch% AND 4 OR buttons% AND 4 OR INKEY(-4) OR INKEY(-98) OR INKEY(-103) THEN
PROC_b2RevoluteMotorTorque(lpivot%%, 500, 1)
PROC_b2RevoluteMotorSpeed(lpivot%%, 200, 1)
ELSE
PROC_b2RevoluteMotorTorque(lpivot%%, 300, 1)
PROC_b2RevoluteMotorSpeed(lpivot%%, -200, 1)
ENDIF
IF Touch% AND 1 OR buttons% AND 1 OR INKEY(-7) OR INKEY(-67) OR INKEY(-104) THEN
PROC_b2RevoluteMotorTorque(rpivot%%, 500, 1)
PROC_b2RevoluteMotorSpeed(rpivot%%, -200, 1)
ELSE
PROC_b2RevoluteMotorTorque(rpivot%%, 300, 1)
PROC_b2RevoluteMotorSpeed(rpivot%%, 200, 1)
ENDIF
PROC_b2GetBody(ball%%, x, y, a)
IF y < 1.0 PROC_b2SetBody(ball%%, 26.7, 4.0, 0) : PROC_b2SetVelocity(ball%%, 0, 0, 0)
IF x < 23 PROC_b2SetActive(gate2%%, TRUE)
IF VIEW3D THEN
X(4) = (20 - x)*4.5
Z(4) = (17 - y)*4.5
PROC_b2GetBody(plunger%%, x, y, a)
Z(3) = (3 - y)*4.5
PROC_b2GetBody(lflipper%%, x, y, a)
y(1) = 2.6-a
PROC_b2GetBody(rflipper%%, x, y, a)
y(2) = PI-2.6-a
eye(0) = distance * COS(altitude) * SIN(azimuth)
eye(1) = distance * SIN(altitude) + 100
eye(2) = distance * COS(altitude) * COS(azimuth)
PROC_render(pDevice%, &7F0000, 1, l%(), 5, m%(), Tex%(), pVB%(), nv%(), vf%(), vl%(), \
\ y(), p(), r(), X(), Y(), Z(), eye(), at(), PI/6, @vdu%!208/@vdu%!212, 20, 2000, 0)
CASE INKEY(0) OF
WHEN 141: distance /= 1.02 : IF distance < 50 distance = 50
WHEN 140: distance *= 1.02 : IF distance > 1000 distance = 1000
ENDCASE
IF INKEY(-64) distance /= 1.01 : IF distance < 50 distance = 50
IF INKEY(-79) distance *= 1.01 : IF distance > 1000 distance = 1000
IF INKEY(-42) altitude -= 0.01 : IF altitude < 0 altitude = 0
IF INKEY(-58) altitude += 0.01 : IF altitude > 1.4 altitude = 1.4
IF INKEY(-26) azimuth += 0.01
IF INKEY(-122) azimuth -= 0.01
ELSE
CLS
IF INKEY(-51) IF INKEY$(-256) = "W" IF HIMEM > PAGE + 48000 PROC_b2DebugDraw(myWorld%%)
GCOL 4,0 : CIRCLE FILL x * 40, y * 40, 16
*REFRESH
ENDIF
IF INKEY$(-256) = "W" SYS "timeGetTime" TO T% ELSE SYS "SDL_GetTicks" TO T%
WHILE Ticks% < T%
PROC_b2WorldStep(myWorld%%, 0.002, velIterations%, posIterations%)
contact%% = FN_b2ContactListWorld(myWorld%%)
WHILE contact%%
PROC_b2GetContact(contact%%, a%%, b%%, aindex%, bindex%)
IF FN_b2IsTouching(contact%%) THEN
IF a%% = mushroom1%% OR b%% = mushroom1%% OR \
\ a%% = mushroom2%% OR b%% = mushroom2%% OR \
\ a%% = mushroom3%% OR b%% = mushroom3%% IF ADVAL(-6) SOUND 1,1,172,4 : EXIT WHILE
IF a%% = bumper%%(1) OR b%% = bumper%%(1) OR \
\ a%% = bumper%%(2) OR b%% = bumper%%(2) IF ADVAL(-6) SOUND 1,1,124,4 : EXIT WHILE
ENDIF
contact%% = FN_b2NextContact(contact%%)
ENDWHILE
Ticks% += 2
ENDWHILE
IF INKEY$(-256) = "W" WAIT 1
UNTIL Resize%
IF VIEW3D THEN
FOR I% = 0 TO DIM(pVB%(),1) PROC_release(pVB%(I%)) : NEXT
PROC_release(pDevice%)
ENDIF
UNTIL FALSE
PROCcleanup
END
DEF PROCtouch(M%, L%)
L% AND= &FFFF
CASE TRUE OF
WHEN L% < @size.x% * 1/3: IF M% = &700 Touch% OR= 4 ELSE IF M% = &701 Touch% AND= NOT 4
WHEN L% > @size.x% * 2/3: IF M% = &700 Touch% OR= 1 ELSE IF M% = &701 Touch% AND= NOT 1
OTHERWISE: IF M% = &700 Touch% OR= 2 ELSE IF M% = &701 Touch% AND= NOT 2
ENDCASE
ENDPROC
DEF PROCcleanup
LOCAL I%
ON ERROR OFF
VDU 23,22,640;500;8,20,16,128
IF !^pVB%() FOR I% = 0 TO DIM(pVB%(),1) PROC_release(pVB%(I%)) : NEXT
pDevice% += 0 : IF pDevice% PROC_release(pDevice%)
*REFRESH ON
myWorld%% += 0 : IF myWorld%% PROC_b2DestroyWorld(myWorld%%) : myWorld%% = 0
IF INKEY$(-256) = "W" IF HIMEM > PAGE + 48000 PROC_b2DebugExit
PROC_b2Exit
ENDPROC
Last edited by Deleted User 9295 on Sat Mar 27, 2021 4:04 pm, edited 1 time in total.
-
Deleted User 9295
Re: 3D Pinball (100% BBC BASIC)
And here it is running on a Raspberry Pi, to show it doesn't need a powerful PC:
https://www.youtube.com/watch?v=ogkYfllq3AA
https://www.youtube.com/watch?v=ogkYfllq3AA
Re: 3D Pinball (100% BBC BASIC)
Hi. I am new to BBC and when I try to run this on BBCSDL it says unable to load bumper1.dat. Would love to see this running but not sure how to proceed. Thanks.
-
Deleted User 9295
Re: 3D Pinball (100% BBC BASIC)
Inevitably, the program relies on several resource files: 3D objects, textures etc. (about 1¾ Mbytes of data in all!). I hope I didn't give the impression that 10 Kbytes of BASIC code is sufficient, on its own, to generate 3D graphics with such enormous detail. That really would be magic.
My intention is to bundle this example with the next releases of BBC BASIC for Windows and BBC BASIC for SDL 2.0, but until then the only way to run the code is in your browser. I linked to the in-browser edition in the top post, here is the link again.
-
Deleted User 9295
Re: 3D Pinball (100% BBC BASIC)
Here are the Box2D Debug Graphics for the pinball table; green indicates the static bodies, pink the dynamic bodies and blue the joints (the flippers use revolute joints and the plunger a prismatic joint):
Re: 3D Pinball (100% BBC BASIC)
Thank you I will check it out and will love to see it in the next release.Richard Russell wrote: ↑Fri Mar 26, 2021 9:58 pmMy intention is to bundle this example with the next releases of BBC BASIC for Windows and BBC BASIC for SDL 2.0, but until then the only way to run the code is in your browser. I linked to the in-browser edition in the top post, here is the link again.
-
Deleted User 9295
Re: 3D Pinball (100% BBC BASIC)
Just an update to say the program is now available with the latest releases of both BBC BASIC for Windows and BBC BASIC for SDL 2.0.
I'd love to see submissions of more programs making use of 3D graphics and the Box2D physics engine (not necessarily in the same program, although that would be nice too). For those who haven't yet tried it, the supplied libraries make this easy,