axle model

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

axle model

Post by Muttonhead »

truck parking game? alfa kilo's project reminds me, that I tried something similar a few months ago. It's an axle model only:

w=accelerate
s=brake
a=left
d=right


if the truck has stopped:
r=backward
f=foreward

Code: Select all

screen 19,32
print
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

'points on the vehicle centre line
'could be real axles or hitches
type axle
  used      as single '"flag" is this axle in use?
  mounting  as single 'distance to an previous axle
  position  as vector 'global position
end type


/'

         ---                   ---
          |                     |
  <-----axl(0)----------------axl(1)--axl(2)
          |                     |
         ---                   ---


'/
'container
type vessel
  prevvessel as vessel ptr
  nextvessel as vessel ptr

  vtype         as integer

  align         as single
  axl(2)        as axle '0 and 1 for real axles, 2 for hitch
end type

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)
declare sub CalcPositions (v as vessel ptr)

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

'gesamter Zug
type set
  steer       as single   'steer angle/ moving direction of axle(0)
  steermax    as single
  steercontrol as integer '1=left  0=straight   2=right

  velocity    as single
  velocontrol as integer  '1=accelerate  0=roll out  2=brake

  dircontrol  as integer  '1=foreward -1=back

  timer_this  as single   'time managment
  timer_last  as single


  firstvessel  as vessel ptr 'linked list
  lastvessel   as vessel ptr

  'help variables
  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 MoveAll

  declare sub Acceleration
  declare sub Deceleration
  declare sub ToLeft
  declare sub ToRight
  declare sub Foreward
  declare sub Reverse

  declare sub DrawVessels
end type

constructor set
  timer_this=0
  timer_last=0
  dircontrol=1
  steermax=45/360 * doublepi
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

  'hitching rules
  if lastvessel=0 then  'if nothing exists

    if vtype<5 then possible=1' firstvessel must be a tractor

  else                  ' if something exist...

    if vtype>4 then     'trailer only alowed
      possible=1

      'exceptions for trailers
      if lastvessel->vtype=1 and vtype<>5 then possible=0'road tractor -> semi trailer
      if lastvessel->vtype=2 and vtype<>6 then possible=0'tractor -> trailer
      if lastvessel->vtype=5 and vtype=5 then possible=0'semi trailer -> semi trailer not possible
    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 'link first vessel(tractor)
        firstvessel=tmp
        lastvessel=tmp
      else            'link trailers
        lastvessel->nextvessel=tmp
        tmp->prevvessel=lastvessel
        lastvessel=tmp
        'move the trailer to the hitch
        HitchUpVessel(lastvessel)
      end if


      function=possible

    end if

  end if

end function



sub set.HitchUpVessel (vess as vessel ptr)
  l=vess->prevvessel->axl(2).position
  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

  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
end sub



sub set.MoveAll
  'Timer stuff
  if timer_last then timer_this = timer-timer_last
  timer_last=timer

  'speed calculation
  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


  'steer calculations
  if steercontrol=0 and steer<>0 then 'straight
    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 'left
    steer += 1*timer_this
    if steer>steermax then steer=steermax
  end if

  if steercontrol=2 and steer<>-steermax then 'right
    steer -= 1*timer_this
    if steer<-steermax then steer=-steermax
  end if


  vess=firstvessel
  do
    if vess=firstvessel then 'tractor axle calculations

      distance=velocity*timer_this   'calc the distance
      d=GetVector(vess->align + steer) 'direction to move the first axle

      'new position first axle (axl(0))
      oldpoint=vess->axl(0).position'remember old position
      vess->axl(0).position.x +=d.x*distance * dircontrol
      vess->axl(0).position.y +=d.y*distance * dircontrol

      'new position second axle (axl(1))
      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))'vector d isis also direction for hitch(axle(2))
      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

      'new position third axle (axl(2)) hitch
      oldpoint=vess->axl(2).position
      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

      vess->align=GetArcus(vess->axl(1).position,vess->axl(0).position)

    else 'Trailer

      'new position axle(0)
      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))

      oldpoint=vess->axl(0).position
      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 'if normal trailer

        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))
        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

        vess->align=GetArcus(vess->axl(1).position,vess->axl(0).position)

      else 'if semi trailer

        vess->align=GetArcus(vess->axl(0).position,vess->prevvessel->axl(2).position)

      end if

    end if

    'new position third axle (axl(2)) hitch
    oldpoint=vess->axl(2).position
    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

    vess=vess->nextvessel
  loop until vess=0

  steercontrol=0
  velocontrol=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



sub set.DrawVessels
  vess=firstvessel
  if vess then
    do
      select case vess->vtype
        case 1,2
          circle (Xo + vess->axl(0).position.x , Yo - vess->axl(0).position.y),5,&H0000FF
          line (Xo + vess->axl(0).position.x , Yo - vess->axl(0).position.y) - (Xo + vess->axl(1).position.x , Yo - vess->axl(1).position.y),&H00FF00
          circle (Xo + vess->axl(1).position.x , Yo - vess->axl(1).position.y),5,&HFF0000
          circle (Xo + vess->axl(2).position.x , Yo - vess->axl(2).position.y),3,&H00FF00

        case 5
          line (Xo + vess->prevvessel->axl(2).position.x , Yo - vess->prevvessel->axl(2).position.y) - (Xo + vess->axl(0).position.x , Yo - vess->axl(0).position.y),&HFF7F00
          circle (Xo + vess->axl(0).position.x , Yo - vess->axl(0).position.y),5,&HFF0000
          circle (Xo + vess->axl(2).position.x , Yo - vess->axl(2).position.y),3,&H00FF00

        case 6
          line (Xo + vess->prevvessel->axl(2).position.x , Yo - vess->prevvessel->axl(2).position.y) - (Xo + vess->axl(0).position.x , Yo - vess->axl(0).position.y),&HFF7F00
          circle (Xo + vess->axl(0).position.x , Yo - vess->axl(0).position.y),5,&H0000FF
          line (Xo + vess->axl(0).position.x , Yo - vess->axl(0).position.y) - (Xo + vess->axl(1).position.x , Yo - vess->axl(1).position.y),&H00FF00
          circle (Xo + vess->axl(1).position.x , Yo - vess->axl(1).position.y),5,&HFF0000
          circle (Xo + vess->axl(2).position.x , Yo - vess->axl(2).position.y),3,&H00FF00

      end select
      vess=vess->nextvessel
    loop until vess=0
  end if
end sub
'******************************************************************************
'******************************************************************************
'******************************************************************************


'**************************************
'definition of possible trucks,traktors,trailers

sub SetTractorA (v as vessel ptr)
  v->vtype=1
  'front to left 180 grd
  v->align=pi
  '************************************
  v->axl(0).used=1
  v->axl(0).mounting=0
  v->axl(1).used=1
  v->axl(1).mounting=80
  v->axl(2).used=1
  v->axl(2).mounting=50
  CalcPositions (v)
end sub


sub SetTractorB (v as vessel ptr)
  v->vtype=2
  'front to left 180 grd
  v->align=pi
  '************************************
  v->axl(0).used=1
  v->axl(0).mounting=0
  v->axl(1).used=1
  v->axl(1).mounting=40
  v->axl(2).used=1
  v->axl(2).mounting=50
  CalcPositions (v)
end sub


sub SetTrailerA (v as vessel ptr)
  v->vtype=5
  v->align=pi
  '************************************
  v->axl(0).used=1
  v->axl(0).mounting=160
  v->axl(1).used=0
  v->axl(1).mounting=0
  v->axl(2).used=1
  v->axl(2).mounting=10
  CalcPositions (v)
end sub



sub SetTrailerB (v as vessel ptr)
  v->vtype=6
  v->align=pi
  '************************************
  v->axl(0).used=1
  v->axl(0).mounting=20
  v->axl(1).used=1
  v->axl(1).mounting=80
  v->axl(2).used=1
  v->axl(2).mounting=90
  CalcPositions (v)
end sub



sub CalcPositions (v as vessel ptr)
  'Achsen verorten
  v->axl(0).position.x=0
  v->axl(0).position.y=0
  for i as integer=1 to 2
    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
end sub

' asm code in following routines by volta

'get distance between 2 local vectors
 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)
   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



'get the global angle (radians) of v from b (b is the basis)
 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)
   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



'convert radians to a vector (length=1)
 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)
   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


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

dim as set truck

'traktor types 1=road tractor / 2=traktor
'trailer types 5=semi trailer / 6=trailer

truck.AddVessel(2)'tractor
truck.AddVessel(6)'trailer
truck.AddVessel(6)'trailer

'or try this:
'truck.AddVessel(1)'road tractor
'truck.AddVessel(5)'semi trailer



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.MoveAll

  screenlock
    cls

    truck.DrawVessels

    line (0,Yo)-(Xo*2-1,Yo),&H007F00
    line (Xo,0)-(Xo,Yo*2-1),&H7F0000

  screenunlock
loop until inkey=chr(27)
end

h4tt3n
Posts: 698
Joined: Oct 22, 2005 21:12
Location: Denmark

Re: axle model

Post by h4tt3n »

Neat. Yo got some nice rigid body constraint thing going here.
Roland Chastain
Posts: 1022
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: axle model

Post by Roland Chastain »

When I compile and run the example under Linux 64-bit, I get a segmentation error. I use FBC 1.10.1.

Would someone know how to fix it?

[EDIT]

Got more information with -exx option.

Code: Select all

Aborting due to runtime error 12 ("segmentation violation" signal) in axle.bas::GETARCUS()
Maybe the assembler code is 32-bit only.
RetardedAndProud
Posts: 26
Joined: Jun 09, 2024 18:26

Re: axle model

Post by RetardedAndProud »

Roland Chastain wrote: Mar 25, 2025 6:41 When I compile and run the example under Linux 64-bit, I get a segmentation error. I use FBC 1.10.1.

Would someone know how to fix it?

[EDIT]

Got more information with -exx option.

Code: Select all

Aborting due to runtime error 12 ("segmentation violation" signal) in axle.bas::GETARCUS()
Maybe the assembler code is 32-bit only.
First off, as I do not know the expected behaviour of this program I can't tell if it is working as expected or there are other problems regarding system quirks between Linux/Windows etc..

However, I compiled and executed the modified code on both Linux Debian 11 (Bullseye) x86_64 and Debian 12 (Bookworm) x86.

Each produced the same result of the program running but the only keypress that did anything was W/Accelerate and the graphics just zipped off the screen never to return.

For the record, I also tried compiling and running it without using assembly for the trig functions.

Anyhoo, here's the modified (assembly) code.

Code: Select all

screen 19,32
print
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

'points on the vehicle centre line
'could be real axles or hitches
type axle
  used      as single '"flag" is this axle in use?
  mounting  as single 'distance to an previous axle
  position  as vector 'global position
end type


/'

         ---                   ---
          |                     |
  <-----axl(0)----------------axl(1)--axl(2)
          |                     |
         ---                   ---


'/
'container
type vessel
  prevvessel as vessel ptr
  nextvessel as vessel ptr

  vtype         as integer

  align         as single
  axl(2)        as axle '0 and 1 for real axles, 2 for hitch
end type

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)
declare sub CalcPositions (v as vessel ptr)

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

'gesamter Zug
type set
  steer       as single   'steer angle/ moving direction of axle(0)
  steermax    as single
  steercontrol as integer '1=left  0=straight   2=right

  velocity    as single
  velocontrol as integer  '1=accelerate  0=roll out  2=brake

  dircontrol  as integer  '1=foreward -1=back

  timer_this  as single   'time managment
  timer_last  as single


  firstvessel  as vessel ptr 'linked list
  lastvessel   as vessel ptr

  'help variables
  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 MoveAll

  declare sub Acceleration
  declare sub Deceleration
  declare sub ToLeft
  declare sub ToRight
  declare sub Foreward
  declare sub Reverse

  declare sub DrawVessels
end type

constructor set
  timer_this=0
  timer_last=0
  dircontrol=1
  steermax=45/360 * doublepi
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

  'hitching rules
  if lastvessel=0 then  'if nothing exists

    if vtype<5 then possible=1' firstvessel must be a tractor

  else                  ' if something exist...

    if vtype>4 then     'trailer only alowed
      possible=1

      'exceptions for trailers
      if lastvessel->vtype=1 and vtype<>5 then possible=0'road tractor -> semi trailer
      if lastvessel->vtype=2 and vtype<>6 then possible=0'tractor -> trailer
      if lastvessel->vtype=5 and vtype=5 then possible=0'semi trailer -> semi trailer not possible
    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 'link first vessel(tractor)
        firstvessel=tmp
        lastvessel=tmp
      else            'link trailers
        lastvessel->nextvessel=tmp
        tmp->prevvessel=lastvessel
        lastvessel=tmp
        'move the trailer to the hitch
        HitchUpVessel(lastvessel)
      end if


      function=possible

    end if

  end if

end function



sub set.HitchUpVessel (vess as vessel ptr)
  l=vess->prevvessel->axl(2).position
  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

  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
end sub



sub set.MoveAll
  'Timer stuff
  if timer_last then timer_this = timer-timer_last
  timer_last=timer

  'speed calculation
  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


  'steer calculations
  if steercontrol=0 and steer<>0 then 'straight
    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 'left
    steer += 1*timer_this
    if steer>steermax then steer=steermax
  end if

  if steercontrol=2 and steer<>-steermax then 'right
    steer -= 1*timer_this
    if steer<-steermax then steer=-steermax
  end if


  vess=firstvessel
  do
    if vess=firstvessel then 'tractor axle calculations

      distance=velocity*timer_this   'calc the distance
      d=GetVector(vess->align + steer) 'direction to move the first axle

      'new position first axle (axl(0))
      oldpoint=vess->axl(0).position'remember old position
      vess->axl(0).position.x +=d.x*distance * dircontrol
      vess->axl(0).position.y +=d.y*distance * dircontrol

      'new position second axle (axl(1))
      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))'vector d isis also direction for hitch(axle(2))
      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

      'new position third axle (axl(2)) hitch
      oldpoint=vess->axl(2).position
      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

      vess->align=GetArcus(vess->axl(1).position,vess->axl(0).position)

    else 'Trailer

      'new position axle(0)
      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))

      oldpoint=vess->axl(0).position
      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 'if normal trailer

        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))
        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

        vess->align=GetArcus(vess->axl(1).position,vess->axl(0).position)

      else 'if semi trailer

        vess->align=GetArcus(vess->axl(0).position,vess->prevvessel->axl(2).position)

      end if

    end if

    'new position third axle (axl(2)) hitch
    oldpoint=vess->axl(2).position
    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

    vess=vess->nextvessel
  loop until vess=0

  steercontrol=0
  velocontrol=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



sub set.DrawVessels
  vess=firstvessel
  if vess then
    do
      select case vess->vtype
        case 1,2
          circle (Xo + vess->axl(0).position.x , Yo - vess->axl(0).position.y),5,&H0000FF
          line (Xo + vess->axl(0).position.x , Yo - vess->axl(0).position.y) - (Xo + vess->axl(1).position.x , Yo - vess->axl(1).position.y),&H00FF00
          circle (Xo + vess->axl(1).position.x , Yo - vess->axl(1).position.y),5,&HFF0000
          circle (Xo + vess->axl(2).position.x , Yo - vess->axl(2).position.y),3,&H00FF00

        case 5
          line (Xo + vess->prevvessel->axl(2).position.x , Yo - vess->prevvessel->axl(2).position.y) - (Xo + vess->axl(0).position.x , Yo - vess->axl(0).position.y),&HFF7F00
          circle (Xo + vess->axl(0).position.x , Yo - vess->axl(0).position.y),5,&HFF0000
          circle (Xo + vess->axl(2).position.x , Yo - vess->axl(2).position.y),3,&H00FF00

        case 6
          line (Xo + vess->prevvessel->axl(2).position.x , Yo - vess->prevvessel->axl(2).position.y) - (Xo + vess->axl(0).position.x , Yo - vess->axl(0).position.y),&HFF7F00
          circle (Xo + vess->axl(0).position.x , Yo - vess->axl(0).position.y),5,&H0000FF
          line (Xo + vess->axl(0).position.x , Yo - vess->axl(0).position.y) - (Xo + vess->axl(1).position.x , Yo - vess->axl(1).position.y),&H00FF00
          circle (Xo + vess->axl(1).position.x , Yo - vess->axl(1).position.y),5,&HFF0000
          circle (Xo + vess->axl(2).position.x , Yo - vess->axl(2).position.y),3,&H00FF00

      end select
      vess=vess->nextvessel
    loop until vess=0
  end if
end sub
'******************************************************************************
'******************************************************************************
'******************************************************************************


'**************************************
'definition of possible trucks,traktors,trailers

sub SetTractorA (v as vessel ptr)
  v->vtype=1
  'front to left 180 grd
  v->align=pi
  '************************************
  v->axl(0).used=1
  v->axl(0).mounting=0
  v->axl(1).used=1
  v->axl(1).mounting=80
  v->axl(2).used=1
  v->axl(2).mounting=50
  CalcPositions (v)
end sub


sub SetTractorB (v as vessel ptr)
  v->vtype=2
  'front to left 180 grd
  v->align=pi
  '************************************
  v->axl(0).used=1
  v->axl(0).mounting=0
  v->axl(1).used=1
  v->axl(1).mounting=40
  v->axl(2).used=1
  v->axl(2).mounting=50
  CalcPositions (v)
end sub


sub SetTrailerA (v as vessel ptr)
  v->vtype=5
  v->align=pi
  '************************************
  v->axl(0).used=1
  v->axl(0).mounting=160
  v->axl(1).used=0
  v->axl(1).mounting=0
  v->axl(2).used=1
  v->axl(2).mounting=10
  CalcPositions (v)
end sub



sub SetTrailerB (v as vessel ptr)
  v->vtype=6
  v->align=pi
  '************************************
  v->axl(0).used=1
  v->axl(0).mounting=20
  v->axl(1).used=1
  v->axl(1).mounting=80
  v->axl(2).used=1
  v->axl(2).mounting=90
  CalcPositions (v)
end sub



sub CalcPositions (v as vessel ptr)
  'Achsen verorten
  v->axl(0).position.x=0
  v->axl(0).position.y=0
  for i as integer=1 to 2
    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
end sub

' asm code in following routines by volta

'get distance between 2 local vectors
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)
#ifdef __FB_64BIT__
  Asm
     mov rax, [d]
     mov rbx, [b]
     fld dword Ptr [rax]
     fsub dword Ptr [rbx]
     fmul ST(0), ST(0)
     fld dword Ptr [rax+4]
     fsub dword Ptr [rbx+4]
     fmul ST(0), ST(0)
     faddp
     fsqrt
     fstp dword Ptr [Function]
   End Asm
#else
   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
#endif
End Function



'get the global angle (radians) of v from b (b is the basis)
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)
#ifdef __FB_64BIT__
   Asm
     mov rax, [v]
     mov rbx, [b]
     fld dword Ptr [rax+4]
     fsub dword Ptr [rbx+4]
     fld dword Ptr [rax]
     fsub dword Ptr [rbx]
     fpatan
     fstp dword Ptr [arcus]
   End Asm
#else
   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
#endif
   If Sgn(arcus)=-1 Then arcus= doublepi + arcus
   Function=arcus
End Function



'convert radians to a vector (length=1)
 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)
   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


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

dim as set truck

'traktor types 1=road tractor / 2=traktor
'trailer types 5=semi trailer / 6=trailer

truck.AddVessel(2)'tractor
truck.AddVessel(6)'trailer
truck.AddVessel(6)'trailer

'or try this:
'truck.AddVessel(1)'road tractor
'truck.AddVessel(5)'semi trailer



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.MoveAll

  screenlock
    cls

    truck.DrawVessels

    line (0,Yo)-(Xo*2-1,Yo),&H007F00
    line (Xo,0)-(Xo,Yo*2-1),&H7F0000

  screenunlock
loop until inkey=chr(27)
end
Roland Chastain
Posts: 1022
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: axle model

Post by Roland Chastain »

@RetardedAndProud

Thank you very much for your code! Tested it under Windows (32 and 64-bit), and it seems to work perfectly. I used the pure FB version of GetVector, because I was under the impression that you forgot to provide a 64-bit assembler version for that function.

Will test under Linux when I am at home.
RetardedAndProud
Posts: 26
Joined: Jun 09, 2024 18:26

Re: axle model

Post by RetardedAndProud »

Roland Chastain wrote: Mar 25, 2025 11:07 @RetardedAndProud

Thank you very much for your code! Tested it under Windows (32 and 64-bit), and it seems to work perfectly. I used the pure FB version of GetVector, because I was under the impression that you forgot to provide a 64-bit assembler version for that function.

Will test under Linux when I am at home.
The GetVector function does not need different code as it utilizes 32bit floating point instructions (Single precision floats) on either architecture.
Roland Chastain
Posts: 1022
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: axle model

Post by Roland Chastain »

RetardedAndProud wrote: Mar 25, 2025 11:34 The GetVector function does not need different code as it utilizes 32bit floating point instructions (Single precision floats) on either architecture.
I see, thank you.

On Linux, I can compile your code, but the program doesn't seem to work well: when I press w, the truck disappears. I will investigate...
RetardedAndProud
Posts: 26
Joined: Jun 09, 2024 18:26

Re: axle model

Post by RetardedAndProud »

Roland Chastain wrote: Mar 25, 2025 12:47 On Linux, I can compile your code, but the program doesn't seem to work well: when I press w, the truck disappears. I will investigate...
Not 100% sure if I recall, but I think there may be differences between MULTIKEY on Linux and Windows. Something in the back of me noggin tells me I've seen posts referring to that.
Roland Chastain
Posts: 1022
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: axle model

Post by Roland Chastain »

RetardedAndProud wrote: Mar 25, 2025 13:05 Not 100% sure if I recall, but I think there may be differences between MULTIKEY on Linux and Windows.
I checked: Multikey works correctly. The problem is elsewhere.
paul doe
Posts: 1859
Joined: Jul 25, 2017 17:22
Location: Argentina
Contact:

Re: axle model

Post by paul doe »

There is absolutely no account for timestepping. Thus, the simulation quickly 'explodes to infinity' if your system is too fast.
Roland Chastain
Posts: 1022
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: axle model

Post by Roland Chastain »

@paul doe

Thank you for your answer.

I tried to change the sleep parameter:

Code: Select all

do
  'sleep 1
  sleep 50, 1
But the result is still the same: the truck vanishes as soon as I press the w key.
paul doe
Posts: 1859
Joined: Jul 25, 2017 17:22
Location: Argentina
Contact:

Re: axle model

Post by paul doe »

@Roland: mind that timestepping is not so simple as just sleeping in the loop, it requires the simulation to take it into account ie you integrate it based on the timestep.

For example, see:
https://dewitters.com/dewitters-gameloop/
Roland Chastain
Posts: 1022
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: axle model

Post by Roland Chastain »

Found.

Code: Select all

  timer_this  as double'single   'time managment
  timer_last  as double'single
Now the program works correctly under Linux.
paul doe wrote: Mar 26, 2025 0:15 @Roland: mind that timestepping is not so simple as just sleeping in the loop, it requires the simulation to take it into account ie you integrate it based on the timestep.
Thank you for the link. The article sounds interesting.
Muttonhead
Posts: 143
Joined: May 28, 2009 20:07

Re: axle model

Post by Muttonhead »

...Jul 08, 2012 10:59. It's been a long time.
@Roland: Important here, this isn't really a "real" physical model; at best, it would win 4th place :) in the "it looks as if" competition. My understanding of the subject wasn't sufficient for that. So, it's more a product of necessity. 8)
Roland Chastain
Posts: 1022
Joined: Nov 24, 2011 19:49
Location: France
Contact:

Re: axle model

Post by Roland Chastain »

Muttonhead wrote: Mar 26, 2025 9:04 @Roland: Important here, this isn't really a "real" physical model; at best, it would win 4th place :) in the "it looks as if" competition.
Maybe (if you say so), but it's a nice little program IMHO. I am glad that it work under Linux now.
Muttonhead wrote: Mar 26, 2025 9:04 ...Jul 08, 2012 10:59. It's been a long time.
This was the time when I discovered programming and... the FreeBASIC forum. :)
Last edited by Roland Chastain on Mar 28, 2025 3:12, edited 1 time in total.
Post Reply