axle model

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
Muttonhead
Posts: 143
Joined: May 28, 2009 20:07

Re: axle model

Post by Muttonhead »

... I had a look in the old folder to see what other strange things were created with the axle model.
Ok, the comments are in German, I apologize for that, a self-steering thing that always heads for a certain target marker.
it's exciting to watch the whole thing:

Code: Select all

screen 19,32
randomize timer

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

'******************************************************************************

type axle
  mounting  as single 'Entfernung dieser Achse zu einem vorhergehenden Aufhängungspunkt,
  position  as vector 'Position der Achse
end type

'******************************************************************************

'Die Lage dieser Punkte wird durch den relativen Winkel zur Kameramittelachse
'und der Entfernung zum Null-Punkt definiert.
'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

'******************************************************************************

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 function Rotation (v1 as vector, v2 as vector, v3 as vector) as integer

'******************************************************************************

type target
  radius as integer
  position as vector
  declare constructor
  declare sub RandomSet
  declare sub DrawTarget
end type



constructor target
  radius=10
  RandomSet
end constructor



sub target.RandomSet
  dim as integer w,h
  w=scrnw-radius*10
  h=scrnh-radius*10
  position.x=rnd*(w)-(w/2)
  position.y=rnd*(h)-(h/2)
end sub



sub target.DrawTarget
  circle(Xo+position.x,Yo-position.y),radius,&H006600
end sub

'******************************************************************************

'Kameraobjekt
type cameraobj
  align       as single   'globaler Winkel/Richtung der Kamera
  axl(1)      as axle     '0 und 1 für Achsen definiert die Richtung

  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

  vmax        as single   'Höchstgeschwindigkeit
  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 double   'aktuell vergangene Zeit seit timer_last
  timer_last  as double   'Systemzeit letzten Bewegung/Berechnung

  'Hilfsvariablen
  oldpoint    as vector
  v           as vector
  l           as vector
  d           as vector

  t           as single
  distance    as single
  steertmp    as single

  sccoords(4) as vector

  declare constructor
  declare destructor

  declare sub MoveCamera

  declare sub Deceleration
  declare sub RollOut
  declare sub Acceleration
  declare sub ToLeft
  declare sub ToRight
  declare sub SteerToTarget(t as target)
  declare function TargetAchieved (t as target) as integer
  declare sub Drawcamera(t as target)
end type



constructor cameraobj
  timer_this=0
  timer_last=0
  vmax=200
  dircontrol=1
  steermax=45/360 * doublepi
  
  'Ausrichtung nach links 180 grd
  align=pi
  'Achsen
  axl(0).mounting=0
  axl(1).mounting=10

  'Achsen verorten
  axl(0).position.x=0
  axl(0).position.y=0

  axl(1).position.x=axl(0).position.x + axl(1).mounting
  axl(1).position.y=axl(0).position.y
end constructor



destructor cameraobj
end destructor



sub cameraobj.MoveCamera

    'Timersteuerung
    if timer_last then timer_this = timer-timer_last

    'Geschwindigkeit berechnen
    select case velocontrol
      case -2
        if velocity>0 then
          velocity -=vmax*2*timer_this
          if velocity<0 then velocity=0
        end if
      case -1
        if velocity>0 then
          velocity -=5*timer_this
          if velocity<0 then velocity=0
        end if

      case 0

      case 1
        if velocity<vmax then
          velocity +=vmax*timer_this
          if velocity>vmax then velocity=vmax
        end if
    end select

    'Lenkeinschlag berechnen
    if steercontrol=0 and steer<>0 then  'steer=0'gerade
      steertmp=abs(steer)
      steertmp -= 100*timer_this
      if steertmp<0 then steer=0 else steer=steertmp*sgn(steer)
    end if

    if steercontrol=1 and steer<>steermax then 'links
      if steer<0 then steer += 10*timer_this else steer += .11*timer_this
      if steer>steermax then steer=steermax
    end if

    if steercontrol=-1 and steer<>-steermax then 'rechts
      if steer>0 then steer -= 10*timer_this else steer -= .11*timer_this
      if steer<-steermax then steer=-steermax
    end if

    distance=velocity*timer_this 'Weg aus Geschwindigkeit und Zeit ermitteln
    d=GetVector(align + steer)   'Summe aus Richtungswinkel der 1. Achse und der Steuerungswinkel ergibt

    'neue Position 1.Achse berechnen
    oldpoint=axl(0).position'alte Position 1.Achse merken
    axl(0).position.x +=d.x*distance * dircontrol
    axl(0).position.y +=d.y*distance * dircontrol

    'neue Position 2.Achse berechnen (mit Zwischenposition)
    d=GetVector(GetArcus(oldpoint,axl(1).position))
    l.x=oldpoint.x + d.x * (axl(1).mounting - distance)
    l.y=oldpoint.y + d.y * (axl(1).mounting - distance)
    d=GetVector(GetArcus(axl(0).position,l))
    axl(1).position.x=axl(0).position.x + d.x * axl(1).mounting
    axl(1).position.y=axl(0).position.y + d.y * axl(1).mounting

    'neue Ausrichtung der Kamera berechnen
    align=GetArcus(axl(1).position,axl(0).position)

    timer_last=timer   'aktuelle Zeit für das nächstemal merken
    steercontrol=0
    velocontrol=0
end sub



sub cameraobj.Deceleration
  velocontrol=-2
end sub


sub cameraobj.Acceleration
  velocontrol=1
end sub



sub cameraobj.ToLeft
  steercontrol=1
end sub



sub cameraobj.ToRight
  steercontrol=-1
end sub


sub cameraobj.SteerToTarget(t as target)
  dim as integer turn
  if velocity>vmax/2 then
    if abs(steer)< steermax/2 then Acceleration else Deceleration
  else
    Acceleration
  end if
  turn=Rotation(axl(0).position, t.position, axl(1).position)
  if turn =1 then ToLeft
  if turn=-1 then ToRight
end sub



function cameraobj.TargetAchieved (t as target) as integer
  function=0
  if GetDistance(axl(1).position,t.position)<=t.radius then function=1
end function



sub cameraobj.DrawCamera(t as target)
  line (Xo + axl(0).position.x,Yo - axl(0).position.y)-(Xo + axl(1).position.x,Yo - axl(1).position.y),&HFF3F00
  'pset (Xo + axl(0).position.x,Yo - axl(0).position.y),&HFFFFFF
end sub



'******************************************************************************
'Hilfsfunktionen

'liefert 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)
   'AsmBooster von Volta
   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
 


'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)
   'AsmBooster von Volta
   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
 


'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)
   'AsmBooster von Volta
   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


function Rotation (v1 as vector, v2 as vector, v3 as vector) as integer
'benutzt das sog. Kreuzprodukt von Vektoren
'um heraus zu bekommen, ob die Reihenfolge der Vectoren
'links- oder rechtsherum ist.
'nach M.Apetri; dont ask me!!!
	function=0
	dim as single t
	t=(v3.x - v1.x) * (v2.y - v1.y) - (v3.y - v1.y) * (v2.x - v1.x)
	if t<0 then function=1
	if t>0 then function=-1
end function

'******************************************************************************
'******************************************************************************
'******************************************************************************

dim as cameraobj cam
dim as target t

do
  sleep 1

  cam.SteerToTarget(t)
  cam.MoveCamera
  if cam.TargetAchieved(t) then t.RandomSet'Wenn Ziel erreicht, Ziel neu positionieren
  screenlock
    'cls
    cam.DrawCamera (t)
    t.DrawTarget

    'Koordinatensystem
    line (0,Yo)-(Xo*2-1,Yo),&H007F00
    line (Xo,0)-(Xo,Yo*2-1),&H7F0000
  screenunlock
loop until inkey=chr(27)
end
Top
Roland Chastain
Posts: 1022
Joined: Nov 24, 2011 19:49
Location: France
Contact:
Contact Roland Chastain

Re: axle model

Post by Roland Chastain »

I like this vector stuff. Thank you for sharing.

By the way, we could put functions (with 32 and 64-bit assembler) in a separate BI file.
Top
BasicCoder2
Posts: 3955
Joined: Jan 01, 2009 7:03
Location: Australia

Re: axle model

Post by BasicCoder2 »

Did a google translation of comments.

Code: Select all

reen 19,32
randomize timer

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

'******************************************************************************

type axle
  mounting  as single 'Distance of this axis to a previous suspension point,
  position  as vector 'Position of the axis
end type

'******************************************************************************

'The position of these points is defined by the relative angle to the camera's
'center axis and the distance to the zero point.
'The graphic is constructed from such points
type bodypoint
  align    as single 'Shop
  distance as single 'Distance to zero point
  position as vector 'Position of this point
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 function Rotation (v1 as vector, v2 as vector, v3 as vector) as integer

'******************************************************************************

type target
  radius as integer
  position as vector
  declare constructor
  declare sub RandomSet
  declare sub DrawTarget
end type



constructor target
  radius=10
  RandomSet
end constructor



sub target.RandomSet
  dim as integer w,h
  w=scrnw-radius*10
  h=scrnh-radius*10
  position.x=rnd*(w)-(w/2)
  position.y=rnd*(h)-(h/2)
end sub



sub target.DrawTarget
  circle(Xo+position.x,Yo-position.y),radius,&H006600
end sub

'******************************************************************************

'Kameraobjekt
type cameraobj
  align       as single   'global angle/direction of the camera
  axl(1)      as axle     '0 and 1 for axes defines the direction

  steer       as single   'Steering angle/direction of movement of the first axle
  steermax    as single   'Max. steering angle in radians, set in the Constructor
  steercontrol as integer '1=Left 0=Straight 2=Right

  vmax        as single   'Top speed
  velocity    as single   'Speed ??units/second in the coordinate system
  velocontrol as integer  '1=Accelerate 0=Coast 2=Decelerate

  dircontrol  as integer  '1=Forward -1=Backward

  timer_this  as double   'current time elapsed since timer_last
  timer_last  as double   'System time of last movement/calculation

  'auxiliary variables
  oldpoint    as vector
  v           as vector
  l           as vector
  d           as vector

  t           as single
  distance    as single
  steertmp    as single

  sccoords(4) as vector

  declare constructor
  declare destructor

  declare sub MoveCamera

  declare sub Deceleration
  declare sub RollOut
  declare sub Acceleration
  declare sub ToLeft
  declare sub ToRight
  declare sub SteerToTarget(t as target)
  declare function TargetAchieved (t as target) as integer
  declare sub Drawcamera(t as target)
end type



constructor cameraobj
  timer_this=0
  timer_last=0
  vmax=200
  dircontrol=1
  steermax=45/360 * doublepi
  
  'Alignment to the left 180 degrees
  align=pi
  'Axles
  axl(0).mounting=0
  axl(1).mounting=10

  'Locate axes
  axl(0).position.x=0
  axl(0).position.y=0

  axl(1).position.x=axl(0).position.x + axl(1).mounting
  axl(1).position.y=axl(0).position.y
end constructor



destructor cameraobj
end destructor



sub cameraobj.MoveCamera

    'Timer control
    if timer_last then timer_this = timer-timer_last

    'Calculate speed
    select case velocontrol
      case -2
        if velocity>0 then
          velocity -=vmax*2*timer_this
          if velocity<0 then velocity=0
        end if
      case -1
        if velocity>0 then
          velocity -=5*timer_this
          if velocity<0 then velocity=0
        end if

      case 0

      case 1
        if velocity<vmax then
          velocity +=vmax*timer_this
          if velocity>vmax then velocity=vmax
        end if
    end select

    'Calculate steering angle
    if steercontrol=0 and steer<>0 then  'steer=0'straight
      steertmp=abs(steer)
      steertmp -= 100*timer_this
      if steertmp<0 then steer=0 else steer=steertmp*sgn(steer)
    end if

    if steercontrol=1 and steer<>steermax then 'links
      if steer<0 then steer += 10*timer_this else steer += .11*timer_this
      if steer>steermax then steer=steermax
    end if

    if steercontrol=-1 and steer<>-steermax then 'right
      if steer>0 then steer -= 10*timer_this else steer -= .11*timer_this
      if steer<-steermax then steer=-steermax
    end if

    distance=velocity*timer_this 'Determine path from speed and time
    d=GetVector(align + steer)   'The sum of the direction angle of the 1st axis and the steering angle results in

    'Calculate new position 1st axis
    oldpoint=axl(0).position'Remember old position of 1st axis
    axl(0).position.x +=d.x*distance * dircontrol
    axl(0).position.y +=d.y*distance * dircontrol

    'Calculate new position of 2nd axis (with intermediate position)
    d=GetVector(GetArcus(oldpoint,axl(1).position))
    l.x=oldpoint.x + d.x * (axl(1).mounting - distance)
    l.y=oldpoint.y + d.y * (axl(1).mounting - distance)
    d=GetVector(GetArcus(axl(0).position,l))
    axl(1).position.x=axl(0).position.x + d.x * axl(1).mounting
    axl(1).position.y=axl(0).position.y + d.y * axl(1).mounting

    'Calculate new camera orientation
    align=GetArcus(axl(1).position,axl(0).position)

    timer_last=timer   'remember current time for next time
    steercontrol=0
    velocontrol=0
end sub



sub cameraobj.Deceleration
  velocontrol=-2
end sub


sub cameraobj.Acceleration
  velocontrol=1
end sub



sub cameraobj.ToLeft
  steercontrol=1
end sub



sub cameraobj.ToRight
  steercontrol=-1
end sub


sub cameraobj.SteerToTarget(t as target)
  dim as integer turn
  if velocity>vmax/2 then
    if abs(steer)< steermax/2 then Acceleration else Deceleration
  else
    Acceleration
  end if
  turn=Rotation(axl(0).position, t.position, axl(1).position)
  if turn =1 then ToLeft
  if turn=-1 then ToRight
end sub



function cameraobj.TargetAchieved (t as target) as integer
  function=0
  if GetDistance(axl(1).position,t.position)<=t.radius then function=1
end function



sub cameraobj.DrawCamera(t as target)
  line (Xo + axl(0).position.x,Yo - axl(0).position.y)-(Xo + axl(1).position.x,Yo - axl(1).position.y),&HFF3F00
  'pset (Xo + axl(0).position.x,Yo - axl(0).position.y),&HFFFFFF
end sub



'******************************************************************************
'Auxiliary functions

'provides distance of 2 position vectors according to 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)
   
   'AsmBooster from Volta
   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
 


'returns the global direction (in radians) of a point v seen from the viewpoint b
 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)
   
   'AsmBooster from Volta
   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
 


'returns a direction (in radians) as a direction vector
 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)
   
   'AsmBooster from Volta
   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


function Rotation (v1 as vector, v2 as vector, v3 as vector) as integer
'uses the so-called cross product of vectors
'to determine whether the order of the vectors
'is counterclockwise or clockwise.
'according to M. Apetri; don't ask me!!!
	function=0
	dim as single t
	t=(v3.x - v1.x) * (v2.y - v1.y) - (v3.y - v1.y) * (v2.x - v1.x)
	if t<0 then function=1
	if t>0 then function=-1
end function

'******************************************************************************
'******************************************************************************
'******************************************************************************

dim as cameraobj cam
dim as target t

do
  sleep 1

  cam.SteerToTarget(t)
  cam.MoveCamera
  if cam.TargetAchieved(t) then t.RandomSet'When target is reached, reposition target
  screenlock
    'cls
    cam.DrawCamera (t)
    t.DrawTarget

    'Coordinate system
    line (0,Yo)-(Xo*2-1,Yo),&H007F00
    line (Xo,0)-(Xo,Yo*2-1),&H7F0000
  screenunlock
loop until inkey=chr(27)
end
Top
Roland Chastain
Posts: 1022
Joined: Nov 24, 2011 19:49
Location: France
Contact:
Contact Roland Chastain

Re: axle model

Post by Roland Chastain »

Thank you BasicCoder2!
Top
Post Reply

Return to “Sources, Examples, Tips and Tricks”