rolling wheel

[BasicCoder2]

After looking at dodicat's demo,
viewtopic.php?f=7&t=26641
I wondered if I could do something like that with code I found easier to follow. I decided I would have to do it in stages starting with a single wheel.
The wheel will move back and forth.
Tap space bar to change the slope.
The wheel has to move so that it does not slip or slide.
With an undulating surface the slope would have to continually be recomputed for each position something I haven't implemented in this example.
The testCircle checks to see if pixels around the circle contact collision pixels in the bitmap layer3 where rgb(255,0,255) is a non contact pixel value. It is only used to determine the start my value. An alternative to this would be to have an array of values holding the height of the surface at each point along the x axis.
I imagined two scenarios.
1.DETERMINE ROTATION RATE (rotAngle) GIVEN DISTANCE (dd) PER UNIT OF TIME
2.DETERMINE DISTANCE (dd) PER UNIT OF TIME GIVEN ROTATION RATE (rotAngle)
The speed will be determined by the radius of the wheel r , the rotation rate (rotAngle) or distance (dd) and the sleep command.

There is no 2D physics being implemented here only some trig. In fact old retro games had their own "physics" designed for game play rather than an accurate simulation.

Code: Select all

'======== scans circle at xx,yy with radius r for any color except magenta rgb(255,0,255)
function testCircle(layer as any ptr, xx As Integer, yy As Integer, r as integer) as boolean
    dim as integer x0,y0,x1,y1
    dim as ulong c  'clear color
    c = rgb(255,0,255)  'magenta
    dim as boolean HIT
    HIT = FALSE
    x0 = xx - R
    x1 = xx + R
    y0 = yy - R
    y1 = yy + R
    If x0>x1 Then Swap x0,x1
    If y0>y1 Then Swap y0,y1
    Dim As Integer x,y,a2,b2, S, T,xb,yb,b
    b=(y1-y0)/2
    b2=b*b
    a2=(x1-x0)^2/4
    xb=(x0+x1)/2
    yb=(y0+y1)/2

    x = 0
    y = b
    S = a2*(1-2*b) + 2*b2
    T = b2 - 2*a2*(2*b-1)

    if point ((xb+x),(yb+y),layer) <> c then HIT = TRUE
    if point ((xb+x),(yb-y),layer) <> c then HIT = TRUE
    if point ((xb-x),(yb+y),layer) <> c then HIT = TRUE
    if point ((xb-x),(yb-y),layer) <> c then HIT = TRUE
    

    Do 
        If S<0 Then
    
            S += 2*b2*(2*x+3)
            T += 4*b2*(x+1)
            x+=1
        Elseif T<0 Then
            S += 2*b2*(2*x+3) - 4*a2*(y-1)
            T += 4*b2*(x+1) - 2*a2*(2*y-3)
            x+=1
            y-=1
        Else 
            S -= 4*a2*(y-1)
            T -= 2*a2*(2*y-3)
            y-=1
        End If
        
        if point ((xb+x),(yb+y),layer) <> c then HIT = TRUE
        if point ((xb+x),(yb-y),layer) <> c then HIT = TRUE
        if point ((xb-x),(yb+y),layer) <> c then HIT = TRUE
        if point ((xb-x),(yb-y),layer) <> c then HIT = TRUE
        
    Loop While y>0
    
    return HIT

End function

'some useful defines
Const Pi = 4 * Atn(1)
Dim Shared As single TwoPi = 8 * Atn(1)
Dim Shared As single RtoD = 180 / Pi   ' radians * RtoD = degrees
Dim Shared As single DtoR = Pi / 180   ' degrees * DtoR = radians

const SCRW = 800
const SCRH = 600

screenres SCRW,SCRH,32
color rgb(0,0,0),rgb(255,255,255):cls

dim shared as single y1,y2  'to generate random slopes
dim shared as single slope
dim shared as single dd

'======================================================================
' This is the pixel collision layer. Any color except rgb(255,0,255)
' is treated as a collision or overlap.
dim shared as any ptr layer3  'COLLISION LAYER
layer3 = imagecreate(SCRW,SCRH,rgb(255,0,255))

sub trialSlope()
    y1 = int(rnd(1)*SCRH-100)+200
    y2 = SCRH - 1 - y1
    line layer3,(0,0)-(SCRW-1,SCRH-1),rgb(255,0,255),bf  'clear
    line layer3,(0,y1)-(SCRW-1,y2),rgb(0,255,0)
    paint layer3,(SCRW-1,SCRH-1),rgb(0,255,0),rgb(0,255,0)
end sub


'=====================================================================

type WHEEL
    as single mx              'position on diplay screen (absolute space)
    as single my
    as single r               'radius of wheel
    as single rotAngle        'current rotated angle in degrees
    as single rotRate         'degree of rotation per unit of time
    as single px(0 to 10)     'absolute positions of 10 wheel spokes
    as single py(0 to 10)
    as single rx(0 to 10)     'relative positions of spokes around mx,my
    as single ry(0 to 10)
end type

dim shared as WHEEL w1


dd = 8 'move 8 pixels per unit of time

w1.r = 60
'w1.mx = w1.r     'start on left
'w1.my = w1.r + 2    'start high
w1.rotRate = 9   'rotate 9 degrees per unit of time

'=====      create end of spokes coord values     ==================
dim as integer count
dim as single dx,dy
count = 0
for i as integer = 0 to 360 step 36
    dx = cos(i * DtoR) * w1.r
    dy = sin(i * DtoR) * w1.r
    w1.px(count) = dx
    w1.py(count) = dy
    count = count + 1
next i

'===================================================================
sub rotatePoints(w as WHEEL)
    w.rotAngle = w.rotAngle + w.rotRate
    if w.rotAngle >= 360 then w.rotAngle = w.rotAngle - 360
    if w.rotAngle < 0    then w.rotAngle = w.rotAngle + 360
    dim as single ww,tx,ty
    ww = w.rotAngle * DtoR
    for i as integer = 0 to 9
        tx = Cos(ww) * w.px(i) - Sin(ww) * w.py(i)
        ty = Cos(ww) * w.py(i) + Sin(ww) * w.px(i)   
        w.rx(i) = tx + w.mx
        w.ry(i) = ty + w.my
    next i
end sub

sub drawWheel(w as WHEEL)
    rotatePoints(w)
    for i as integer = 0 to 9
        circle (w.rx(i),w.ry(i)),3,rgb(0,0,0)
        if point(w.rx(i),w.ry(i),layer3) = rgb(0,255,0) then
            circle layer3,(w.rx(i),w.ry(i)),3,rgb(255,0,0)
        end if
        line (w.mx,w.my)-(w.rx(i),w.ry(i)),rgb(100,100,200)
        circle (w.mx,w.my),w.r,rgb(200,200,200)
    next i
end sub

sub update()
    screenlock
    cls
    put (0,0),layer3,trans
    drawWheel(w1)
    locate 2,2
    print "SLOPE =";slope
    print
    print " TAP SPACE BAR FOR ANOTHER SLOPE"
    screenunlock
end sub

dim as string key

slope = 0


dd = 9.424778  'used when the distance to travel is known and the rotAngle has to be computed


trialSlope()
slope = atan2(y2-y1,SCRW)*RtoD
if slope < 0 then slope = slope +360
w1.mx = w1.r     'start on left
w1.my = w1.r + 2    'start high
'now drop wheel down until hits green surface
while testCircle(layer3, w1.mx, w1.my, w1.r ) = FALSE
    w1.my = w1.my + 1
wend

do
    
    key = inkey
    if key = " " then
        w1.mx = w1.r     'start on left
        w1.my = w1.r     'start high
        
        trialSlope()
        slope = atan2(y2-y1,SCRW)*RtoD
        if slope < 0 then slope = slope +360
        
        while testCircle(layer3, w1.mx, w1.my, w1.r ) = FALSE
            w1.my = w1.my + 1
        wend
    end if
    
    update()  

    
    'DETERMINE ROTATION RATE GIVEN DISTANCE PER UNIT OF TIME
    'w1.rotRate = dd/(2*Pi*w1.r)*360
    'if w1.mx < w1.r or w1.mx > SCRW - 1 - w1.r then
    '    dd = -dd
    'end if
    
    'DETERMINE DISTANCE PER UNIT OF TIME GIVEN ROTATION RATE
    if w1.mx < w1.r or w1.mx > SCRW - 1 - w1.r then
        w1.rotRate = -w1.rotRate
    end if
    dd = ((2*Pi*w1.r)/360 * w1.rotRate)


    dy = sin(slope*DtoR)*dd
    dx = cos(slope*DtoR)*dd

    w1.mx = w1.mx + dx
    w1.my = w1.my + dy
    
    sleep 100
loop until multikey(&H01)

[paul doe]

Nice, also contains useful maths. Good work.

[BasicCoder2]

@paul doe,
Thanks for the encouragement particularly as I would have imagined your preference would be for using a 2D game engine. I did start off with some buggy demos but the wheels did not rotate to match their movement over the surface as in the dodicat demo.

Code: Select all

'some useful defines
Const Pi = 4 * Atn(1)
Dim Shared As Double TwoPi = 8 * Atn(1)
Dim Shared As Double RtoD = 180 / Pi   ' radians * RtoD = degrees
Dim Shared As Double DtoR = Pi / 180   ' degrees * DtoR = radians

'======== scans circle at xx,yy with radius r for any color except magenta rgb(255,0,255)
function testCircle(layer as any ptr, xx As Integer, yy As Integer, r as integer) as boolean
    dim as integer x0,y0,x1,y1
    dim as ulong c  'clear color
    c = rgb(255,0,255)  'magenta
    dim as boolean HIT
    HIT = FALSE
    x0 = xx - R
    x1 = xx + R
    y0 = yy - R
    y1 = yy + R
    If x0>x1 Then Swap x0,x1
    If y0>y1 Then Swap y0,y1
    Dim As Integer x,y,a2,b2, S, T,xb,yb,b
    b=(y1-y0)/2
    b2=b*b
    a2=(x1-x0)^2/4
    xb=(x0+x1)/2
    yb=(y0+y1)/2

    x = 0
    y = b
    S = a2*(1-2*b) + 2*b2
    T = b2 - 2*a2*(2*b-1)

    if point ((xb+x),(yb+y),layer) <> c then HIT = TRUE
    if point ((xb+x),(yb-y),layer) <> c then HIT = TRUE
    if point ((xb-x),(yb+y),layer) <> c then HIT = TRUE
    if point ((xb-x),(yb-y),layer) <> c then HIT = TRUE
    

    Do 
        If S<0 Then
    
            S += 2*b2*(2*x+3)
            T += 4*b2*(x+1)
            x+=1
        Elseif T<0 Then
            S += 2*b2*(2*x+3) - 4*a2*(y-1)
            T += 4*b2*(x+1) - 2*a2*(2*y-3)
            x+=1
            y-=1
        Else 
            S -= 4*a2*(y-1)
            T -= 2*a2*(2*y-3)
            y-=1
        End If
        
        if point ((xb+x),(yb+y),layer) <> c then HIT = TRUE
        if point ((xb+x),(yb-y),layer) <> c then HIT = TRUE
        if point ((xb-x),(yb+y),layer) <> c then HIT = TRUE
        if point ((xb-x),(yb-y),layer) <> c then HIT = TRUE
        
    Loop While y>0
    
    return HIT

End function

'====================================================================


const BMAPW = 2560
const BMAPH = 480
const WINW = 640
const WINH = 480
dim shared as integer WINX,WINY  'position of window in layer3 bitmap


screenres 640,480,32
color rgb(0,0,0),rgb(255,255,255):cls
dim shared as any ptr layer3
layer3 = imagecreate(BMAPW,BMAPH,rgb(255,0,255))


'==============    Draw hills on layer2 =================================
dim shared as integer hills(0 to BMAPW-1)
sub drawHills()
    dim as single a1,a2,a3   'angle of each wave
    dim as single y1,y2,y3   'height of each wave
    dim as single y4         'combined height of waves
    a1 = 0                   'starting angle
    a2 = 20
    a3 = 100
    for i as single = 0 to BMAPW-1
        a1 = a1 +  .6
        a2 = a2 +  .7
        a3 = a3 +  1
        y1 = sin(a1*DtoR)*60
        y2 = sin(a2*DtoR)*30
        y3 = sin(a3*DtoR)*25
        y4 = (sin(a2*DtoR)*30) + (sin(a1*DtoR)*60) + (sin(a3*DtoR)*25)
        hills(i) = y4
    next i
    for i as integer = 1 to BMAPW-1
        line layer3,(i-1,hills(i-1)+240)-(i,hills(i)+240),rgb(0,0,255)
    next i    
    paint layer3,(0,BMAPH-1),rgb(0,0,255),rgb(0,0,255)
end sub
'=======================================================================

dim shared as integer x1,y1,x2,y2  'coordinates of back and front wheels
dim shared as single angle         'angle of front wheel to back wheel
angle = 270  'points up to start
dim shared as single mv            'speed of buggy
mv = 1
dim shared as single dx,dy         'working variables
dim shared as single bar
x1 = 260
y1 = 80
bar = 100
WINX = 0
WINY = 0

'=======================================================================

sub update()
    dim as single px1,py1,px2,py2,angle2
    screenlock
    cls
    put (0,0),layer3,(WINX,WINY)-(WINX+WINW-1,WINY+WINH-1),trans

    px1 = x1 + (x2 - x1)/2
    py1 = y2 + (y1 - y2)/2
    angle2 = angle - 90
    px2 = cos(angle2*DtoR)*60+px1
    py2 = sin(angle2*DtoR)*60+py1
    
    'center buggy if possible within display window
    WINX = px1-320
    if WINX < 320 then WINX = 320
    if WINX > BMAPW-WINW then WINX = BMAPW-WINW
    'draw buggy
    circle (x1-WINX,y1),25,rgb(255,0,0)
    circle (x2-WINX,y2),25,rgb(0,255,0)
    line (x1-WINX,y1)-(x2-WINX,y2),rgb(200,100,0)
    line (px1-WINX,py1)-(px2-WINX,py2),rgb(0,255,0)
    circle (px2-WINX,py2),40,rgb(0,255,0)
    locate 2,2
    print "angle =";angle
    screenunlock
end sub

drawHills()

'drop buggy
angle = 270  'pointing front wheel up to lower until it hits ground

'angle = 45

do

    'move back wheel down until it hits ground
    while testCircle(layer3,x1,y1,26) = FALSE
        y1 = y1 + 1
    wend
    'move back wheel up until out of ground
    while testCircle(layer3,x1,y1,26) = TRUE
        y1 = y1 - 1
    wend

    'compute position of front wheel
    'angle = 270  'points up
    x2 = x1 + cos(angle*DtoR) * bar
    y2 = y1 + sin(angle*DtoR) * bar
    
    'rotate front wheel down until it hits ground
    while testCircle(layer3,x2,y2,26) = FALSE
        angle = angle + .5
        x2 = x1 + cos(angle*DtoR) * bar
        y2 = y1 + sin(angle*DtoR) * bar
    wend
    
    'rotate front wheel up out of ground
    while testCircle(layer3,x2,y2,26) = TRUE
        angle = angle - 1
        x2 = x1 + cos(angle*DtoR) * bar
        y2 = y1 + sin(angle*DtoR) * bar
    wend 

    dx = Cos(angle*DtoR) * mv
    dy = Sin(angle*DtoR) * mv
    
    if x1>0 and x1<BMAPW-150 then
        x1 = x1 + dx  'move forward
        y1 = y1 + dy
    end if

    if angle > 360 then angle = angle - 360
    if angle < 0   then angle = angle + 360
    
    update()
    
    sleep 2
loop until multikey(&H01)

[paul doe]

@paul doe,
Thanks for the encouragement particularly as I would have imagined your preference would be for using a 2D game engine. I did start off with some buggy demos but the wheels did not rotate to match their movement over the surface as in the dodicat demo.

You're welcome. The new code looks neat, and the demo runs flawless. Nice work! =D

As for my preferences, it really depends on what you're trying to do: 2D engines are cool because they're easy to code and conceptualize, but 3D ones offer more possibilities (and even make some things easier). Then again, it all depends on the type of game you're trying to pull off. If making a 3D engine doesn't really add anything to the game (think StarCraft vs StarCraft 2), then it will only become a pain (for you and your artists, if you have some friends that'll do it =D) for no real gain.

Keep it up!