w=accelerate
s=brake
a=left
d=right
if the truck has stopped:
r=backward
f=foreward
Code: Select all
screen 19,32
print
dim shared as integer scrnw,scrnh
screeninfo scrnw,scrnh
dim shared as integer Xo,Yo
Xo=scrnw\2
Yo=scrnh\2
const as single pi =atn (1) * 4
const as single doublepi=pi*2
type vector
x as single
y as single
end type
'points on the vehicle centre line
'could be real axles or hitches
type axle
used as single '"flag" is this axle in use?
mounting as single 'distance to an previous axle
position as vector 'global position
end type
/'
--- ---
| |
<-----axl(0)----------------axl(1)--axl(2)
| |
--- ---
'/
'container
type vessel
prevvessel as vessel ptr
nextvessel as vessel ptr
vtype as integer
align as single
axl(2) as axle '0 and 1 for real axles, 2 for hitch
end type
declare sub SetTractorA (v as vessel ptr)
declare sub SetTractorB (v as vessel ptr)
declare sub SetTrailerA (v as vessel ptr)
declare sub SetTrailerB (v as vessel ptr)
declare sub CalcPositions (v as vessel ptr)
declare function GetDistance(b as vector, d as vector) as single
declare function GetArcus(b as vector,v as vector) as single
declare function GetVector(arcus as single) as vector
'gesamter Zug
type set
steer as single 'steer angle/ moving direction of axle(0)
steermax as single
steercontrol as integer '1=left 0=straight 2=right
velocity as single
velocontrol as integer '1=accelerate 0=roll out 2=brake
dircontrol as integer '1=foreward -1=back
timer_this as single 'time managment
timer_last as single
firstvessel as vessel ptr 'linked list
lastvessel as vessel ptr
'help variables
oldpoint as vector
v as vector
l as vector
d as vector
t as single
distance as single
steertmp as single
vess as vessel ptr
declare constructor
declare destructor
declare function AddVessel(vtype as integer) as integer
declare sub HitchUpVessel (vess as vessel ptr)
declare sub MoveAll
declare sub Acceleration
declare sub Deceleration
declare sub ToLeft
declare sub ToRight
declare sub Foreward
declare sub Reverse
declare sub DrawVessels
end type
constructor set
timer_this=0
timer_last=0
dircontrol=1
steermax=45/360 * doublepi
end constructor
destructor set
dim as vessel ptr nv,v=firstvessel
if v then
do
nv=v->nextvessel
delete v
v=nv
loop until v=0
end if
end destructor
function set.AddVessel(vtype as integer) as integer
function=0
dim as vessel ptr tmp
dim as integer possible=0
'hitching rules
if lastvessel=0 then 'if nothing exists
if vtype<5 then possible=1' firstvessel must be a tractor
else ' if something exist...
if vtype>4 then 'trailer only alowed
possible=1
'exceptions for trailers
if lastvessel->vtype=1 and vtype<>5 then possible=0'road tractor -> semi trailer
if lastvessel->vtype=2 and vtype<>6 then possible=0'tractor -> trailer
if lastvessel->vtype=5 and vtype=5 then possible=0'semi trailer -> semi trailer not possible
end if
end if
if possible then
tmp= new vessel
if tmp then
tmp->vtype=vtype
select case vtype
case 1
SetTractorA (tmp)
case 2
SetTractorB (tmp)
case 5
SetTrailerA (tmp)
case 6
SetTrailerB (tmp)
end select
if vtype<5 then 'link first vessel(tractor)
firstvessel=tmp
lastvessel=tmp
else 'link trailers
lastvessel->nextvessel=tmp
tmp->prevvessel=lastvessel
lastvessel=tmp
'move the trailer to the hitch
HitchUpVessel(lastvessel)
end if
function=possible
end if
end if
end function
sub set.HitchUpVessel (vess as vessel ptr)
l=vess->prevvessel->axl(2).position
d=GetVector(vess->align - pi)
vess->axl(0).position.x=l.x + d.x*vess->axl(0).mounting
vess->axl(0).position.y=l.y + d.y*vess->axl(0).mounting
for i as integer=1 to 2
vess->axl(i).position.x=vess->axl(0).position.x + d.x*vess->axl(i).mounting
vess->axl(i).position.y=vess->axl(0).position.y + d.y*vess->axl(i).mounting
next i
end sub
sub set.MoveAll
'Timer stuff
if timer_last then timer_this = timer-timer_last
timer_last=timer
'speed calculation
if velocontrol=0 and velocity>0 then
velocity -=5*timer_this
if velocity<0 then velocity=0
end if
if velocontrol=1 and velocity<200 then
velocity +=10*timer_this
if velocity>200 then velocity=200
end if
if velocontrol=2 and velocity>0 then
velocity -=100*timer_this
if velocity<0 then velocity=0
end if
'steer calculations
if steercontrol=0 and steer<>0 then 'straight
steertmp=abs(steer)
steertmp -= 1.2*timer_this
if steertmp<0 then steer=0 else steer=steertmp*sgn(steer)
end if
if steercontrol=1 and steer<>steermax then 'left
steer += 1*timer_this
if steer>steermax then steer=steermax
end if
if steercontrol=2 and steer<>-steermax then 'right
steer -= 1*timer_this
if steer<-steermax then steer=-steermax
end if
vess=firstvessel
do
if vess=firstvessel then 'tractor axle calculations
distance=velocity*timer_this 'calc the distance
d=GetVector(vess->align + steer) 'direction to move the first axle
'new position first axle (axl(0))
oldpoint=vess->axl(0).position'remember old position
vess->axl(0).position.x +=d.x*distance * dircontrol
vess->axl(0).position.y +=d.y*distance * dircontrol
'new position second axle (axl(1))
d=GetVector(GetArcus(oldpoint,vess->axl(1).position))
l.x=oldpoint.x + d.x * (vess->axl(1).mounting - distance)
l.y=oldpoint.y + d.y * (vess->axl(1).mounting - distance)
d=GetVector(GetArcus(vess->axl(0).position,l))'vector d isis also direction for hitch(axle(2))
vess->axl(1).position.x=vess->axl(0).position.x + d.x * vess->axl(1).mounting
vess->axl(1).position.y=vess->axl(0).position.y + d.y * vess->axl(1).mounting
'new position third axle (axl(2)) hitch
oldpoint=vess->axl(2).position
vess->axl(2).position.x=vess->axl(0).position.x + d.x * vess->axl(2).mounting
vess->axl(2).position.y=vess->axl(0).position.y + d.y * vess->axl(2).mounting
vess->align=GetArcus(vess->axl(1).position,vess->axl(0).position)
else 'Trailer
'new position axle(0)
d=GetVector(GetArcus(oldpoint,vess->axl(0).position))
l.x=oldpoint.x + d.x * (vess->axl(0).mounting - distance)
l.y=oldpoint.y + d.y * (vess->axl(0).mounting - distance)
d=GetVector(GetArcus(vess->prevvessel->axl(2).position,l))
oldpoint=vess->axl(0).position
vess->axl(0).position.x=vess->prevvessel->axl(2).position.x + d.x * vess->axl(0).mounting
vess->axl(0).position.y=vess->prevvessel->axl(2).position.y + d.y * vess->axl(0).mounting
if vess->axl(1).used then 'if normal trailer
d=GetVector(GetArcus(oldpoint,vess->axl(1).position))
l.x=oldpoint.x + d.x * (vess->axl(1).mounting - distance)
l.y=oldpoint.y + d.y * (vess->axl(1).mounting - distance)
d=GetVector(GetArcus(vess->axl(0).position,l))
vess->axl(1).position.x=vess->axl(0).position.x + d.x * vess->axl(1).mounting
vess->axl(1).position.y=vess->axl(0).position.y + d.y * vess->axl(1).mounting
vess->align=GetArcus(vess->axl(1).position,vess->axl(0).position)
else 'if semi trailer
vess->align=GetArcus(vess->axl(0).position,vess->prevvessel->axl(2).position)
end if
end if
'new position third axle (axl(2)) hitch
oldpoint=vess->axl(2).position
vess->axl(2).position.x=vess->axl(0).position.x + d.x * vess->axl(2).mounting
vess->axl(2).position.y=vess->axl(0).position.y + d.y * vess->axl(2).mounting
vess=vess->nextvessel
loop until vess=0
steercontrol=0
velocontrol=0
end sub
sub set.Acceleration
velocontrol=1
end sub
sub set.Deceleration
velocontrol=2
end sub
sub set.ToLeft
steercontrol=1
end sub
sub set.ToRight
steercontrol=2
end sub
sub set.Foreward
if velocity=0 then dircontrol=1
end sub
sub set.Reverse
if velocity=0 then dircontrol=-1
end sub
sub set.DrawVessels
vess=firstvessel
if vess then
do
select case vess->vtype
case 1,2
circle (Xo + vess->axl(0).position.x , Yo - vess->axl(0).position.y),5,&H0000FF
line (Xo + vess->axl(0).position.x , Yo - vess->axl(0).position.y) - (Xo + vess->axl(1).position.x , Yo - vess->axl(1).position.y),&H00FF00
circle (Xo + vess->axl(1).position.x , Yo - vess->axl(1).position.y),5,&HFF0000
circle (Xo + vess->axl(2).position.x , Yo - vess->axl(2).position.y),3,&H00FF00
case 5
line (Xo + vess->prevvessel->axl(2).position.x , Yo - vess->prevvessel->axl(2).position.y) - (Xo + vess->axl(0).position.x , Yo - vess->axl(0).position.y),&HFF7F00
circle (Xo + vess->axl(0).position.x , Yo - vess->axl(0).position.y),5,&HFF0000
circle (Xo + vess->axl(2).position.x , Yo - vess->axl(2).position.y),3,&H00FF00
case 6
line (Xo + vess->prevvessel->axl(2).position.x , Yo - vess->prevvessel->axl(2).position.y) - (Xo + vess->axl(0).position.x , Yo - vess->axl(0).position.y),&HFF7F00
circle (Xo + vess->axl(0).position.x , Yo - vess->axl(0).position.y),5,&H0000FF
line (Xo + vess->axl(0).position.x , Yo - vess->axl(0).position.y) - (Xo + vess->axl(1).position.x , Yo - vess->axl(1).position.y),&H00FF00
circle (Xo + vess->axl(1).position.x , Yo - vess->axl(1).position.y),5,&HFF0000
circle (Xo + vess->axl(2).position.x , Yo - vess->axl(2).position.y),3,&H00FF00
end select
vess=vess->nextvessel
loop until vess=0
end if
end sub
'******************************************************************************
'******************************************************************************
'******************************************************************************
'**************************************
'definition of possible trucks,traktors,trailers
sub SetTractorA (v as vessel ptr)
v->vtype=1
'front to left 180 grd
v->align=pi
'************************************
v->axl(0).used=1
v->axl(0).mounting=0
v->axl(1).used=1
v->axl(1).mounting=80
v->axl(2).used=1
v->axl(2).mounting=50
CalcPositions (v)
end sub
sub SetTractorB (v as vessel ptr)
v->vtype=2
'front to left 180 grd
v->align=pi
'************************************
v->axl(0).used=1
v->axl(0).mounting=0
v->axl(1).used=1
v->axl(1).mounting=40
v->axl(2).used=1
v->axl(2).mounting=50
CalcPositions (v)
end sub
sub SetTrailerA (v as vessel ptr)
v->vtype=5
v->align=pi
'************************************
v->axl(0).used=1
v->axl(0).mounting=160
v->axl(1).used=0
v->axl(1).mounting=0
v->axl(2).used=1
v->axl(2).mounting=10
CalcPositions (v)
end sub
sub SetTrailerB (v as vessel ptr)
v->vtype=6
v->align=pi
'************************************
v->axl(0).used=1
v->axl(0).mounting=20
v->axl(1).used=1
v->axl(1).mounting=80
v->axl(2).used=1
v->axl(2).mounting=90
CalcPositions (v)
end sub
sub CalcPositions (v as vessel ptr)
'Achsen verorten
v->axl(0).position.x=0
v->axl(0).position.y=0
for i as integer=1 to 2
v->axl(i).position.x=v->axl(0).position.x + v->axl(i).mounting
v->axl(i).position.y=v->axl(0).position.y
next i
end sub
' asm code in following routines by volta
'get distance between 2 local vectors
Function GetDistance(b As vector, d As vector) As Single
'dim as single dx,dy
'dx=d.x - b.x
'dy=d.y - b.y
'function=sqr(dx*dx + dy*dy)
Asm
mov eax, dword Ptr [d]
mov ebx, dword Ptr [b]
fld dword Ptr [eax]
fsub dword Ptr [ebx]
fmul ST(0), ST(0)
fld dword Ptr [eax+4]
fsub dword Ptr [ebx+4]
fmul ST(0), ST(0)
faddp
fsqrt
fstp dword Ptr [Function]
End Asm
End Function
'get the global angle (radians) of v from b (b is the basis)
Function GetArcus(b As vector,v As vector) As Single
Dim As Single arcus
'Dim As vector d
'd.x= v.x - b.x
'd.y= v.y - b.y
'arcus=ATan2(d.y,d.x)
Asm
mov eax, dword Ptr [v]
mov ebx, dword Ptr [b]
fld dword Ptr [eax+4]
fsub dword Ptr [ebx+4]
fld dword Ptr [eax]
fsub dword Ptr [ebx]
fpatan
fstp dword Ptr [arcus]
End Asm
If Sgn(arcus)=-1 Then arcus= doublepi + arcus
Function=arcus
End Function
'convert radians to a vector (length=1)
Function GetVector(arcus As Single) As vector
Dim As vector v
If arcus>=doublepi Then arcus=arcus-doublepi
If arcus<0 Then arcus=doublepi+arcus
'v.x=Cos(arcus)
'v.y=Sin(arcus)
Asm
fld dword Ptr [arcus]
fsincos 'compute sin AND cos
fstp dword Ptr [v] 'cos -> v.x
fstp dword Ptr [v+4] 'sin -> v.y
End Asm
Function=v
End Function
'******************************************************************************
'******************************************************************************
'******************************************************************************
dim as set truck
'traktor types 1=road tractor / 2=traktor
'trailer types 5=semi trailer / 6=trailer
truck.AddVessel(2)'tractor
truck.AddVessel(6)'trailer
truck.AddVessel(6)'trailer
'or try this:
'truck.AddVessel(1)'road tractor
'truck.AddVessel(5)'semi trailer
do
sleep 1
if multikey(&H11) then truck.Acceleration
if multikey(&H1F) then truck.Deceleration
if multikey(&H1E) then truck.ToLeft
if multikey(&H20) then truck.ToRight
if multikey(&H13) then truck.Reverse
if multikey(&H21) then truck.Foreward
truck.MoveAll
screenlock
cls
truck.DrawVessels
line (0,Yo)-(Xo*2-1,Yo),&H007F00
line (Xo,0)-(Xo,Yo*2-1),&H7F0000
screenunlock
loop until inkey=chr(27)
end