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
            
            IF Resize% EXIT REPEAT
            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 FALSE
        IF VIEW3D THEN
          FOR I% = 4 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% = 4 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