Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Achsenmodell die 3.
| Uploader: |  Muttonhead |
| Datum/Zeit: | 06.11.2011 22:17:40 |
'Einspur-Achsenmodel_03.bas
'weit entfernt von Physik und Realität
#include "fbgfx.bi"
const as integer Xo=400,Yo=300
const as single pi =atn (1) * 4
const as single doublepi=pi*2
type vector
x as single
y as single
end type
declare function GetAngle(b as vector,v as vector) as single
declare function GetVector(align as single) as vector
type axle
prevaxle as axle ptr 'Zeiger auf Vorgänger
nextaxle as axle ptr 'Zeiger auf Nachfolger
distAxle as integer 'Entfernung der Achse zur Kupplung vorn
posAxle as vector 'Position der Achse
distHitch as integer 'Entfernung der hinteren Kupplung zur Kupplung vorn
posHitch as vector 'Position der hinteren Kupplung/ hier
'Berechnungshilfe
oldpos as vector 'Puffer für alte Position
end type
type set
alignment as single 'globale Richtung des "Zugfahrzeugs"(definiert durch die Lage von 1. und 2. Achse)
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
firstaxle as axle ptr 'Zeiger auf erste Achse
lastaxle as axle ptr 'Zeiger auf letzte Achse
'Hilfsvariablen
tmp as axle ptr
axl as axle ptr
v as vector
t as single
distance as single
steertmp as single
declare function AddAxle(distA as integer=-1,distH as integer=-1,align as single=0) as integer
declare sub MoveAxles
declare sub CalcAlignment
declare sub DrawAxles
declare sub Acceleration
declare sub Deceleration
declare sub ToLeft
declare sub ToRight
declare sub Foreward
declare sub Reverse
declare constructor
declare destructor
end type
'Achsenfolge wird immer vom Koordinatenursprung erzeugt, soll heißen: 1. Achse ist immer in (0,0)
function set.AddAxle(distA as integer,distH as integer,align as single=0) as integer
tmp=new axle
if tmp then
if distH=0 then distH=distA
if lastaxle=0 then'wenn noch keine Achse, dann...
'erste Achse ignoriert alle Parameter
tmp->prevaxle=0
tmp->nextaxle=0
tmp->distAxle=0
tmp->posAxle.x=0
tmp->posAxle.y=0
tmp->distHitch=0
tmp->posHitch=tmp->posAxle'Kupplung/Aufhängepunkt für nächste Achse = Position der Achse
firstaxle=tmp 'als Erste setzen
else'ansonsten normales Erzeugen und Verlinken der nachfolgenden Achsen
'Verlinken
lastaxle->nextaxle=tmp
tmp->prevaxle=lastaxle
'Positionieren der Achse relativ zum vorhergehenden Achse
v=GetVector(align)'Richtungsvektor erzeugen, dessen Länge ist 1
'Position der vorhergehenden hinteren Kupplung + Skalarmultiplikation des Vektors mit dist...
tmp->posAxle.x=lastaxle->posHitch.x + v.x*distA
tmp->posAxle.y=lastaxle->posHitch.y + v.y*distA
tmp->posHitch.x=lastaxle->posHitch.x + v.x*distH
tmp->posHitch.y=lastaxle->posHitch.y + v.y*distH
'Entfernung merken
tmp->distAxle=distA
tmp->distHitch=distH
end if
lastaxle=tmp' erzeugte Achse als Letze definieren
function=1
end if
end function
sub set.MoveAxles
dim as axle ptr axl=firstaxle
dim as vector v
dim as single t,distance
axl=firstaxle
'Timersteuerung
if timer_last then timer_this = timer-timer_last
'Geschwindigkeit berechnen
select case velocontrol
case 0
if velocity>0 then
velocity -=5*timer_this
if velocity<0 then velocity=0
end if
case 1
if velocity<200 then
velocity +=15*timer_this
if velocity>200 then velocity=200
end if
case 2
if velocity>0 then
velocity -=100*timer_this
if velocity<0 then velocity=0
end if
end select
'Lenkeinschlag berechnen
select case steercontrol
case 0 'gerade
if steer<>0 then
steertmp=abs(steer)
steertmp -= 1.4*timer_this
if steertmp<0 then steer=0 else steer=steertmp*sgn(steer)
end if
case 1 'links
if steer<>steermax then
steer += .8*timer_this
if steer>steermax then steer=steermax
end if
case 2 'rechts
if steer<>-steermax then
steer -= .8*timer_this
if steer<-steermax then steer=-steermax
end if
end select
'Ausrichtung der 1.Achse neuberechnen
CalcAlignment
do
if axl=firstaxle then 'betrifft nur die erste Achse
distance=velocity*timer_this 'Weg aus Geschwindigkeit und Zeit ermitteln
v=GetVector(alignment + steer) 'Summe aus Richtungswinkel der 1. Achse und der Steuerungswinkel ergibt
'einen Vektor für die Bewegungsrichtung
axl->oldpos=axl->posAxle 'alte Position merken
axl->posAxle.x +=v.x*distance * dircontrol
axl->posAxle.y +=v.y*distance * dircontrol
axl->posHitch=axl->posAxle
else 'alle anderen Achsen
axl->oldpos=axl->posHitch 'alte Position merken
'Zwischenposition, zur alten Position der Vorgängerin ziehen
v=GetVector(GetAngle(axl->prevaxle->oldpos,axl->posAxle))
v.x=axl->prevaxle->oldpos.x + v.x * (axl->distAxle - distance)
v.y=axl->prevaxle->oldpos.y + v.y * (axl->distAxle - distance)
'entgültige Position zur neuen Position der Vorgängerin berechnen
v=GetVector(GetAngle(axl->prevaxle->posHitch,v))
axl->posAxle.x=axl->prevaxle->posHitch.x + v.x*axl->distAxle
axl->posAxle.y=axl->prevaxle->posHitch.y + v.y*axl->distAxle
axl->posHitch.x=axl->prevaxle->posHitch.x + v.x*axl->distHitch
axl->posHitch.y=axl->prevaxle->posHitch.y + v.y*axl->distHitch
end if
axl=axl->nextaxle
loop until axl=0
timer_last=timer 'aktuelle Zeit für das nächstemal merken
steercontrol=0
velocontrol=0
end sub
sub set.CalcAlignment
if lastaxle<>firstaxle then
alignment=GetAngle(firstaxle->nextaxle->posAxle,firstaxle->posAxle)'Ausrichtung der 1.Achse neuberechnen
end if
end sub
sub set.DrawAxles
dim as axle ptr axl=firstaxle
dim as integer c
do
if axl=firstaxle then c=&HFFFFFF else c=&HFF7F00
circle(Xo + axl->posAxle.x , Yo - axl->posAxle.y ),6,c
circle(Xo + axl->posHitch.x , Yo - axl->posHitch.y ),3,&H00FF00
if axl<>firstaxle then line(Xo + axl->prevaxle->posHitch.x , Yo - axl->prevaxle->posHitch.y )-(Xo + axl->posAxle.x , Yo - axl->posAxle.y ),&HFFFFFF
axl=axl->nextaxle
loop until axl=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
constructor set
timer_this=0
timer_last=0
dircontrol=1
steermax=45/360 * doublepi
end constructor
destructor set
dim as axle ptr naxl,axl=firstaxle
if axl then
do
naxl=axl->nextaxle
delete axl
axl=naxl
loop until axl=0
end if
end destructor
'liefert die globale Richtung(in Bogenmaß) eines Punktes v vom Standpunkt b aus gesehen
function GetAngle(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.AddAxle()
truck.AddAxle(47,30)
truck.AddAxle(87,90)
/'
'Trekker mit 2 Anhänger
'Traktor
truck.AddAxle()
truck.AddAxle(40,45)
'2 achsiger Anhänger mit Zuggabel
truck.AddAxle(20,20)'vordere Achse, "Kupplung"/Aufhängung für hintere Achse an gleicher Stelle
truck.AddAxle(50,55)'hintere Achse
'2 achsiger Anhänger mit Zuggabel
truck.AddAxle(20,20)'vordere Achse, "Kupplung"/Aufhängung für hintere Achse an gleicher Stelle
truck.AddAxle(50,55)'hintere Achse
'/
screenres Xo*2,Yo*2,32
do
sleep 1
if multikey(fb.sc_w) then truck.Acceleration
if multikey(fb.sc_s) then truck.Deceleration
if multikey(fb.sc_a) then truck.ToLeft
if multikey(fb.sc_d) then truck.ToRight
if multikey(fb.sc_r) then truck.Reverse
if multikey(fb.sc_f) then truck.Foreward
truck.MoveAxles
screenlock
cls
'Koordinatensystem
line (0,Yo)-(Xo*2-1,Yo),&H007f00
line (Xo,0)-(Xo,Yo*2-1),&H7F0000
truck.DrawAxles
screenunlock
loop until inkey=chr(27)
end