Sorry your browser is not supported!

set display mode 1024,768,16
sync on
sync rate 0

rem make a neon green ring
cls 0
ink RGB(179,255,22),0

for r=96 to 127
   circle 127,127,r
   circle 128,127,r
next r
get image 1,0,0,256,256,1
sync

rem create a plane and texture it with the ring
make object plain 1,25,25
texture object 1,1

rem transparency
ghost object on 1

rem set ambient to 0
set object ambient 1,0
set object diffuse 1,0

color backdrop 0

cdir=1
do
   rem cycle through the emissive intensity
   inc c,cdir
   if c > 254 or c < 1 then cdir=0-cdir
   set object emissive 1,rgb(c,c,c)
   text 0,0,str$(screen fps())

   sync
loop

Set Display Mode 1024,768,32
sync on: sync rate 60

dim img(30,2)

for n = 1 to 30
    ink rgb(212 + rnd(44),212 + rnd(44),212 + rnd(44)),0
    box 1,1,100,100
    get image n, 1,1,100,100,1
next n

x = 1 : y = 1
for n = 1 to 30
    sprite n, 20 + rnd(980), 20 + rnd(720), n
    set sprite alpha n, 50
    img(n,1) = x : img(n,2) = y
    x = x * -1 : y = y * -1    
next n


backdrop on: Color Backdrop 0

do
    for n = 1 to 30
        sprite n, sprite x(n) + img(n,1), sprite y(n) + img(n,2), n
        if sprite x(n) > 1000 or sprite x(n) < 20 then img(n,1) = img(n,1) * -1
        if sprite y(n) > 740 or sprite y(n) < 20 then img(n,2) = img(n,2) * -1
        if downkey() and sprite alpha(n) > 1 then Set Sprite alpha n, sprite alpha(n) - 1
        if upkey() and sprite alpha(n) < 254 then Set Sprite alpha n, sprite alpha(n) + 1
    next n
    sync

loop

sync on : sync rate 60

rem Set resolution to desktop resolution
set display mode desktop width(), desktop height(), 32, 1

autocam off

rem Link a body with a 3D object
type BodyObjectPair
    BodyId as integer
    ObjectId as integer
endtype

dim BodyObjectPairs() as BodyObjectPair

rem Create the physics world
global world as integer

rem Since 3D units can be any scale we want we'll make them the same as the Box2D units
b2SetScale 1, 180.0/3.1415926535, 1, 1
b2SetScreenTransform screen width()/2, screen height()/2, 20, 1

rem This is a top-down world, so there is effectively no gravity
world = b2CreateWorld(0.0, 0.0, 1)


rem Create an empty static object to attach friction joints to
global ground as integer
ground = b2CreateBody(world, b2BodyType_Static(), 0, 0)

rem Create the car
global car as integer
car = CreateBox(0, 0, 30, 1, 2, 1, 1, b2BodyType_Dynamic(), rgb(0, 255, 0))

position camera 0, -5, -15
rotate camera -30, 0, 0

for i = 0 to 100
    CreateBox(rnd(400)*0.1-20.0, rnd(400)*0.1-20.0, rnd(360), (rnd(10)+1)*0.2, (rnd(10)+1)*0.2, (rnd(3)+1)*0.2, 1, b2BodyType_Dynamic(), rgb(255, 0, 0))
next i

for i = 0 to 10
    CreateBox(rnd(400)*0.1-20.0, rnd(400)*0.1-20.0, rnd(360), (rnd(10)+1)*0.2, (rnd(10)+1)*0.2, (rnd(3)+1)*0.2, 1, b2BodyType_Static(), rgb(0, 255, 255))
next i

set light range 0, 1000
point light 0, 0, 50, 100

rem Main loop
do
    text 0, 0, "FPS: " + str$(screen fps())
    text 0, 40, "Arrow keys to move"
    text 0, 60, "Space to turn sharply"
    text 0, 80, "Enter to show debug info"
    
    rem Control the car
    ControlCar()

    rem Update physics sim
    b2StepWorld world, 1.0/60.0
    
    rem Update 3D objects
    UpdatePairs()
    
    rem Make camera follow car
    position camera b2GetBodyPositionX(car), b2GetBodyPositionY(car)-5, -15

    if returnkey() then b2DrawWorld world, 1
    
    sync
loop

global wheelAngle#

function ControlCar()

    rem Find force of engine
    f# = (upkey()-downkey())*20.0

    rem Find location of front of car in world coordinates
    fx# = b2GetBodyWorldPointX(car, 0, 1)
    fy# = b2GetBodyWorldPointY(car, 0, 1)

    rem Find forward and sideways velocity of car
    vx# = b2GetBodyLocalVectorX(car, b2GetBodyLinearVelocityX(car), b2GetBodyLinearVelocityY(car))
    vy# = b2GetBodyLocalVectorY(car, b2GetBodyLinearVelocityX(car), b2GetBodyLinearVelocityY(car))
    
    rem Find speed of car to use lighter steering at high speeds
    v# = sqrt(vx#*vx#+vy#*vy#)
    
    rem If spacekey is pressed or speed is small, user doesn't want to use light steering
    if spacekey() or v# < 1.0 then v# = 1.0
    
    rem Find angle of wheels, and smooth it over time using curvevalue
    wheelAngle# = curvevalue((leftkey()-rightkey())*100/v#, wheelAngle#, 10)

    rem Find world direction of force to be applied
    fdx# = b2GetBodyWorldVectorX(car, vx#*-4.0, f#)
    fdy# = b2GetBodyWorldVectorY(car, vx#*-4.0, f#)
    
    rem Apply the force
    b2ApplyBodyForce car, fdx#, fdy#, fx#, fy#
    rem Apply torque for steering
    b2ApplyBodyTorque car, (b2GetBodyAngularVelocity(car)-wheelAngle#*vy#)*-0.01
endfunction

rem Update the positions of the 3D objects to match the 2D bodies
function UpdatePairs()
    num = array count(BodyObjectPairs())
    for i = 0 to num
        bodyId = BodyObjectPairs(i).BodyId
        objectId = BodyObjectPairs(i).ObjectId
        
        position object objectId, b2GetBodyPositionX(bodyId), b2GetBodyPositionY(bodyId), object position z(objectId)
        rotate object objectId, 0, 0, b2GetBodyAngle(bodyId)
    next i
endfunction

function CreateBox(x#, y#, angle#, width#, height#, depth#, density#, bodyType, color)
    rem Create the 3D object part
    objectId = FindFreeObject()
    make object box objectId, width#, height#, depth#
    position object objectId, 0, 0, depth#*-0.5
    color object objectId, color

    rem Create the 2D body part
    bodyId = b2CreateBody(world, bodyType, x#, y#, angle#)
    
    rem Add box shape
    shapeId = b2CreatePolygonShapeAsBox(width#, height#)
    fixtureId = b2CreateFixture(bodyId, shapeId, density#, 0.2, 0.4)
    b2DeleteShape shapeId

    if bodyType = b2BodyType_Dynamic()
        rem Simulate air resistance
        b2SetBodyLinearDamping bodyId, 0.3
        b2SetBodyAngularDamping bodyId, 0.05
        
        rem Simulate friction
        joint = b2CreateFrictionJoint(world, ground, bodyId, x#, y#)
        b2SetFrictionJointMaxForce joint, 0.1
        b2SetFrictionJointMaxTorque joint, 0.05
    endif

    array insert at bottom BodyObjectPairs()
    id = array count(BodyObjectPairs())
    BodyObjectPairs(id).BodyId = bodyId
    BodyObjectPairs(id).ObjectId = objectId
endfunction bodyId

rem Search for an unused object ID
function FindFreeObject()
    id = rnd(100)+1
    while object exist(id)
        inc id
    endwhile
endfunction id

sync on : sync rate 60

autocam off

`color backdrop 0
backdrop off

dot 0, 0, rgb(255, 0, 0)
get image 1, 0, 0, 1, 1, 1
dot 0, 0, rgb(0, 255, 0)
get image 2, 0, 0, 1, 1, 1
dot 0, 0, rgb(50, 50, 255)
get image 3, 0, 0, 1, 1, 1
dot 0, 0, rgb(240, 240, 240)
get image 4, 0, 0, 1, 1, 1

make object plain 1, 1, 1
make object plain 2, 1, 1
make object plain 3, 1, 1
make object plain 4, 100, 100

make object cube 5, 1
position object 5, -1, -0.8, 0

texture object 1,1
texture object 2,2
texture object 3,3
texture object 4,4

ghost object on 1
ghost object on 2
ghost object on 3
ghost object on 4, 1

set object light 1, 0
set object light 2, 0
set object light 3, 0
set object light 4, 0

disable object zwrite 1
disable object zwrite 2
disable object zwrite 3
disable object zwrite 4
disable object zread 4

set object transparency 1, 2
set object transparency 2, 2
set object transparency 3, 2
set object transparency 4, 2

color light 0, 100, 100, 100

position camera 0, 0, -3

do
    position object 1, -0.2, 0, 0
    position object 2, 0.2, 0.2, 0
    position object 3, (mousex()-screen width()/2)*0.01, (mousey()-screen height()/2)*-0.01, 0.0
    
    sync
loop