Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Achsenmodell die 6. mit Eigenkollisionserkennung
| Uploader: |  Muttonhead |
| Datum/Zeit: | 23.11.2011 22:03:29 |
'Achsenmodel_06.bas
'weit entfernt von Physik und Realität
screen 19,32
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
const as single scale=8
Dim shared as integer ptr CollisionS
CollisionS=imagecreate(scrnw,scrnh)
if CollisionS=0 then end
type vector
x as single
y as single
end type
'Als axle werden alle Punkte auf der
'Fahrzeugmittelachse definiert:
'das können tatsächlich Achsen als auch Anhängerkupplungen sein
type axle
used as single '"Flag" ob Achse da ist oder nicht
mounting as single 'Entfernung dieser Achsezu einem vorhergehenden Aufhängungspunkt, also Achse/Anhängerkupplung
position as vector 'Position der Achse
end type
'Die Lage dieser Punkte wird durch den relativen Winkel zur Fahreugmittelachse
'und der Entfernung zum Null-Punkt definiert.
'Kollisionspunkte und später die Grafik wird aus solchen Punkten aufgebaut
type bodypoint
align as single 'Winkel
distance as single 'Entfernung zum NullPunkt
position as vector 'Position dieses Punktes
end type
'Container für die Fahrzeugdefinition
'Null-Punkt ist immer axl(0)
/'
c(1)------------------------------c(2)
| --- --- |
| | | |
<---|-axl(0)----------------axl(1)--axl(2)
| | | |
| --- --- |
c(0)------------------------------c(3)
'/
type vessel
prevvessel as vessel ptr
nextvessel as vessel ptr
vtype as integer
align as single
axl(2) as axle '0 und 1 für Achsen
collision(3) as bodypoint'beschreibt KollisionsFläche, für Kollisionen zwischen den Vessels
collisioncolor as integer 'Farbe für Collisionsüberprüfung
end type
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
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)
'gesamter Zug
type set
steer as single 'Lenkwinkel/ Bewegungsrichtung der ersten Achse
steermax as single 'max. Einlenkwinkel in Bogenmaß, gesetzt im Constructor
steercontrol as integer '1=Links 0=Gerade 2=Rechts
velocity as single 'Geschwindigkeit Einheiten/Sekunde im Koordinatensystem
velocontrol as integer '1=Beschleunigen 0=Ausrollen 2=Abbremsen
dircontrol as integer '1=Vorwärts -1=Rückwärts
timer_this as single 'aktuell vergangene Zeit seit timer_last
timer_last as single 'Systemzeit letzten Bewegung/Berechnung
firstvessel as vessel ptr 'erstes Objekt
lastvessel as vessel ptr 'letztes Objekt
gamemsg as string
rotcolor as integer 'rotierender Farbwert für Eigenkollision wird ins Vessel eingetragen
'Hilfsvariablen
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 MoveSet
declare sub Acceleration
declare sub Deceleration
declare sub ToLeft
declare sub ToRight
declare sub Foreward
declare sub Reverse
declare sub DrawVessels
declare function CheckSelfCollision as integer
end type
constructor set
timer_this=0
timer_last=0
dircontrol=1
steermax=45/360 * doublepi
rotcolor=0
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
if lastvessel=0 then 'Als erstes muß immer ein Zugfahrzeug gewählt werden
if vtype<5 then possible=1
else 'an nächster Stelle
if vtype>4 then 'nur noch Anhänger möglich
possible=1
'if lastvessel->vtype=1 and vtype<>5 then possible=0'an Sattelschlepper ist nur Auflieger möglich
if lastvessel->vtype=2 and vtype<>6 then possible=0'an Traktor ist nur 2achsiger Anhänger möglich
'if lastvessel->vtype=5 and vtype=5 then possible=0'Auflieger an Auflieger nicht möglich
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
'Verlinken
firstvessel=tmp
lastvessel=tmp
else
'Verlinken
lastvessel->nextvessel=tmp
tmp->prevvessel=lastvessel
lastvessel=tmp
'zur Anhängekupplung des Vorgängers bewegen
HitchUpVessel(lastvessel)
end if
function=1
end if
end if
end function
sub set.HitchUpVessel (vess as vessel ptr)
l=vess->prevvessel->axl(2).position'Position der Kupplung vom vorhergehenden Vessel
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
'd=GetVector(vess->align)
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
for i as integer=0 to 3
d=GetVector(vess->align+vess->collision(i).align)
vess->collision(i).position.x=vess->axl(0).position.x + d.x * vess->collision(i).distance
vess->collision(i).position.y=vess->axl(0).position.y + d.y * vess->collision(i).distance
next i
end sub
sub set.MoveSet
if CheckSelfCollision=0 then
'Timersteuerung
if timer_last then timer_this = timer-timer_last
'Geschwindigkeit berechnen
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
'Lenkeinschlag berechnen
if steercontrol=0 and steer<>0 then 'gerade
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 'links
steer += 1*timer_this
if steer>steermax then steer=steermax
end if
if steercontrol=2 and steer<>-steermax then 'rechts
steer -= 1*timer_this
if steer<-steermax then steer=-steermax
end if
vess=firstvessel
do
if vess=firstvessel then 'Zugfahrzeug
distance=velocity*timer_this 'Weg aus Geschwindigkeit und Zeit ermitteln
d=GetVector(vess->align + steer) 'Summe aus Richtungswinkel der 1. Achse und der Steuerungswinkel ergibt
'neue Position 1.Achse berechnen
oldpoint=vess->axl(0).position'alte Position 1.Achse merken
vess->axl(0).position.x +=d.x*distance * dircontrol
vess->axl(0).position.y +=d.y*distance * dircontrol
'neue Position 2.Achse berechnen (mit Zwischenposition)
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))'Vektor d ist gleichzeitig auch die Richtung für die Kupplung
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
'neue Position Kupplung berechnen
oldpoint=vess->axl(2).position'alte Position hintere Kupplung merken
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
'neue Ausrichtung des Vessels berechnen
vess->align=GetArcus(vess->axl(1).position,vess->axl(0).position)
else 'Anhänger
'neue Position 1.Achse berechnen (mit Zwischenposition)
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))'Vektor d ist gleichzeitig auch die Richtung für die Kupplung
oldpoint=vess->axl(0).position'alte Position 1.Achse merken
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 'wenn 2achsiger Anhänger
'neue Position 2.Achse berechnen (mit Zwischenposition)
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))'Vektor d ist gleichzeitig auch die Richtung für die Kupplung
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
'neue Ausrichtung des Vessels berechnen
vess->align=GetArcus(vess->axl(1).position,vess->axl(0).position)
else 'wenn 1achsiger Anhänger
'neue Ausrichtung des Vessels berechnen
vess->align=GetArcus(vess->axl(0).position,vess->prevvessel->axl(2).position)
end if
end if
'neue Position Kupplung berechnen
oldpoint=vess->axl(2).position'alte Position hintere Kupplung merken
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
'Kollisionspunkte berechnen
for i as integer=0 to 3
d=GetVector(vess->align + vess->collision(i).align)
vess->collision(i).position.x=vess->axl(0).position.x + d.x * vess->collision(i).distance
vess->collision(i).position.y=vess->axl(0).position.y + d.y * vess->collision(i).distance
next i
vess=vess->nextvessel
loop until vess=0
timer_last=timer 'aktuelle Zeit für das nächstemal merken
steercontrol=0
velocontrol=0
else
gamemsg="Lastzug durch Eigenkollision zerstoert"
end if
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
line(Xo + vess->collision(0).position.x,Yo - vess->collision(0).position.y)-_
(Xo + vess->collision(1).position.x,Yo - vess->collision(1).position.y),&HFF7F00
line-(Xo + vess->collision(2).position.x,Yo - vess->collision(2).position.y),&HFF7F00
line-(Xo + vess->collision(3).position.x,Yo - vess->collision(3).position.y),&HFF7F00
line-(Xo + vess->collision(0).position.x,Yo - vess->collision(0).position.y),&HFF7F00
paint(Xo+ vess->axl(0).position.x,Yo - vess->axl(0).position.y),&HFF7F00
vess=vess->nextvessel
loop until vess=0
end if
locate (1,1)
print gamemsg
end sub
function set.CheckSelfCollision as integer
dim as integer selfcollision=0
function=0
if firstvessel then
'Zeichenrichtung firstvessel->lastvessel
vess=firstvessel
do
'Farbrotation
rotcolor +=1
if rotcolor>&HFFFFFF then rotcolor=1
vess->collisioncolor=rotcolor
line CollisionS,(Xo + vess->collision(0).position.x,Yo - vess->collision(0).position.y)-_
(Xo + vess->collision(1).position.x,Yo - vess->collision(1).position.y),vess->collisioncolor
line CollisionS,-(Xo + vess->collision(2).position.x,Yo - vess->collision(2).position.y),vess->collisioncolor
line CollisionS, -(Xo + vess->collision(3).position.x,Yo - vess->collision(3).position.y),vess->collisioncolor
line CollisionS,-(Xo + vess->collision(0).position.x,Yo - vess->collision(0).position.y),vess->collisioncolor
paint CollisionS,(Xo+ vess->axl(0).position.x,Yo - vess->axl(0).position.y),vess->collisioncolor
vess=vess->nextvessel
loop until vess=0
'Überprüfung ob jeder Kollisionspunkt die richtige Farbe hat
vess=firstvessel
do
for i as integer=0 to 3
if point (Xo + vess->collision(i).position.x,Yo - vess->collision(i).position.y,CollisionS)<>_
vess->collisioncolor then selfcollision=1
next i
vess=vess->nextvessel
loop until (vess=0) or (selfcollision=1)
if selfcollision=0 then
'Zeichenrichtung lastvessel->firstvessel
vess=lastvessel
do
'Farbrotation
rotcolor +=1
if rotcolor>&HFFFFFF then rotcolor=1
vess->collisioncolor=rotcolor
line CollisionS,(Xo + vess->collision(0).position.x,Yo - vess->collision(0).position.y)-_
(Xo + vess->collision(1).position.x,Yo - vess->collision(1).position.y),vess->collisioncolor
line CollisionS,-(Xo + vess->collision(2).position.x,Yo - vess->collision(2).position.y),vess->collisioncolor
line CollisionS, -(Xo + vess->collision(3).position.x,Yo - vess->collision(3).position.y),vess->collisioncolor
line CollisionS,-(Xo + vess->collision(0).position.x,Yo - vess->collision(0).position.y),vess->collisioncolor
paint CollisionS,(Xo+ vess->axl(0).position.x,Yo - vess->axl(0).position.y),vess->collisioncolor
vess=vess->prevvessel
loop until vess=0
'Überprüfung ob jeder Kollisionspunkt die richtige Farbe hat
vess=firstvessel
do
for i as integer=0 to 3
if point (Xo + vess->collision(i).position.x,Yo - vess->collision(i).position.y,CollisionS)<>_
vess->collisioncolor then selfcollision=1
next i
vess=vess->nextvessel
loop until (vess=0) or (selfcollision=1)
end if
end if
function=selfcollision
end function
'**************************************
'**************************************
'Punktedefinition aller möglichen Fahrzeuge und Anhänger
sub SetTractorA (v as vessel ptr)
'Vesseltyp festlegen
v->vtype=1
'Ausrichtung nach links 180 grd
v->align=pi
'************************************
'Achsen
v->axl(0).used=1
v->axl(0).mounting=0
v->axl(1).used=1
v->axl(1).mounting=4
v->axl(2).used=1
v->axl(2).mounting=3
'Kollision
v->collision(0).position.x=-1.5
v->collision(0).position.y=-1.25
v->collision(1).position.x=-1.5
v->collision(1).position.y=1.25
v->collision(2).position.x=0.5'4.97
v->collision(2).position.y=1.25
v->collision(3).position.x=0.5'4.97
v->collision(3).position.y=-1.25
'************************************
'Achsen verorten
v->axl(0).position.x=0
v->axl(0).position.y=0
v->axl(0).mounting *=scale
for i as integer=1 to 2
v->axl(i).mounting *=scale
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
'Bezug zum NullPunkt(axl(0)) herstellen
for i as integer=0 to 3
v->collision(i).position.x *=scale
v->collision(i).position.y *=scale
v->collision(i).align=v->align-GetArcus(v->axl(0).position,v->collision(i).position)
v->collision(i).distance=GetDistance(v->axl(0).position,v->collision(i).position)
next i
end sub
sub SetTrailerA (v as vessel ptr)
'Vesseltyp festlegen
v->vtype=5
'Ausrichtung nach links 180 grd
v->align=pi
'************************************
'Achsen
v->axl(0).used=1
v->axl(0).mounting=8
v->axl(1).used=0
v->axl(1).mounting=0
v->axl(2).used=1
v->axl(2).mounting=4
'Kollision
v->collision(0).position.x=-9.5
v->collision(0).position.y=-1.25
v->collision(1).position.x=-9.5
v->collision(1).position.y=1.25
v->collision(2).position.x=4
v->collision(2).position.y=1.25
v->collision(3).position.x=4
v->collision(3).position.y=-1.25
'************************************
'Achsen verorten
v->axl(0).position.x=0
v->axl(0).position.y=0
v->axl(0).mounting *=scale
for i as integer=1 to 2
v->axl(i).mounting *=scale
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
'Bezug zum NullPunkt(axl(0)) herstellen
for i as integer=0 to 3
v->collision(i).position.x *=scale
v->collision(i).position.y *=scale
v->collision(i).align=v->align-GetArcus(v->axl(0).position,v->collision(i).position)
v->collision(i).distance=GetDistance(v->axl(0).position,v->collision(i).position)
next i
end sub
sub SetTrailerB (v as vessel ptr)
'Vesseltyp festlegen
v->vtype=6
'Ausrichtung nach links 180 grd
v->align=pi
'************************************
'Achsen
v->axl(0).used=1
v->axl(0).mounting=3
v->axl(1).used=1
v->axl(1).mounting=4
v->axl(2).used=1
v->axl(2).mounting=5.5
'Kollision
v->collision(0).position.x=-1
v->collision(0).position.y=-1.25
v->collision(1).position.x=-1
v->collision(1).position.y=1.25
v->collision(2).position.x=5.5
v->collision(2).position.y=1.25
v->collision(3).position.x=5.5
v->collision(3).position.y=-1.25
'************************************
'Achsen verorten
v->axl(0).position.x=0
v->axl(0).position.y=0
v->axl(0).mounting *=scale
for i as integer=1 to 2
v->axl(i).mounting *=scale
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
'Bezug zum NullPunkt(axl(0)) herstellen
for i as integer=0 to 3
v->collision(i).position.x *=scale
v->collision(i).position.y *=scale
v->collision(i).align=v->align-GetArcus(v->axl(0).position,v->collision(i).position)
v->collision(i).distance=GetDistance(v->axl(0).position,v->collision(i).position)
next i
end sub
'******************************************************************************
'**************************************
'Hilfsfunktionen
'liefern Entfernung 2er Ortsvektoren nach Pythagoras
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)
end function
'liefert die globale Richtung(in Bogenmaß) eines Punktes v vom Standpunkt b aus gesehen
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)
if sgn(arcus)=-1 then arcus= doublepi + arcus
function=arcus
end function
'liefert eine Richtung (in Bogenmaß) als Richtungsvektor
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)
function=v
end function
'******************************************************************************
dim as set truck
truck.AddVessel(1)
truck.AddVessel(5)
truck.AddVessel(6)
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.MoveSet
screenlock
cls
truck.DrawVessels
'Koordinatensystem
line (0,Yo)-(Xo*2-1,Yo),&H007f00
line (Xo,0)-(Xo,Yo*2-1),&H7F0000
screenunlock
loop until inkey=chr(27)
end
imagedestroy CollisionS