Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
(k)einspurmodell
| Uploader: |  Muttonhead |
| Datum/Zeit: | 31.10.2011 21:08:50 |
'Einspur-Achsenmodel_00.bas
'weit entfernt von Physik und Realität
#include "fbgfx.bi"
const as integer Xo=400,Yo=300
const as double pi =atn (1) * 4
const as double doublepi=pi*2
screenres Xo*2,Yo*2,32
type vector
x as double
y as double
end type
declare function GetAngle(b as vector,v as vector) as double
declare function GetVector(align as double) as vector
type axle
prevaxle as axle ptr 'Zeiger auf Vorgänger
nextaxle as axle ptr 'Zeiger auf Nachfolger
position as vector
dist as integer 'Entfernung dieser Achse zum Vorgänger, 0 bei erster Achse
end type
type set
alignment as double 'globale Richtung des "Zugfahrzeugs"(definiert durch die Lage von 1. und 2. Achse)
steer as double 'Lenkwinkel/ Bewegungsrichtung der ersten Achse
speed as double 'Geschwindigkeit Einheiten/Sekunde im Koordinatensystem
reverse as integer '1 wenn Rückwärtsgang, Speed muß 0 sein
tmr as double 'Zeitpunkt der letzten Bewegung/Berechnung
firstaxle as axle ptr 'Zeiger auf erste Achse
lastaxle as axle ptr 'Zeiger auf letzte Achse
declare function AddAxle(dist as integer=0,align as double=0) as integer
declare sub MoveAxles
declare sub CalcAlignment
declare sub DrawAxles
declare sub Faster
declare sub Slower
declare sub ToLeft
declare sub ToRight
declare destructor
end type
'Achsenfolge wird immer vom Koordinatenursprung erzeugt, soll heißen: 1. Achse ist immer in (0,0)
function set.AddAxle(dist as integer=0,direction as double=0) as integer
dim as axle ptr tmp
dim as vector v
tmp=new axle
if tmp then
if lastaxle=0 then'wenn noch keine Achse, dann...
tmp->prevaxle=0
tmp->nextaxle=0
tmp->dist=0
tmp->position.x=0
tmp->position.y=0
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 Punkt
v=GetVector(direction)'Richtungsvektor erzeugen, dessen Länge ist 1
'Position der vorhergehenden Achse + Skalarmultiplikation des Vektors mit dist... Keine Ahnung davon
tmp->position.x=lastaxle->position.x + v.x*dist
tmp->position.y=lastaxle->position.y + v.y*dist
'Entfernung merken
tmp->dist=dist
end if
lastaxle=tmp' erzeugt 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 double t,l
'Timersteuerung
if tmr then t= timer-tmr else t=0'Zeit seit letzter Bewegung
CalcAlignment'Ausrichtung der 1.Achse neuberechnen
do
if axl=firstaxle then 'betrifft nur die erste Achse
l=speed*t 'aus Geschwindigkeit und Zeit den Weg ermitteln
'Bewegung der 1. Achse
v=GetVector(alignment + steer) 'Summe aus Richtungswinkel der 1. Achse und der Steuerungswinkel ergibt einen Vektor für die Bewegungsrichtung
print alignment,steer
axl->position.x +=v.x*l
axl->position.y +=v.y*l
else 'alle anderen Achsen jeweils in Richtung ihrer Vorgängerin ziehen
'Vektor von vorhergehender Achse neue Position in Richtung diese Achse alte Position.
v=GetVector(GetAngle(axl->prevaxle->position,axl->position))
axl->position.x=axl->prevaxle->position.x + v.x*axl->dist
axl->position.y=axl->prevaxle->position.y + v.y*axl->dist
end if
axl=axl->nextaxle
loop until axl=0
tmr=timer 'aktuelle Zeit für das nächstemal merken
end sub
sub set.CalcAlignment
if lastaxle<>firstaxle then
alignment=GetAngle(firstaxle->nextaxle->position,firstaxle->position)'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->position.x , Yo - axl->position.y ),5,c
if axl<>firstaxle then line(Xo + axl->prevaxle->position.x , Yo - axl->prevaxle->position.y )-(Xo + axl->position.x , Yo - axl->position.y ),&HFFFFFF
axl=axl->nextaxle
loop until axl=0
end sub
sub set.Faster
speed +=1
if speed>50 then speed=50
end sub
sub set.Slower
speed -=1
if speed<-20 then speed=-20
end sub
sub set.ToLeft
steer +=1
if steer>30 then steer=30
end sub
sub set.ToRight
steer -=1
if steer<-30 then steer=-30
end sub
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 eines Punktes v vom Standpunkt b aus gesehen (in Grad)
function GetAngle(b as vector,v as vector) as double
dim as double 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/doublepi) * 360
end function
'liefert eine Richtung (in Grad) als Richtungsvektor
function GetVector(align as double) as vector
dim as double arcus
dim as vector v
if align>=360 then align=align-360
if align<0 then align=360+align
arcus=(align/360) * doublepi
v.x=cos(arcus)
v.y=sin(arcus)
function=v
end function
'****************************************************************************************
dim as set truck
truck.AddAxle()
truck.AddAxle(40,0)
truck.AddAxle(90,30)
truck.speed=0
truck.steer=0
dim as integer exitsignal=0
do
if multikey(fb.sc_w) then truck.Faster
if multikey(fb.sc_s) then truck.Slower
if multikey(fb.sc_a) then truck.ToLeft
if multikey(fb.sc_d) then truck.ToRight
if multikey(fb.sc_escape) then exitsignal=1
screenlock
cls
'Koordinatensystem
line (0,Yo)-(Xo*2-1,Yo),&H007f00
line (Xo,0)-(Xo,Yo*2-1),&H7F0000
pset(Xo,Yo),&HFFFFFF
truck.DrawAxles
screenunlock
truck.MoveAxles
sleep 1
loop until exitsignal
end