Newton's Cradle (BBC BASIC)

[Deleted User 9295]

This is another, somewhat more straightforward, example of combining 3D graphics with calculations performed by the Box2D physics engine, made easy by the libraries supplied with BBC BASIC for Windows and BBC BASIC for SDL 2.0. If you have a suitable desktop browser (not Safari) you can run the web edition here; press and hold the 1, 2, 4 or 5 keys to lift the relevant ball(s). Try different combinations and see if you can predict what will happen from the laws of conservation of energy and momentum!




https://youtu.be/xE9QNbXDCeA

[Deleted User 9295]

Here's the source code and the other files needed to run it locally:

Code: Select all

      REM. Newton's Cradle - combines Box2D physics engine with 3D rendering.
      REM. v1.0 (C) Richard Russell, http://www.rtrussell.co.uk/, 25-Apr-2021
      REM. 'Kinetic Desk Sculpture 1' by 'chaja' from https://turbosquid.com/
      REM. MODEL MAY NOT BE USED FOR ANOTHER PURPOSE WITHOUT BEING REPURCHASED
      REM. This program is compatible with both BBCSDL & BB4W (plus libraries)

      REM!Embed @lib$+"box2dlib", @lib$+"box2ddbg", @lib$+"ogllib", @lib$+"gleslib", @lib$+"webgllib"
      REM!Embed @dir$+"plinth.fvf", @dir$+"girder.fvf", @dir$+"cradle.fvf", @dir$+"cradle.gif"

      VIEW3D = TRUE
      VDU 23,22,800;600;8,16,16,0
      *TEMPO 1
      SOUND 1,0,0,0

      title$ = "Newton's Cradle - Hold 1, 2, 4, 5 or touch to lift balls; " + \
      \        "PgUp, PgDn and Cursor keys to change viewpoint."

      INSTALL @lib$+"box2dlib" : PROC_b2Init
      IF HIMEM > PAGE + 48000 INSTALL @lib$+"box2ddbg"
      IF INKEY$(-256) = "W" THEN
        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 = -490

      myWorld%% = FN_b2CreateWorld(gravity_x, gravity_y)

      IF HIMEM > PAGE + 48000 PROC_b2DebugInit(myWorld%%, %01011, 20)

      REM Balls:
      DIM ball%%(4), mass%%(4), pivot%%(4), joint%%(4)

      x = 14.0
      FOR i% = 0 TO 4
        ball%%(i%) = FN_b2DynamicBody(myWorld%%, x, 5.0, 0, 0, 0, 0, 0, 0)
        mass%%(i%) = FN_b2CircleFixture(ball%%(i%), 0.0, 0, 1.48, 0.1, 1.0, 1.0)
        pivot%%(i%) = FN_b2StaticBox(myWorld%%, x, 20.0, 0.0, 0.1, 0.1)
        joint%%(i%) = FN_b2RevoluteJoint(myWorld%%, pivot%%(i%), ball%%(i%), x, 20.0, -0.78, +0.78)
        x += 3.0
      NEXT i%

      Auto% = TRUE
      REPEAT
        Resize% = FALSE
        Touch% = 0

        REM. (Re-)initialise 3D system:
        IF VIEW3D THEN
          IF INKEY$(-256) = "W" INSTALL @lib$ + "d3dliba" ELSE INSTALL @lib$ + "ogllib"

          DIM pVB%(6), nv%(6), vf%(6), vl%(6), l%(6), m%(6), Tex%(6), y(6), p(6), r(6)
          DIM X(6), Y(6), Z(6), 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"
          IF INKEY$(-256)="W" SYS !(!pDevice%+200), pDevice%, 29, 1 : REM D3DRS_SPECULARENABLE

          REM. Load 3D objects:
          pVB%(0) = FN_load3d(pDevice%, @dir$+"cradle.fvf", nv%(0), vf%(0), vl%(0))
          IF pVB%(0) = 0 ERROR 101, "Couldn't load 'cradle.fvf'"
          pVB%() = pVB%(0) : nv%() = nv%(0) : vf%() = vf%(0) : vl%() = vl%(0)
          FOR i% = 0 TO 4 : X(i%) = 3.0 * i% - 6.0 : Y(i%) = 20.8 : NEXT
          pVB%(5) = FN_load3d(pDevice%, @dir$+"plinth.fvf", nv%(5), vf%(5), vl%(5))
          IF pVB%(5) = 0 ERROR 101, "Couldn't load 'plinth.fvf'"
          pVB%(6) = FN_load3d(pDevice%, @dir$+"girder.fvf", nv%(6), vf%(6), vl%(6))
          IF pVB%(6) = 0 ERROR 101, "Couldn't load 'girder.fvf'"

          REM. Load texture:
          Tex%(5) = FN_loadtexture(pDevice%, @dir$+"cradle.gif")
          IF Tex%(5) = 0 ERROR 101, "Couldn't load 'cradle.gif'"

          REM. Point-source lights:
          DIM light{(2)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{(0)}.Type% = 1                : REM. point source
          light{(0)}.Diffuse.r% = FN_f4(0.5)  : REM. diffuse colour RGB
          light{(0)}.Diffuse.g% = FN_f4(0.5)
          light{(0)}.Diffuse.b% = FN_f4(0.5)
          light{(0)}.Specular.r% = FN_f4(1.0) : REM. specular colour RGB
          light{(0)}.Specular.g% = FN_f4(1.0)
          light{(0)}.Specular.b% = FN_f4(1.0)
          light{(0)}.Position.x% = FN_f4(100) : REM. position XYZ
          light{(0)}.Position.y% = FN_f4(50)
          light{(0)}.Position.z% = FN_f4(0)
          light{(0)}.Range% = FN_f4(1000)     : REM. range
          light{(0)}.Attenuation0% = FN_f4(1) : REM. attenuation (constant)
          l%(0) = light{(0)} - PAGE + !340

          light{(1)} = light{(0)}
          light{(1)}.Position.x% = FN_f4(100*COS(2*PI/3))
          light{(1)}.Position.z% = FN_f4(100*SIN(2*PI/3))
          l%(1) = light{(1)} - PAGE + !340

          light{(2)} = light{(0)}
          light{(2)}.Position.x% = FN_f4(100*COS(-2*PI/3))
          light{(2)}.Position.z% = FN_f4(100*SIN(-2*PI/3))
          l%(2) = light{(2)} - PAGE + !340

          REM. Materials:
          DIM material{(1)Diffuse{r%,g%,b%,a%}, Ambient{r%,g%,b%,a%}, \
          \     Specular{r%,g%,b%,a%}, Emissive{r%,g%,b%,a%}, Power%}

          REM. Metal:
          material{(0)}.Diffuse.r% = FN_f4(0.0)  : REM. diffuse colour RGB
          material{(0)}.Diffuse.g% = FN_f4(0.0)
          material{(0)}.Diffuse.b% = FN_f4(0.0)
          material{(0)}.Specular.r% = FN_f4(2.0) : REM. specular colour RGB
          material{(0)}.Specular.g% = FN_f4(2.0)
          material{(0)}.Specular.b% = FN_f4(2.2)
          material{(0)}.Power% = FN_f4(20)       : REM. specular 'power'
          m%() = (material{(0)} - PAGE + !340)

          REM. Wood:
          material{(1)} = material{(0)}
          material{(1)}.Diffuse.r% = FN_f4(0.7)  : REM. diffuse colour RGB
          material{(1)}.Diffuse.g% = FN_f4(0.4)
          material{(1)}.Diffuse.b% = FN_f4(0.0)
          material{(1)}.Specular.r% = FN_f4(1.0) : REM. specular colour RGB
          material{(1)}.Specular.g% = FN_f4(0.5)
          material{(1)}.Specular.b% = FN_f4(0.0)
          material{(1)}.Power% = FN_f4(100)      : REM. specular 'power'
          m%(5) = material{(1)} - PAGE + !340

          at() = 0, 10, 0
          distance = 60
          altitude = 0.25
          azimuth = PI
        ENDIF

        velIterations% = 6
        posIterations% = 3

        *REFRESH OFF
        IF INKEY$(-256) = "W" SYS "timeGetTime" TO Ticks% ELSE SYS "SDL_GetTicks" TO Ticks%
        REPEAT

          MOUSE x%,y%,b%  : IF Touch% b% = 0
          lift% = 0
          IF INKEY(-49) OR Touch% AND 1  OR b%<>0 AND x% < 320  OR INKEY(-99) lift% OR= %00001
          IF INKEY(-50) OR Touch% AND 2  OR b%<>0 AND x% >= 320 AND x% < 640  lift% OR= %00011
          IF INKEY(-19) OR Touch% AND 8  OR b%<>0 AND x% >= 960 AND x% < 1280 lift% OR= %11000
          IF INKEY(-20) OR Touch% AND 16 OR b%<>0 AND x% > 1280 OR INKEY(-74) lift% OR= %10000

          IF lift% THEN
            FOR i% = 1 TO 3
              PROC_b2GetBody(ball%%(i%), x, y, a)
              PROC_b2SetBody(ball%%(i%), 14.0 + 3.0*i%, 5.0, 0)
              PROC_b2DestroyJoint(myWorld%%, joint%%(i%))
              lower = -0.01 : upper = +0.06
              IF i% = 1 IF lift% AND %01010 lower = -0.780 : upper = +0.035
              IF i% = 2 IF lift% AND %01010 lower = -0.035 : upper = +0.035
              IF i% = 3 IF lift% AND %01010 lower = -0.035 : upper = +0.780
              joint%%(i%) = FN_b2RevoluteJoint(myWorld%%, pivot%%(i%), ball%%(i%), 14.0 + 3.0*i%, 20.0, lower, upper)
              PROC_b2SetBody(ball%%(i%), x, y, a)
            NEXT
            FOR i% = 0 TO 4
              IF lift% AND (1 << i%) THEN
                PROC_b2RevoluteMotorTorque(joint%%(i%), 90000, 1)
                PROC_b2RevoluteMotorSpeed(joint%%(i%), SGN(i%-2), 1)
              ELSE
                PROC_b2GetBody(ball%%(i%), x, y, a)
                IF ABS(y - 5.0) < 0.1 THEN
                  PROC_b2SetBody(ball%%(i%), 14.0 + 3.0*i%, 5.0, 0)
                  PROC_b2SetVelocity(ball%%(i%), 0, 0, 0)
                ENDIF
              ENDIF
            NEXT
          ELSE
            FOR i% = 0 TO 4
              PROC_b2RevoluteMotorTorque(joint%%(i%), 0, 0)
              PROC_b2RevoluteMotorSpeed(joint%%(i%), 0, 0)
            NEXT
          ENDIF

          IF VIEW3D THEN
            eye(0) = distance * COS(altitude) * SIN(azimuth)
            eye(1) = distance * SIN(altitude) + 10
            eye(2) = distance * COS(altitude) * COS(azimuth)

            FOR i% = 0 TO 4
              PROC_b2GetBody(ball%%(i%), x, y, a)
              r(i%) = ATN((x - 14.0 - 3.0 * i%) / 15)
            NEXT

            PROC_render(pDevice%, &1080FF, 3, l%(), 7, 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 > 500 distance = 500
            ENDCASE
            IF INKEY(-64) distance /= 1.01 : IF distance < 50  distance = 50
            IF INKEY(-79) distance *= 1.01 : IF distance > 500 distance = 500
            IF INKEY(-42) altitude -= 0.01 : IF altitude < 0   altitude = 0
            IF INKEY(-58) altitude += 0.01 : IF altitude > 1.5 altitude = 1.5
            IF INKEY(-26)  azimuth += 0.01 : Auto% = FALSE
            IF INKEY(-122) azimuth -= 0.01 : Auto% = FALSE
            IF Auto% azimuth += 0.003
          ELSE
            CLS
            IF HIMEM > PAGE + 48000 PROC_b2DebugDraw(myWorld%%)
            *REFRESH
          ENDIF

          IF INKEY$(-256) = "W" SYS "timeGetTime" TO T% ELSE SYS "SDL_GetTicks" TO T%
          WHILE Ticks% < T%
            PROC_b2WorldStep(myWorld%%, 0.001, velIterations%, posIterations%)
            contact%% = FN_b2ContactListWorld(myWorld%%)
            WHILE contact%%
              PROC_b2GetContact(contact%%, a%%, b%%, aindex%, bindex%)
              IF FN_b2IsTouching(contact%%) THEN
                PROC_b2GetVelocity(FN_b2GetBody(a%%), x1, y, a1)
                PROC_b2GetVelocity(FN_b2GetBody(b%%), x2, y, a1)
                dv% = ABS(x1 - x2) / 2 : IF dv% > 15 dv% = 15
                IF dv% IF ADVAL(-6) SOUND 1,-dv%,255,1
              ENDIF
              contact%% = FN_b2NextContact(contact%%)
            ENDWHILE
            Ticks% += 1
          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 : L% = 1 << (L% DIV (@size.x% DIV 5))
      IF M% = &700 Touch% OR= L% ELSE IF M% = &701 Touch% AND= NOT L%
      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 HIMEM > PAGE + 48000 PROC_b2DebugExit
      PROC_b2Exit
      ENDPROC

cradle_files.zip

(145.34 KiB) Downloaded 91 times

[nicolagiacobbe]

Thanks Russel. The demo is awesome and it let me think about BBC BASIC as a GUI builder. Do you know of any tool especially designed to write GUIs in BBC BASIC?

[Deleted User 9295]

Do you know of any tool especially designed to write GUIs in BBC BASIC?

What exactly do you mean by GUI? Do you mean the style of interface which uses 'forms' or 'dialogue boxes' for user input (there's an existing tool DLGEDIT.BBC for that, but it's currently rather Windows-specific), or are you meaning graphics in a more general sense?

[nicolagiacobbe]

Yes, I am sorry I was unclear. Usually for GUI I mean a form of interfacing to users by windows containing wisual toolkit whose usage is more or less aknowledged among the general population (i.e. most people knows that a button is for requesting an action or accept/dismiss a prompt and so on) usually in an interactive way.
I was wondering if I could develop such user interfaces in BBC BASIC with the core program being a text-only program under Linux.
There are a few tools for that but they are either too akward for general use of too limited (or both) . Sometimes, when the need for a GUI (in the above sense) arises I resort to Java or WxPython, BBC BASIC would be a welcomed new tool for rapid prototyping.

[Deleted User 9295]

I was wondering if I could develop such user interfaces in BBC BASIC with the core program being a text-only program under Linux.

You could. On a Linux platform it needs the SDL2, SDL2_ttf and SDL2_net libraries to be installed before it will even run (SDL2 is commonly pre-installed on modern Linux distros but not usually the other two) so I don't know whether that is a concern; I expect any GUI tool is going to need similar libraries but it's something to consider.

BBC BASIC for SDL 2.0 comes with libraries for creating dialogue boxes, buttons, textboxes, comboboxes, listboxes, file selectors and so on; they simply leverage standard BBC BASIC graphics statements like DRAW and PLOT to achieve the expected behaviour (such as mouse-over highlighting, focus rectangles etc.). If they don't suit in their existing form they would be easily adaptable by anybody who knows BBC BASIC.

I would suggest you install BBCSDL on your preferred platform and have a play with programs such as dlgdemo.bbc to get a feel for the current GUI libraries and how closely they approach what your need.