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)