Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
spielerei fourier
| Uploader: |  Muttonhead |
| Datum/Zeit: | 27.08.2025 06:13:48 |
#include "fbgfx.bi"
'math**************************************************************************
'******************************************************************************
'******************************************************************************
const as double doublepi =atn (1) * 8
const as double pi =atn (1) * 4
const as double halfpi =atn (1) * 2
const as double quarterpi =atn (1)
'******************************************************************************
type vector
x as double
y as double
end type
'******************************************************************************
'bringt ein Bogenmaß in den Bereich von 0 bis 2PI
'! BYREF es wir die übergebene Variable verändert
sub RadiansInRange (byref Rad as double)
if Rad>=doublepi then Rad=Rad-doublepi
if Rad<0 then Rad=doublepi+Rad
end sub
'liefert Entfernung 2er Ortsvektoren nach Pythagoras
function GetDistance(origin as vector, dest as vector) As double
dim as double dx,dy
dx=dest.x - origin.x
dy=dest.y - origin.y
return sqr(dx*dx + dy*dy)
end function
'liefert das Quadrat der Entfernung 2er Ortsvektoren nach Pythagoras, erspart SQR
function GetDistanceP2(origin as vector, dest as vector) As double
dim as double dx,dy
dx=dest.x - origin.x
dy=dest.y - origin.y
return dx*dx + dy*dy
end function
'Richtung(als Bogenmaß) des Punktes dest vom Standpunkt origin aus betrachtet
function GetRad overload(origin as vector,dest as vector) as double
dim as double Rad
dim as vector delta
delta.x= dest.x - origin.x
delta.y= dest.y - origin.y
Rad=atan2(delta.y,delta.x)
if sgn(Rad)=-1 then Rad= doublepi + Rad
return Rad
end function
'wandelt einen Richtungsvektor zu Bogenmaß
function GetRad (v as vector) as double
dim as double Rad=atan2(v.y,v.x)
if sgn(Rad)=-1 then Rad= doublepi + Rad
return Rad
end function
'wandelt Bogenmaß zu Richtungsvektor
'distance stellt ein Skalar dar, der optional benutzt werden kann
function GetVector overload(Rad as double,distance as double=1) as vector
dim as vector v
RadiansInRange(Rad)
v.x=cos(Rad)*distance
v.y=sin(Rad)*distance
return v
end function
'"normalisiert" Richtungsvektor, skalierbar
function GetVector (origin as vector,distance as double=1) as vector
dim as double l
l=sqr(origin.x*origin.x + origin.y*origin.y)
origin.x *=distance/l
origin.y *=distance/l
return origin
end function
'Richtung zu dest als Vector,skalierbar
function GetVector (origin as vector,dest as vector,distance as double=1) as vector
dim as double l
dim as vector delta
delta.x= dest.x - origin.x
delta.y= dest.y - origin.y
l=sqr(delta.x*delta.x + delta.y*delta.y)
delta.x *=distance/l
delta.y *=distance/l
return delta
end function
'liefert die nach links zeigende Normale als Vektor mit Länge 1
function GetLeftNormal (origin as vector,dest as vector) as vector
dim as double l
dim as vector delta,normal
delta.x= dest.x - origin.x
delta.y= dest.y - origin.y
l=sqr(delta.x*delta.x + delta.y*delta.y)
delta.x /=l
delta.y /=l
normal.x=-delta.y
normal.y=delta.x
return normal
end function
'liefert die nach rechts zeigende Normale als Vektor mit Länge 1
function GetRightNormal (origin as vector,dest as vector) as vector
dim as double l
dim as vector delta,normal
delta.x= dest.x - origin.x
delta.y= dest.y - origin.y
l=sqr(delta.x*delta.x + delta.y*delta.y)
delta.x /=l
delta.y /=l
normal.x=delta.y
normal.y=-delta.x
return normal
end function
function IsLeft(linestart as vector, lineend as vector, cpoint as vector) as integer
if ((linestart.x - cpoint.x) * (lineend.y - cpoint.y) - _
(linestart.y - cpoint.y) * (lineend.x - cpoint.x))>0 then return 1
return 0
end function
'******************************************************************************
'neues Zeugs
'liefert die nach links zeigende Normale als Vector
function GetLeft (v as vector) as vector
dim as vector n
n.x=-v.y
n.y=v.x
return n
end function
'liefert die nach rechts zeigende Normale als Vector
function GetRight (v as vector) as vector
dim as vector n
n.x=v.y
n.y=-v.x
return n
end function
'liefert den umgekehrten Vektor
function GetReverse (v as vector) as vector
dim as vector n
n.x=-v.x
n.y=-v.y
return n
end function
'liefert den Winkel den 3 Punkte bilden, positiver Drehsinn(=gegen Uhrzeiger) beachten, als Bogenmaß
function GetRad(a as vector, b as vector, c as vector) as double
dim as double rad
rad=GetRad(b,c)-GetRad(b,a)
RadiansInRange(rad)
return rad
end function
'Verschiebt Vektor a um Vektor b
'BYREF Vektor a wird verändert!!!
sub ShiftVector(byref a as vector, b as vector)
a.x+=b.x
a.y+=b.y
end sub
'game objects******************************************************************
'******************************************************************************
'******************************************************************************
'Koordinatenursprung auf dem Screen:
const as integer CoordX=400
const as integer CoordY=300
type drive
public:
DrivePos as vector 'globale Position des Antriebs
Radius as double 'BewegungsRadius der Kupplung
Speed as double 'Winkelgeschwindigkeit der Kupplung als Bogenmaß/Sekunde
Connector as vector 'globale Position Kupplung
declare sub InitDrive (startpos as double=0)
declare sub RunDrive (frametime as double)
declare sub MoveDrive (NewPos as vector)
declare sub DrawDrive (img as FB.Image ptr = 0)
private:
localpos as double 'lokale Position der Kupplung in Bogenmaß
end type
sub drive.InitDrive (startpos as double=0)
localpos=startpos'interne lokale Position der Kupplung merken in Bogenmaß
Connector=GetVector(localpos,Radius)'lokale Position als Vektor setzen
ShiftVector(Connector,DrivePos)'verschieben zu global, denn DrivePos ist global
end sub
sub drive.RunDrive (frametime as double)
localpos+=Speed*frametime'Geschwindigkeit "herunterbrechen" auf Winkel/Framezeit und intern aufsummen
RadiansInRange localpos' Wert in 0-2Pi Bereich bringen
Connector=GetVector(localpos,Radius)'lokal Position als Vektor neu setzen
ShiftVector(Connector,DrivePos)'verschieben zu global, denn DrivePos ist global
end sub
sub drive.MoveDrive (NewPos as vector)
DrivePos=NewPos'es muß wohl nicht mehr gemacht werden, nun gut
end sub
sub drive.DrawDrive (img as FB.Image ptr = 0)
circle img, (CoordX+DrivePos.x,CoordY-DrivePos.y),Radius,&H444444
line img, (CoordX+DrivePos.x,CoordY-DrivePos.y)-(CoordX+Connector.x,CoordY-Connector.y),&HCCAA44
circle img, (CoordX+Connector.x,CoordY-Connector.y),3,&H00AA00
end sub
'Start'************************************************************************
'******************************************************************************
'******************************************************************************
const SCREEN_W = 800, SCREEN_H = 600
screenres SCREEN_W, SCREEN_H, 32
dim as FB.Image ptr bild1 = imagecreate(SCREEN_W, SCREEN_H), bild2 = imagecreate(SCREEN_W, SCREEN_H, 0)
dim as double oldtime,currtime,frametime
redim as drive m(0)'dynamisch
dim as integer units,NumMotors
dim as double speed
NumMotors=3' 300
units=250 'Amplitude
speed=pi/10 'Frequenz
redim as drive m(NumMotors-1)
'ersten Motor konfigurieren
m(0).DrivePos.x=0
m(0).DrivePos.y=0
m(0).Radius=units
m(0).Speed=speed
m(0).InitDrive 0
'Folgemotoren konfigurieren
for i as integer=1 to NumMotors-1
'm(i).MoveDrive m(i-1).Connector 'Positionierung hier noch nicht wichtig
m(i).Radius=units/(i*2+1) 'keine Ahnung, jeder folgende Motor wird im Radius entsprechend kleiner
m(i).Speed=speed*(i*2+1) 'alle ungeraden Vielfachen der Ausgangsgeschwindigkeit(Frequenz), also Speedx3,5,7,9 usw
m(i).InitDrive 0
'jeden 2.Motor negativer Drehsinn und
'beginnt mit Drehung um halbe Phase verschoben
if (i mod 2) then
m(i).Speed *=-1
m(i).InitDrive +pi
end if
next i
dim key as string
dim as integer posX = -1, posY
currtime=timer
do
sleep 1
oldtime=currtime
currtime=timer
frametime=currtime-oldtime
m(0).RunDrive(frametime)
for i as integer=1 to NumMotors-1
m(i).MoveDrive m(i-1).Connector
m(i).RunDrive(frametime)
next i
key=inkey
' Bild vom Gerät zeichnen (bild1, auf transparentem Hintergrund)
line bild1, (0, 0)-(799, 599), &hff00ff, bf
for i as integer=0 to NumMotors-1
m(i).DrawDrive (bild1)
next i
' resultierende Zeichnung zeichnen (bild2)
if posX < 0 then
pset bild2, (CoordX+m(NumMotors-1).Connector.x,CoordY-m(NumMotors-1).Connector.y), &HFF0000
else
line bild2, (posX, posY)-(CoordX+m(NumMotors-1).Connector.x,CoordY-m(NumMotors-1).Connector.y), &HFF0000
end if
posX = CoordX+m(NumMotors-1).Connector.x
posY = CoordY-m(NumMotors-1).Connector.y
' Ausgabe beider Bilder
screenlock
put (0, 0), bild2, pset
put (0, 0), bild1, trans
screenunlock
loop until key="q" or key= chr(255, 107)
put (0, 0), bild2, pset
imagedestroy bild1
imagedestroy bild2
if key <> chr(255, 107) then
print "press any key"
sleep
end if