Physics question

Game development specific discussions.
badidea
Posts: 1617
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Physics question

Postby badidea » Jul 20, 2019 21:30

deltarho[1859] wrote:
badidea wrote:but the whole structure is a bit of a mess.

I think that Vincent van Gogh's paintings are a bit of a mess but some folk have parted with some serious money to get their hands on them. One thing is for sure and that is dodicat is not a John Constable. <smile>

Yes, they both all three might have produced master pieces worth millions, but are the the pieces good starting points to learn (painting or coding)?
deltarho[1859]
Posts: 2102
Joined: Jan 02, 2017 0:34
Location: UK

Re: Physics question

Postby deltarho[1859] » Jul 20, 2019 22:35

badidea wrote:but are the pieces good starting points to learn (painting or coding)?

Probably not. If van Gogh and Constable got into programming I'd reckon van Gogh would plug for Top-Down programming and Constable would plug for Bottom-Up programming. <smile> Both methods have their pros and cons, best bet is to study both.

dodicat does not write code to educate, he writes code to solve a problem. If we posed a programming challenge dodicat would be one of the first, if not the first, to produce working code and then take his dogs out for a walk whilst the rest of us probably haven't passed the half-way mark. I write to get code working but I then sit back and work on it so that if I ever return to it I would be up to speed fairly quickly and not have to spend time wondering what the blazes I was up to. That takes time but I reckon it is worth it. Not everyone works like that, many are not interested in hanging their code on a wall, they get it working and move on to the next challenge. There is room for both types.
BasicCoder2
Posts: 3404
Joined: Jan 01, 2009 7:03

Re: Physics question

Postby BasicCoder2 » Jul 21, 2019 3:45

deltarho[1859] wrote:dodicat does not write code to educate, he writes code to solve a problem.

I have a special folder called the dodicat folder because I find his examples so useful and/or entertaining.
My favourite pieces are his 3d stuff using fast code to place dots in 3d space.

His bit in this thread on implementing the vector products to deduce an angle in the range 0 to 360 was educational but it is really up to anyone interested the subject to learn all those things from the many web resources on the subject and of course the FreeBasic manual on how to implement the more advanced programming techniques.
deltarho[1859]
Posts: 2102
Joined: Jan 02, 2017 0:34
Location: UK

Re: Physics question

Postby deltarho[1859] » Jul 21, 2019 5:50

BasicCodr2 wrote:I have a special folder called the dodicat folder because I find his examples so useful and/or entertaining.

Snap! My folder is called 'DodicatGems'.
srvaldez
Posts: 2158
Joined: Sep 25, 2005 21:54

Re: Physics question

Postby srvaldez » Jul 21, 2019 8:38

@badidea
I ran your program from post viewtopic.php?p=262619#p262619 on macOS, it flickers a lot
in line 132, if you place clearscreen(0) after screenlock then it's ok
badidea
Posts: 1617
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Physics question

Postby badidea » Jul 21, 2019 18:55

Yes, an error, I'll fix later...
dodicat
Posts: 6026
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Physics question

Postby dodicat » Jul 21, 2019 19:07

Badidea, I hope you are not procrastinating your camping.
It has been raining here all day.
Your demo runs OK here.
Thank you everybody for your comments.
I have gathered up everything and put it all inside one sub to return the required angle and direction after a kick on one thruster.
This makes the sub innards a bit gobbledygook, (macros), but apart from the sub it should be readable.
The shape is a polygon which can be given an eccentricity (0 to 1], (but not 0).

Code: Select all

 

Type pt
    As Double x,y,z
End Type
Const pi=4*Atn(1)
Dim Shared As Double systemconstant

Sub createpolygon(p() As pt,n As Long,cx As Single,cy As Single,size As Single,angle As Single=0,ecc As Single=1)
    If ecc>1 Then ecc=1
    Var slug =2*pi/n
    Var count =0
    Redim p(1 To n)
    For z As Single=0 To 2*pi+.1 Step slug
        count=count+1
        If count>n Then Exit For
        p(count)=Type((Cos(angle)*(ecc*(size)*Cos(z))-Sin(angle)*(size)*Sin(z))+cx,_
                      (Sin(angle)*(ecc*(size)*Cos(z))+Cos(angle)*(size)*Sin(z))+cy)
    Next z
End Sub

Sub drawpolygon(p() As Pt,col As Ulong)
    Pset(p(Lbound(p)).x,(p(Lbound(p)).y)),col
    Dim As Single cx=p(Lbound(p)).x,cy=p(Lbound(p)).y
    For n As Long=Lbound(p)+1 To Ubound(p)
        cx+=p(n).x:cy+=p(n).y
        Line -(p(n).x,p(n).y),col
    Next n
    Line-(p(Lbound(p)).x,p(Lbound(p)).y),col
    cx/=(Ubound(p)-Lbound(p)+1):cy/=(Ubound(p)-Lbound(p)+1)
    Paint (cx,cy),col,col
End Sub

sub push(pg() As pt,p1 As pt,p2 As pt,dirn As pt,Byref angle As Single,impulsefactor as single=1)
    #define dot(v1,v2) (v1.x*v2.x+v1.y*v2.y+v1.z*v2.z)
    #define dist(p1,p2) Sqr((p1.x-p2.x)^2 + (p1.y-p2.y)^2)
    #define length(p1) Sqr(p1.x^2 + p1.y^2)
    #define cross(v1,v2) Type<pt>(v1.y*v2.z-v2.y*v1.z,-(v1.x*v2.z-v2.x*v1.z),v1.x*v2.y-v2.x*v1.y)
    #define normalize(p1)  Type<pt>(p1.x/Length(p1),p1.y/Length(p1),p1.z/Length(p1))
    #macro get_angle(_p_,ret1)
    Scope
        Dim As pt L1=(_p_(1).x-_p_(2).x,_p_(1).y-_p_(2).y)'leg 1
        Dim As pt L2=(_p_(3).x-_p_(2).x,_p_(3).y-_p_(2).y)'leg 2
        Var NL1=normalize(L1)
        Var NL2=normalize(L2)
        ret1= Acos(dot(NL1,NL2))
        Dim As pt cr =cross(L1,L2)
        If cr.z>0 Then ret1=2*pi-ret1
    End Scope
    #endmacro
    #define drawto(x,y,angle,dst) Type<pt>(x+dst*Cos(angle),y+dst*Sin(angle))
    #macro shortline(fp,p ,Ln,ret2)
    Scope
        Dim As Single diffx=p.x-fp.x,diffy=p.y-fp.y
        Dim As Single L=Sqr(diffx*diffx+diffy*diffy)
        Ret2= Type(fp.x+Ln*diffx/L,fp.y+Ln*diffy/L)
    End Scope
    #endmacro
    #macro inpolygon(p1,p2,ret3)
    Scope
        #macro Winder(L1,L2,p)
        ((L1.x-L2.x)*(p.y-L2.y)-(p.x-L2.x)*(L1.y-L2.y))
        #endmacro
        Dim As Long index,nextindex,k=Ubound(p1)+1,wn
        For n As Integer=1 To Ubound(p1)
            index=n Mod k:nextindex=(n+1) Mod k
            If nextindex=0 Then nextindex=1
            If p1(index).y<=p2.y Then
                If p1(nextindex).y>p2.y Andalso  Winder(p1(index),p1(nextindex),p2)>0 Then wn+=1
            Else
                If p1(nextindex).y<=p2.y Andalso Winder(p1(index),p1(nextindex),p2)<0 Then wn-=1
            End If
        Next n
        Ret3= wn
    End Scope
    #endmacro
 
    Dim As Long ic
    inpolygon(pg,p1,ic)
    If ic Then return  'if mouse in in the shape
   
    Dim As pt c
    Dim As Single size=-1e6
    For n As Long=Lbound(pg) To Ubound(pg)  'get centre
        c.x+=pg(n).x
        c.y+=pg(n).y
    Next n
    c.x/=(Ubound(pg)-Lbound(pg)+1)
    c.y/=(Ubound(pg)-Lbound(pg)+1)
    For n As Long=Lbound(pg) To Ubound(pg)  'get size
        Var l=dist(pg(n),c)
        If size<l Then size=l
    Next n
    Var L=dist(p1,p2)
    Var ang=Atan2(p2.y-p1.y,p2.x-p1.x)
    Dim As pt p=p1
    Dim As Long ctr
    Do
        shortline(p,p2,1,p)
        inpolygon(pg,p,ic)
        ctr+=1
    Loop Until ic Or ctr>L 'when hits the polygon or misses
    If ic=0 Then return
    Dim As pt eq=drawto(c.x,c.y,ang,-200)
    Dim As pt q=Type(c.x,c.y)
    ctr=0
    Do
        shortline(q,eq,1,q)
        inpolygon(pg,q,ic)
        ctr+=1
    Loop Until ic=0 Or ctr>1000 'when exits the polygon or an escape
    Dim As pt leg1=Type(c.x+(c.x-q.x),c.y+(c.y-q.y))
    Dim As pt leg2=Type(c.x+(c.x-p.x),c.y+(c.y-p.y))
    Dim As pt pq(1 To 3)={leg1,c,leg2}
    get_angle(pq,angle)
    Dim As pt d1=Type(c.x-p.x,c.y-p.y) 'centre to edge intersection
    dirn=normalize(d1)
    'angle and dirn to be altered to suit.
    Var mass= systemconstant*size^2*Ubound(pg)*Sin(2*pi/Ubound(pg))/2
    Var anginertia=systemconstant*((mass*size^2)/6)*(1+2*(Cos(pi/Ubound(pg))^2))
    If angle>pi/2 And angle<3*pi/2 Then dirn.x=-dirn.x:dirn.y=-dirn.y
    Var impulse=impulsefactor*dist(p1,p2)
    Var linearimpulse=impulse*Cos(angle)/mass
    angle=-impulse*Sin(angle)/anginertia  'out
    dirn.x=dirn.x*linearimpulse           'out
    dirn.y=dirn.y*linearimpulse
End sub

Function Regulate(Byval MyFps As Long,Byref fps As Long=0) As Long
    Static As Double timervalue,_lastsleeptime,t3,frames
    Var t=Timer
    frames+=1
    If (t-t3)>=1 Then t3=t:fps=frames:frames=0
    Var sleeptime=_lastsleeptime+((1/myfps)-T+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    _lastsleeptime=sleeptime
    timervalue=T
    Return sleeptime
End Function

Function Getline(x As Long,y As Long,angle As Single,dist As Long) As pt'line by angle
    Var x2=x+dist*Cos(angle)
    Var y2=y+dist*Sin(angle)
    Return Type(x2,y2)
End Function

Function inpolygon(p1() As Pt,Byval p2 As Pt) As Long
    #macro Winder(L1,L2,p)
    ((L1.x-L2.x)*(p.y-L2.y)-(p.x-L2.x)*(L1.y-L2.y))
    #endmacro
    Dim As Integer index,nextindex,k=Ubound(p1)+1,wn
    For n As Integer=1 To Ubound(p1)
        index=n Mod k:nextindex=(n+1) Mod k
        If nextindex=0 Then nextindex=1
        If p1(index).y<=p2.y Then
            If p1(nextindex).y>p2.y Andalso  Winder(p1(index),p1(nextindex),p2)>0 Then wn+=1
        Else
            If p1(nextindex).y<=p2.y Andalso Winder(p1(index),p1(nextindex),p2)<0 Then wn-=1
        End If
    Next n
    Return wn
End Function

function OutOfBounds(p() as pt) as long  'going off the screen
    dim as integer sx,sy
    screeninfo sx,sy
    #define outside(x,y) x>sx or x<0 or y>sy or y<0
    for n as long=lbound(p) to ubound(p)
        if outside(p(n).x,p(n).y) then return 1
    next
    return 0
end function
'====================

Redim As pt p() 'a polygon
Dim As Long mx,my,wheel,btn,flag 'for mouse
Dim As Single x=400,y=300  'start position
Dim As pt getdirection,lastdirection
Dim As Single getangle,TurnAngle,lastangle
Dim As Single size=100
systemconstant=1/size
Dim As Long numsides=30
dim as single eccentricity=.5
dim as single impulsefactor=1
dim as long getfps
dim as long length=100

Screen 19,32
Do
    Getmouse mx,my,wheel,btn
    Screenlock
    Cls
    draw string (20,10),"Mouse wheel for impulse direction, left button to fire"
    draw string(20,30),"framerate "&getfps
    createpolygon(p(),numsides,x,y,size,TurnAngle,eccentricity)
    drawpolygon(p(),Rgb(0,100,255))
   
    Dim As pt x1=Type(mx,my)
    Dim As pt x2=Getline(mx,my,wheel/5,length)
    Line(x1.x,x1.y)-(x2.x,x2.y),rgb(200,0,0)
   
    if btn=1 and flag=0 and inpolygon(p(),x2) and inpolygon(p(),x1)=0 then 'fire impulse from outside polygon
    lastangle+=getangle
    lastdirection.x+=getdirection.x
    lastdirection.y+=getdirection.y
    push (p(),x1,x2,getdirection,getangle,impulsefactor)
         end if
   'motion
    x+=getdirection.x+lastdirection.x
    y+=getdirection.y+lastdirection.y
    TurnAngle+=getangle+lastangle
   
    if OutOfBounds(p()) then
    x=400:y=300:TurnAngle=0
    getdirection.x=0:getdirection.y=0:getangle=0
    lastdirection.x=0:lastdirection.y=0:lastangle=0
     end if
     flag=btn
    Screenunlock
    Sleep regulate(60,getfps),1
Loop Until Len(Inkey)
Sleep

Last edited by dodicat on Jul 22, 2019 9:08, edited 1 time in total.
badidea
Posts: 1617
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Physics question

Postby badidea » Jul 21, 2019 21:11

A real camping experince requires at least one rainy morning at near zero temperatures. Currently in Belgium and I haven't seen a simple drop however and the forcast is 35 degC.
badidea
Posts: 1617
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Physics question

Postby badidea » Aug 14, 2019 22:20

Writing some quick code before a vacation and think that you can continue smoothly a few weeks later, is an illusion.

Anyway, the case where one off-axis thruster is continuously active:

Code: Select all

const as single PI = 4 * atn(1)
const as single PPM = 3 'pixels per meter
const SW = 800, SH = 600

screenres SW, SH, 32
width SW \ 16, SH \ 8

'-------------------------------------------------------------------------------

type sgl2d
   dim as single x, y
   declare constructor
   declare constructor(x as single, y as single)
   declare operator cast () as string
end type

constructor sgl2d
end constructor

constructor sgl2d(x as single, y as single)
   this.x = x : this.y = y
end constructor

operator sgl2d.cast () as string
   return str(x) & "," & str(y)
end operator

operator +(a as sgl2d, b as sgl2d) as sgl2d
   return sgl2d(a.x + b.x, a.y + b.y)
end operator

operator -(a as sgl2d, b as sgl2d) as sgl2d
   return sgl2d(a.x - b.x, a.y - b.y)
end operator

operator /(a as sgl2d, div as single) as sgl2d
   return sgl2d(a.x / div, a.y / div)
end operator

operator *(a as sgl2d, mul as single) as sgl2d
   return sgl2d(a.x * mul, a.y * mul)
end operator

function cross(a as sgl2d, b as sgl2d) as single
   return a.x * b.y - a.y * b.x
end function

'-------------------------------------------------------------------------------

function polarToCartesian(angle as single, radius as single) as sgl2d
   return sgl2d(cos(angle) * radius, sin(angle) * radius)
end function

function degToRad(degrees as single) as single
   return (degrees / 180) * PI
end function

function rotatedVector(v as sgl2d, rotAngle as single) as sgl2d
   dim as sgl2d tmp
   tmp.x = cos(rotAngle) * v.x - sin(rotAngle) * v.y
   tmp.y = sin(rotAngle) * v.x + cos(rotAngle) * v.y
   return tmp
end function

sub clearScreen(c as ulong)
   line(0, 0)-(SW - 1, SH - 1), c, bf
end sub

'scaled circle using PPM, y-axis pointing up, center = 0, 0
sub drawCircle(p as sgl2d, r as single, c as ulong)
   circle(SW \ 2 + p.x * PPM, SH \ 2 - p.y * PPM), r * PPM, c
end sub

'scaled line using PPM, y-axis pointing up, center = 0, 0
sub drawLine(p1 as sgl2d, p2 as sgl2d, c as ulong)
   line(SW \ 2 + p1.x * PPM, SH \ 2 - p1.y * PPM)-_
      (SW \ 2 + p2.x * PPM, SH \ 2 - p2.y * PPM), c
end sub

sub drawArrow(p1 as sgl2d, p2 as sgl2d, c as ulong)
   drawLine(p1, p2, c)
   dim as sgl2d posVector = p2 - p1
   posVector /= 3 '1/3 length
   drawLine(p1, p1 + rotatedVector(posVector, degToRad(+30)), c)
   drawLine(p1, p1 + rotatedVector(posVector, degToRad(-30)), c)
end sub

'-------------------------------------------------------------------------------

type disc_object
   dim as single radius '[m]
   dim as single height '[m]
   dim as single density '[kg/m^3]
   dim as ulong colour '[m]
   'linear motion properties
   dim as sgl2d position 'position [m]
   dim as single lin_m 'mass [kg]
   dim as sgl2d lin_F 'force [N] [kg*m/s^2]
   dim as sgl2d lin_a 'acceleration [m/s^2]
   dim as sgl2d lin_v 'velocity [m/s]
   dim as sgl2d lin_p 'momentum [kg*m/s]
   dim as single lin_E 'Kinetic energy [J] [kg*m^2/s^2]
   'Rotational motion properties
   dim as single angle 'angular position (theta) [rad]
   dim as single ang_F 'torque (tau) [N*m] [kg*m^2/s^2]
   dim as single ang_m 'angular mass, moment of inertia (I) [kg*m^2]
   dim as single ang_a 'angular velocity (alpha) [rad/s^2]
   dim as single ang_v 'angular velocity (omega) [rad/s]
   dim as single ang_p 'angular momentum (L) [kg*m^2/s]
   dim as single ang_E 'Kinetic energy [J] [kg*m^2/s^2]
   '
   declare sub init(r as single, h as single, d as single, p as sgl2d, c as ulong)
   declare sub update(dt as double)
end type

'Set radius, height, density, position
'Calculate mass and rotational inertia
sub disc_object.init(r as single, h as single, d as single, p as sgl2d, c as ulong)
   radius = r
   height = h
   density = d
   position = p
   colour = c
   lin_m = PI * r ^ 2 * d
   ang_m = 0.5 * lin_m * r ^ 2
end sub

'update position and angle
sub disc_object.update(dt as double)
   lin_a = lin_F / lin_m
   lin_v += lin_a * dt
   position += lin_v * dt
   ang_a = ang_F / ang_m
   ang_v += ang_a * dt
   angle += ang_v * dt
end sub

'-------------------------------------------------------------------------------

dim as disc_object disc
dim as single thrusterForceMagnitude = 1e4 'N
dim as sgl2d thrusterRelPos, thrusterForceVector

disc.init(10, 1, 5, sgl2d(0, -50), rgb(127, 255, 0))

dim as double tNow = timer, tPrev = tNow, dt = 0
while inkey() <> chr(27)
   'calculate
   thrusterRelPos = polarToCartesian(disc.angle - pi/4, disc.radius)
   thrusterForceVector = polarToCartesian(disc.angle + pi/2, thrusterForceMagnitude)
   disc.lin_F = sgl2d(0, 0) 'reset
   disc.lin_F += thrusterForceVector
   disc.ang_F = 0 'reset
   disc.ang_F += cross(thrusterRelPos, disc.lin_F)
   disc.update(dt)
   'display
   screenlock
   clearScreen(0)
   locate 1,1 : print "<ESC> to exit";
   dim as sgl2d thrusterAbsPos = disc.position + thrusterRelPos
   drawCircle(disc.position, disc.radius, disc.colour) 'flying saucer
   drawArrow(thrusterAbsPos, thrusterAbsPos - disc.lin_F / 1e3, rgb(255, 127, 0)) 'thruster force indicator
   drawLine(disc.position, thrusterAbsPos, rgb(255, 255, 0)) 'rotation indicator
   screenunlock
   'time update
   sleep 1
   tPrev = tNow
   tNow = timer
   dt = tNow - tPrev
wend
screen 0
print "End"

'links:
'http://www.hyperphysics.de/hyperphysics/hbase/mi.html
'https://www.real-world-physics-problems.com/rigid-body-dynamics.html
'https://en.wikipedia.org/wiki/Resultant_force
'https://research.ncl.ac.uk/game/mastersdegree/gametechnologies/physicstutorials/5collisionresponse/
'https://www.toptal.com/game/video-game-physics-part-i-an-introduction-to-rigid-body-dynamics

There is a lot of calls to sin() and cos(), but that can be reduced later...
badidea
Posts: 1617
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Physics question

Postby badidea » Aug 17, 2019 23:14

With 2 forward facing thrusters, individually controlled, one can navigate a spacecraft. Making a quick u-turn however, is quite a challenge.

Code: Select all

#include "fbgfx.bi"

const as single PI = 4 * atn(1)
dim shared as single PPM = 3 'pixels per meter
const SW = 800, SH = 600

const K_ESC = chr(27)
const K_MIN = chr(45)
const K_UND = chr(95)
const K_PLU = chr(61)
const K_EQU = chr(43)

screenres SW, SH, 32
width SW \ 8, SH \ 16

'-------------------------------------------------------------------------------

type sgl2d
   dim as single x, y
   declare constructor
   declare constructor(x as single, y as single)
   declare operator cast () as string
end type

constructor sgl2d
end constructor

constructor sgl2d(x as single, y as single)
   this.x = x : this.y = y
end constructor

operator sgl2d.cast () as string
   return str(x) & "," & str(y)
end operator

operator +(a as sgl2d, b as sgl2d) as sgl2d
   return sgl2d(a.x + b.x, a.y + b.y)
end operator

operator -(a as sgl2d, b as sgl2d) as sgl2d
   return sgl2d(a.x - b.x, a.y - b.y)
end operator

operator /(a as sgl2d, div as single) as sgl2d
   return sgl2d(a.x / div, a.y / div)
end operator

operator *(a as sgl2d, mul as single) as sgl2d
   return sgl2d(a.x * mul, a.y * mul)
end operator

function cross(a as sgl2d, b as sgl2d) as single
   return a.x * b.y - a.y * b.x
end function

'-------------------------------------------------------------------------------

type polar
   dim as single angle
   dim as single magnitude
end type

function polarToCartesian(angle as single, radius as single) as sgl2d
   return sgl2d(cos(angle) * radius, sin(angle) * radius)
end function

function degToRad(degrees as single) as single
   return (degrees / 180) * PI
end function

function rotatedVector(v as sgl2d, rotAngle as single) as sgl2d
   dim as sgl2d tmp
   tmp.x = cos(rotAngle) * v.x - sin(rotAngle) * v.y
   tmp.y = sin(rotAngle) * v.x + cos(rotAngle) * v.y
   return tmp
end function

sub clearScreen(c as ulong)
   line(0, 0)-(SW - 1, SH - 1), c, bf
end sub

'scaled circle using PPM, y-axis pointing up, center = 0, 0
sub drawCircle(p as sgl2d, r as single, c as ulong)
   circle(SW \ 2 + p.x * PPM, SH \ 2 - p.y * PPM), r * PPM, c
end sub

'scaled line using PPM, y-axis pointing up, center = 0, 0
sub drawLine(p1 as sgl2d, p2 as sgl2d, c as ulong)
   line(SW \ 2 + p1.x * PPM, SH \ 2 - p1.y * PPM)-_
      (SW \ 2 + p2.x * PPM, SH \ 2 - p2.y * PPM), c
end sub

sub drawArrow(p1 as sgl2d, p2 as sgl2d, c as ulong)
   drawLine(p1, p2, c)
   dim as sgl2d posVector = p2 - p1
   posVector /= 3 '1/3 length
   drawLine(p1, p1 + rotatedVector(posVector, degToRad(+30)), c)
   drawLine(p1, p1 + rotatedVector(posVector, degToRad(-30)), c)
end sub

'-------------------------------------------------------------------------------

type disc_object
   dim as single radius '[m]
   dim as single height '[m]
   dim as single density '[kg/m^3]
   dim as ulong colour '[m]
   'linear motion properties
   dim as sgl2d position 'position [m]
   dim as single lin_m 'mass [kg]
   dim as sgl2d lin_F 'force [N] [kg*m/s^2]
   dim as sgl2d lin_a 'acceleration [m/s^2]
   dim as sgl2d lin_v 'velocity [m/s]
   dim as sgl2d lin_p 'momentum [kg*m/s]
   dim as single lin_E 'Kinetic energy [J] [kg*m^2/s^2]
   'Rotational motion properties
   dim as single angle 'angular position (theta) [rad]
   dim as single ang_F 'torque (tau) [N*m] [kg*m^2/s^2]
   dim as single ang_m 'angular mass, moment of inertia (I) [kg*m^2]
   dim as single ang_a 'angular velocity (alpha) [rad/s^2]
   dim as single ang_v 'angular velocity (omega) [rad/s]
   dim as single ang_p 'angular momentum (L) [kg*m^2/s]
   dim as single ang_E 'Kinetic energy [J] [kg*m^2/s^2]
   '
   declare sub init(r as single, h as single, d as single, p as sgl2d, c as ulong)
   declare sub update(dt as double)
end type

'Set radius, height, density, position
'Calculate mass and rotational inertia
sub disc_object.init(r as single, h as single, d as single, p as sgl2d, c as ulong)
   radius = r
   height = h
   density = d
   position = p
   colour = c
   lin_m = PI * r ^ 2 * d
   ang_m = 0.5 * lin_m * r ^ 2
end sub

'update position and angle
sub disc_object.update(dt as double)
   lin_a = lin_F / lin_m
   lin_v += lin_a * dt
   position += lin_v * dt
   ang_a = ang_F / ang_m
   ang_v += ang_a * dt
   angle += ang_v * dt
end sub

'-------------------------------------------------------------------------------

type thruster_type
   '''init paramaters
   dim as polar polarForce '(rad, N)
   dim as polar polarPos '(rad, m)
   '''variable paramaters
   dim as sgl2d forceVector '(N, N)
   dim as sgl2d relPos, absPos '(m, m)
   dim as integer active
   declare sub init(forceMagnitude as single, forceDirection as single, posAngle as single, posRadius as single)
   declare sub updatePosition(bodyPos as sgl2d, bodyAngle as single)
end type

sub thruster_type.init(forceDirection as single, forceMagnitude as single, posAngle as single, posRadius as single)
   polarForce = type(forceDirection, forceMagnitude) 'thruster action
   polarPos = type(posAngle, posRadius) 'position of thruster on ship
end sub

sub thruster_type.updatePosition(bodyPos as sgl2d, bodyAngle as single)
   relPos = polarToCartesian(bodyAngle + polarPos.angle, polarPos.magnitude)
   absPos = bodyPos + relPos
end sub

'-------------------------------------------------------------------------------

const NUM_THRUSTERS = 2
const L_FW_THR = 0 'left forward thruster
const R_FW_THR = 1 'right forward thruster

dim as string key
dim as disc_object disc
dim as thruster_type thruster(NUM_THRUSTERS - 1)

disc.init(10, 1, 5, sgl2d(0, -50), rgb(127, 255, 0))
thruster(L_FW_THR).init(0.5 * pi, 1e4, -0.75 * pi, disc.radius)
thruster(R_FW_THR).init(0.5 * pi, 1e4, -0.25 * pi, disc.radius)

dim as double tNow = timer, tPrev = tNow, dt = 0
while key <> chr(27)
   'reset stuff
   disc.lin_F = sgl2d(0, 0)
   disc.ang_F = 0
   for i as integer = 0 to NUM_THRUSTERS - 1
      thruster(i).active = 0
   next

   'do always for display
   for i as integer = 0 to NUM_THRUSTERS - 1
      thruster(i).updatePosition(disc.position, disc.angle)
   next

   if multikey(FB.SC_K) then
      thruster(L_FW_THR).active = 1
   end if

   if multikey(FB.SC_L) then
      thruster(R_FW_THR).active = 1
   end if

   if key = K_MIN or key = K_UND then ppm /= 1.1 'zoom out
   if key = K_PLU or key = K_EQU then ppm *= 1.1 'zoom in

   for i as integer = 0 to NUM_THRUSTERS - 1
      'forces on body by active thrusters
      if thruster(i).active = 1 then
         thruster(i).forceVector = polarToCartesian(disc.angle + thruster(i).polarForce.angle, thruster(i).polarForce.magnitude)
         disc.lin_F += thruster(i).forceVector
         disc.ang_F += cross(thruster(i).relPos, thruster(i).forceVector)
      end if
   next
   
   disc.update(dt)
   
   'display
   screenlock
   clearScreen(0)
   locate 1,1 : print "<K> & <L> for thrusters";
   locate 2,1 : print "<+> & <-> for zoom in/out";
   locate 3,1 : print "<ESC> to exit";
   drawCircle(disc.position, disc.radius, disc.colour) 'flying saucer
   for i as integer = 0 to NUM_THRUSTERS - 1
      drawLine(disc.position, thruster(i).absPos, rgb(255, 255, 0)) 'rotation indicator
      if thruster(i).active = 1 then
         drawArrow(thruster(i).absPos, thruster(i).absPos - thruster(i).forceVector / 1e3, rgb(255, 127, 0)) 'thruster force indicator
      end if
   next
   screenunlock

   'time update
   key = inkey()
   sleep 1
   tPrev = tNow
   tNow = timer
   dt = tNow - tPrev
wend
screen 0
print "End"
BasicCoder2
Posts: 3404
Joined: Jan 01, 2009 7:03

Re: Physics question

Postby BasicCoder2 » Aug 17, 2019 23:49

@badidea,

I like it!

Now maybe make it into some kind of game?
Perhaps manoeuvring through an asteroid belt looking for natural resources or combat with opponents?
With asteroids to give a sense of relative motion I would suggest if you can make the origin always be on the space ship?
Maybe manoeuvre to lock onto a mother ship?
Of course in real space craft all this fine control will be done by computers rather than by manual control.
badidea
Posts: 1617
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Physics question

Postby badidea » Aug 18, 2019 10:54

BasicCoder2 wrote:Now maybe make it into some kind of game?

That is the plan, that is also why this 'physics question' is in the 'Game Dev' section :-)

First, I will try to make something for the The 50 years ago moon landing 4K contest!
Current code however is already > 4kB.

Spaceship control with dedicated side thrusters (and confusing velocity indicator):

Code: Select all

#include "fbgfx.bi"

const as single PI = 4 * atn(1)
dim shared as single PPM = 3 'pixels per meter
const SW = 800, SH = 600

const K_ESC = chr(27)
const K_MIN = chr(45)
const K_UND = chr(95)
const K_PLU = chr(61)
const K_EQU = chr(43)

screenres SW, SH, 32
width SW \ 8, SH \ 16

'-------------------------------------------------------------------------------

type sgl2d
   dim as single x, y
   declare constructor
   declare constructor(x as single, y as single)
   declare operator cast () as string
end type

constructor sgl2d
end constructor

constructor sgl2d(x as single, y as single)
   this.x = x : this.y = y
end constructor

operator sgl2d.cast () as string
   return str(x) & "," & str(y)
end operator

operator +(a as sgl2d, b as sgl2d) as sgl2d
   return sgl2d(a.x + b.x, a.y + b.y)
end operator

operator -(a as sgl2d, b as sgl2d) as sgl2d
   return sgl2d(a.x - b.x, a.y - b.y)
end operator

operator /(a as sgl2d, div as single) as sgl2d
   return sgl2d(a.x / div, a.y / div)
end operator

operator *(a as sgl2d, mul as single) as sgl2d
   return sgl2d(a.x * mul, a.y * mul)
end operator

function cross(a as sgl2d, b as sgl2d) as single
   return a.x * b.y - a.y * b.x
end function

'-------------------------------------------------------------------------------

type polar
   dim as single angle
   dim as single magnitude
end type

function polarToCartesian(angle as single, radius as single) as sgl2d
   return sgl2d(cos(angle) * radius, sin(angle) * radius)
end function

function degToRad(degrees as single) as single
   return (degrees / 180) * PI
end function

function rotatedVector(v as sgl2d, rotAngle as single) as sgl2d
   dim as sgl2d tmp
   tmp.x = cos(rotAngle) * v.x - sin(rotAngle) * v.y
   tmp.y = sin(rotAngle) * v.x + cos(rotAngle) * v.y
   return tmp
end function

sub clearScreen(c as ulong)
   line(0, 0)-(SW - 1, SH - 1), c, bf
end sub

'scaled circle using PPM, y-axis pointing up, center = 0, 0
sub drawCircle(p as sgl2d, r as single, c as ulong)
   circle(SW \ 2 + p.x * PPM, SH \ 2 - p.y * PPM), r * PPM, c
end sub

'scaled line using PPM, y-axis pointing up, center = 0, 0
sub drawLine(p1 as sgl2d, p2 as sgl2d, c as ulong)
   line(SW \ 2 + p1.x * PPM, SH \ 2 - p1.y * PPM)-_
      (SW \ 2 + p2.x * PPM, SH \ 2 - p2.y * PPM), c
end sub

sub drawArrow(p1 as sgl2d, p2 as sgl2d, c as ulong)
   drawLine(p1, p2, c)
   dim as sgl2d posVector = p2 - p1
   posVector /= 3 '1/3 length
   drawLine(p1, p1 + rotatedVector(posVector, degToRad(+30)), c)
   drawLine(p1, p1 + rotatedVector(posVector, degToRad(-30)), c)
end sub

'-------------------------------------------------------------------------------

type disc_object
   dim as single radius '[m]
   dim as single height '[m]
   dim as single density '[kg/m^3]
   dim as ulong colour '[m]
   'linear motion properties
   dim as sgl2d position 'position [m]
   dim as single lin_m 'mass [kg]
   dim as sgl2d lin_F 'force [N] [kg*m/s^2]
   dim as sgl2d lin_a 'acceleration [m/s^2]
   dim as sgl2d lin_v 'velocity [m/s]
   dim as sgl2d lin_p 'momentum [kg*m/s]
   dim as single lin_E 'Kinetic energy [J] [kg*m^2/s^2]
   'Rotational motion properties
   dim as single angle 'angular position (theta) [rad]
   dim as single ang_F 'torque (tau) [N*m] [kg*m^2/s^2]
   dim as single ang_m 'angular mass, moment of inertia (I) [kg*m^2]
   dim as single ang_a 'angular velocity (alpha) [rad/s^2]
   dim as single ang_v 'angular velocity (omega) [rad/s]
   dim as single ang_p 'angular momentum (L) [kg*m^2/s]
   dim as single ang_E 'Kinetic energy [J] [kg*m^2/s^2]
   '
   declare sub init(r as single, h as single, d as single, p as sgl2d, c as ulong)
   declare sub update(dt as double)
end type

'Set radius, height, density, position
'Calculate mass and rotational inertia
sub disc_object.init(r as single, h as single, d as single, p as sgl2d, c as ulong)
   radius = r
   height = h
   density = d
   position = p
   colour = c
   lin_m = PI * r ^ 2 * d
   ang_m = 0.5 * lin_m * r ^ 2
end sub

'update position and angle
sub disc_object.update(dt as double)
   lin_a = lin_F / lin_m
   lin_v += lin_a * dt
   position += lin_v * dt
   ang_a = ang_F / ang_m
   ang_v += ang_a * dt
   angle += ang_v * dt
end sub

'-------------------------------------------------------------------------------

type thruster_type
   '''init paramaters
   dim as polar polarForce '(rad, N)
   dim as polar polarPos '(rad, m)
   '''variable paramaters
   dim as sgl2d forceVector '(N, N)
   dim as sgl2d relPos, absPos '(m, m)
   dim as integer active
   declare sub init(forceMagnitude as single, forceDirection as single, posAngle as single, posRadius as single)
   declare sub updatePosition(bodyPos as sgl2d, bodyAngle as single)
end type

sub thruster_type.init(forceDirection as single, forceMagnitude as single, posAngle as single, posRadius as single)
   polarForce = type(forceDirection, forceMagnitude) 'thruster action
   polarPos = type(posAngle, posRadius) 'position of thruster on ship
end sub

sub thruster_type.updatePosition(bodyPos as sgl2d, bodyAngle as single)
   relPos = polarToCartesian(bodyAngle + polarPos.angle, polarPos.magnitude)
   absPos = bodyPos + relPos
end sub

'-------------------------------------------------------------------------------

const NUM_THRUSTERS = 6
const L_FW_THR = 0 'left forward thruster
const R_FW_THR = 1 'right forward thruster
const L_LO_THR = 2
const R_LO_THR = 3
const L_HI_THR = 4
const R_HI_THR = 5

dim as string key
dim as disc_object disc
dim as thruster_type thruster(NUM_THRUSTERS - 1)

disc.init(10, 1, 5, sgl2d(0, -50), rgb(127, 255, 0))
'force angle, force magnitude, polar thruster position
thruster(L_FW_THR).init(0.5 * pi, 2e4, -0.75 * pi, disc.radius)
thruster(R_FW_THR).init(0.5 * pi, 2e4, -0.25 * pi, disc.radius)
thruster(L_LO_THR).init(0.0 * pi, 1e4, -0.75 * pi, disc.radius)
thruster(R_LO_THR).init(1.0 * pi, 1e4, -0.25 * pi, disc.radius)
thruster(L_HI_THR).init(0.0 * pi, 1e4, +0.75 * pi, disc.radius)
thruster(R_HI_THR).init(1.0 * pi, 1e4, +0.25 * pi, disc.radius)

dim as double tNow = timer, tPrev = tNow, dt = 0
while key <> chr(27)
   'reset stuff
   disc.lin_F = sgl2d(0, 0)
   disc.ang_F = 0
   for i as integer = 0 to NUM_THRUSTERS - 1
      thruster(i).active = 0
   next

   'do always for display
   for i as integer = 0 to NUM_THRUSTERS - 1
      thruster(i).updatePosition(disc.position, disc.angle)
   next

   if multikey(FB.SC_UP) then
      thruster(L_FW_THR).active = 1
      thruster(R_FW_THR).active = 1
   end if

   if multikey(FB.SC_LEFT) then
      thruster(L_LO_THR).active = 1
      thruster(R_HI_THR).active = 1
   end if

   if multikey(FB.SC_RIGHT) then
      thruster(R_LO_THR).active = 1
      thruster(L_HI_THR).active = 1
   end if

   if key = K_MIN or key = K_UND then ppm /= 1.1 'zoom out
   if key = K_PLU or key = K_EQU then ppm *= 1.1 'zoom in

   for i as integer = 0 to NUM_THRUSTERS - 1
      'forces on body by active thrusters
      if thruster(i).active = 1 then
         thruster(i).forceVector = polarToCartesian(disc.angle + thruster(i).polarForce.angle, thruster(i).polarForce.magnitude)
         disc.lin_F += thruster(i).forceVector
         disc.ang_F += cross(thruster(i).relPos, thruster(i).forceVector)
      end if
   next
   
   disc.update(dt)
   
   'display
   screenlock
   clearScreen(0)
   locate 1,1 : print "<UP>, <LEFT>, <RIGHT> for thrusters";
   locate 2,1 : print "<+>, <-> for zoom in/out";
   locate 3,1 : print "<ESC> to exit";
   drawCircle(disc.position, disc.radius, disc.colour) 'flying saucer
   drawArrow(disc.position + disc.lin_v / 1, disc.position, rgb(255, 0, 127)) 'lin. speed ind.
   for i as integer = 0 to NUM_THRUSTERS - 1
      dim as ulong c = iif(i < 4, rgb(255, 255, 0), rgb(255, 255, 255))
      drawLine(disc.position, thruster(i).absPos, c) 'rotation indicator
      if thruster(i).active = 1 then
         drawArrow(thruster(i).absPos, thruster(i).absPos - thruster(i).forceVector / 1e3, rgb(255, 127, 0)) 'thruster force indicator
      end if
   next
   screenunlock

   'time update
   key = inkey()
   sleep 1
   tPrev = tNow
   tNow = timer
   dt = tNow - tPrev
wend
screen 0
print "End"
dodicat
Posts: 6026
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Physics question

Postby dodicat » Aug 18, 2019 18:16

One of the astronauts has unfortunately passed away.
But that is not the end of the story, he must now be laid to rest on a nearby asteroid.
The resting place has been prepared.

Code: Select all

 

Type pt
    As Double x,y,z
End Type
Const pi=4*Atn(1)
Dim Shared As Double systemconstant

Sub createpolygon(p() As pt,n As Long,cx As Single,cy As Single,size As Single,angle As Single=0,ecc As Single=1)
    If ecc>1 Then ecc=1
    Var slug =2*pi/n
    Var count =0
    Redim p(1 To n)
    For z As Single=0 To 2*pi+.1 Step slug
        count=count+1
        If count>n Then Exit For
        p(count)=Type((Cos(angle)*(ecc*(size)*Cos(z))-Sin(angle)*(size)*Sin(z))+cx,_
        (Sin(angle)*(ecc*(size)*Cos(z))+Cos(angle)*(size)*Sin(z))+cy)
    Next z
End Sub

Sub drawpolygon(p() As Pt,col As Ulong,flag As Long=0)
    Pset(p(Lbound(p)).x,(p(Lbound(p)).y)),col
    Dim As Single cx=p(Lbound(p)).x,cy=p(Lbound(p)).y
    For n As Long=Lbound(p)+1 To Ubound(p)
        cx+=p(n).x:cy+=p(n).y
        Line -(p(n).x,p(n).y),col
    Next n
    Line-(p(Lbound(p)).x,p(Lbound(p)).y),col
    cx/=(Ubound(p)-Lbound(p)+1):cy/=(Ubound(p)-Lbound(p)+1)
    If flag=0 Then Paint (cx,cy),col,col
End Sub

Sub push(pg() As pt,p1 As pt,p2 As pt,dirn As pt,Byref angle As Single,impulsefactor As Single=1)
    #define dot(v1,v2) (v1.x*v2.x+v1.y*v2.y+v1.z*v2.z)
    #define dist(p1,p2) Sqr((p1.x-p2.x)^2 + (p1.y-p2.y)^2)
    #define length(p1) Sqr(p1.x^2 + p1.y^2)
    #define cross(v1,v2) Type<pt>(v1.y*v2.z-v2.y*v1.z,-(v1.x*v2.z-v2.x*v1.z),v1.x*v2.y-v2.x*v1.y)
    #define normalize(p1)  Type<pt>(p1.x/Length(p1),p1.y/Length(p1),p1.z/Length(p1))
    #macro get_angle(_p_,ret1)
    Scope
        Dim As pt L1=(_p_(1).x-_p_(2).x,_p_(1).y-_p_(2).y)'leg 1
        Dim As pt L2=(_p_(3).x-_p_(2).x,_p_(3).y-_p_(2).y)'leg 2
        Var NL1=normalize(L1)
        Var NL2=normalize(L2)
        ret1= Acos(dot(NL1,NL2))
        Dim As pt cr =cross(L1,L2)
        If cr.z>0 Then ret1=2*pi-ret1
    End Scope
    #endmacro
    #define drawto(x,y,angle,dst) Type<pt>(x+dst*Cos(angle),y+dst*Sin(angle))
    #macro shortline(fp,p ,Ln,ret2)
    Scope
        Dim As Single diffx=p.x-fp.x,diffy=p.y-fp.y
        Dim As Single L=Sqr(diffx*diffx+diffy*diffy)
        Ret2= Type(fp.x+Ln*diffx/L,fp.y+Ln*diffy/L)
    End Scope
    #endmacro
    #macro inpolygon(p1,p2,ret3)
    Scope
        #macro Winder(L1,L2,p)
        ((L1.x-L2.x)*(p.y-L2.y)-(p.x-L2.x)*(L1.y-L2.y))
        #endmacro
        Dim As Long index,nextindex,k=Ubound(p1)+1,wn
        For n As Integer=1 To Ubound(p1)
            index=n Mod k:nextindex=(n+1) Mod k
            If nextindex=0 Then nextindex=1
            If p1(index).y<=p2.y Then
                If p1(nextindex).y>p2.y Andalso  Winder(p1(index),p1(nextindex),p2)>0 Then wn+=1
            Else
                If p1(nextindex).y<=p2.y Andalso Winder(p1(index),p1(nextindex),p2)<0 Then wn-=1
            End If
        Next n
        Ret3= wn
    End Scope
    #endmacro
   
    Dim As Long ic
    inpolygon(pg,p1,ic)
    If ic Then Return  'if mouse in in the shape
   
    Dim As pt c
    Dim As Single size=-1e6
    For n As Long=Lbound(pg) To Ubound(pg)  'get centre
        c.x+=pg(n).x
        c.y+=pg(n).y
    Next n
    c.x/=(Ubound(pg)-Lbound(pg)+1)
    c.y/=(Ubound(pg)-Lbound(pg)+1)
    For n As Long=Lbound(pg) To Ubound(pg)  'get size
        Var l=dist(pg(n),c)
        If size<l Then size=l
    Next n
    Var L=dist(p1,p2)
    Var ang=Atan2(p2.y-p1.y,p2.x-p1.x)
    Dim As pt p=p1
    Dim As Long ctr
    Do
        shortline(p,p2,1,p)
        inpolygon(pg,p,ic)
        ctr+=1
    Loop Until ic Or ctr>L 'when hits the polygon or misses
    If ic=0 Then Return
    Dim As pt eq=drawto(c.x,c.y,ang,-200)
    Dim As pt q=Type(c.x,c.y)
    ctr=0
    Do
        shortline(q,eq,1,q)
        inpolygon(pg,q,ic)
        ctr+=1
    Loop Until ic=0 Or ctr>1000 'when exits the polygon or an escape
    Dim As pt leg1=Type(c.x+(c.x-q.x),c.y+(c.y-q.y))
    Dim As pt leg2=Type(c.x+(c.x-p.x),c.y+(c.y-p.y))
    Dim As pt pq(1 To 3)={leg1,c,leg2}
    get_angle(pq,angle)
    Dim As pt d1=Type(c.x-p.x,c.y-p.y) 'centre to edge intersection
    dirn=normalize(d1)
    'angle and dirn to be altered to suit.
    Var mass= systemconstant*size^2*Ubound(pg)*Sin(2*pi/Ubound(pg))/2
    Var anginertia=systemconstant*((mass*size^2)/6)*(1+2*(Cos(pi/Ubound(pg))^2))
    If angle>pi/2 And angle<3*pi/2 Then dirn.x=-dirn.x:dirn.y=-dirn.y
    Var impulse=impulsefactor*dist(p1,p2)
    Var linearimpulse=impulse*Cos(angle)/mass
    angle=-impulse*Sin(angle)/anginertia  'out
    dirn.x=dirn.x*linearimpulse           'out
    dirn.y=dirn.y*linearimpulse
End Sub

Function Regulate(Byval MyFps As Long,Byref fps As Long=0) As Long
    Static As Double timervalue,_lastsleeptime,t3,frames
    Var t=Timer
    frames+=1
    If (t-t3)>=1 Then t3=t:fps=frames:frames=0
    Var sleeptime=_lastsleeptime+((1/myfps)-T+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    _lastsleeptime=sleeptime
    timervalue=T
    Return sleeptime
End Function

Function Getline(x As Long,y As Long,angle As Single,dist As Long) As pt'line by angle
    Var x2=x+dist*Cos(angle)
    Var y2=y+dist*Sin(angle)
    Return Type(x2,y2)
End Function

Function inpolygon(p1() As Pt,Byval p2 As Pt) As Long
    #macro Winder(L1,L2,p)
    ((L1.x-L2.x)*(p.y-L2.y)-(p.x-L2.x)*(L1.y-L2.y))
    #endmacro
    Dim As Integer index,nextindex,k=Ubound(p1)+1,wn
    For n As Integer=1 To Ubound(p1)
        index=n Mod k:nextindex=(n+1) Mod k
        If nextindex=0 Then nextindex=1
        If p1(index).y<=p2.y Then
            If p1(nextindex).y>p2.y Andalso  Winder(p1(index),p1(nextindex),p2)>0 Then wn+=1
        Else
            If p1(nextindex).y<=p2.y Andalso Winder(p1(index),p1(nextindex),p2)<0 Then wn-=1
        End If
    Next n
    Return wn
End Function

Function OutOfBounds(p() As pt) As Long  'going off the screen
    Dim As Integer sx,sy
    Screeninfo sx,sy
    #define outside(x,y) x>sx Or x<0 Or y>sy Or y<0
    For n As Long=Lbound(p) To Ubound(p)
        If outside(p(n).x,p(n).y) Then Return 1
    Next
    Return 0
End Function

Function measure(p() As pt,q() As pt) As Long
    For n As Long=Lbound(p) To Ubound(p)
        If inpolygon(q(),p(n))=0 Then Return 0
    Next
    Return -1
End Function

Sub make(p() As Pt)
    Dim As pt c
    Dim As Long ct,n,p1,p2
    For n=Lbound(p) To Ubound(p)
        ct+=1
        c.x+=p(n).x
        c.y+=p(n).y
    Next n
    c.x=c.x/ct
    c.y=c.y/ct
    For p1=Lbound(p) To Ubound(p)-1
        For p2=p1+1 To Ubound(p)
            If Atan2(p(p1).y-c.y,p(p1).x-c.x)< Atan2(p(p2).y-c.y,p(p2).x-c.x) Then
                Swap p(p1),p(p2)
            End If
        Next p2
    Next p1
End Sub

Sub set(p() As pt)
    Randomize 2
    For n As Long=Lbound(p) To Ubound(p)
        p(n)=Type(-150+Rnd*800,100+Rnd*500)
    Next
End Sub

Function start As Long
    Redim As pt p(),q() ' polygons
    Dim As Long mx,my,wheel,btn,flag,life 'for mouse
    Dim As Single x=700,y=300  'start position
    Dim As pt getdirection,lastdirection
    Dim As Single getangle,TurnAngle,lastangle
    Dim As Single size=100
    systemconstant=1/size
    Dim As Long numsides=6
    Dim As Single eccentricity=.5
    Dim As Single impulsefactor=1
    Dim As Long getfps
    Dim As Long length=100
    Dim As String msg
    Dim As Long roomforerror=10
    createpolygon(q(),numsides,200,400,size+roomforerror,0,eccentricity)
    Redim As pt a(20)
    set(a())
    make(a())
   
    Screen 20,32
    Do
        Getmouse mx,my,wheel,btn
        Screenlock
        Cls
        drawpolygon(a(),Rgb(100,100,100))
        drawpolygon(q(),Rgb(50,50,50))
        drawpolygon(q(),Rgb(50,50,50))
        Draw String (20,10),"Mouse wheel for impulse direction, left button to nudge"
        Draw String(20,30),"framerate "&getfps
        Draw String(20,60),"Mistakes so far "+Str(life) +" of 4"
        createpolygon(p(),numsides,x,y,size,TurnAngle,eccentricity)
        drawpolygon(p(),Rgb(0,100,255))
        drawpolygon(p(),Rgb(200,100,0),1)
        Draw String(20,79),msg
        If msg="Done" Then
            Locate 15,15
            Print "You have won, press a key to end"
            Screenunlock
            Sleep
            End
        End If
        If life>3 Then
            Locate 15,15
            Print "You have lost, press a key to end"
            Screenunlock
            Sleep
            End
        End If 
        Dim As pt x1=Type(mx,my)
        Dim As pt x2=Getline(mx,my,wheel/5,length)
        Line(x1.x,x1.y)-(x2.x,x2.y),Rgb(200,0,0)
       
        If btn=1 And flag=0 And inpolygon(p(),x2) And inpolygon(p(),x1)=0 Then
            lastangle+=getangle
            lastdirection.x+=getdirection.x
            lastdirection.y+=getdirection.y
            push (p(),x1,x2,getdirection,getangle,impulsefactor)
        End If
        'motion
        x+=getdirection.x+lastdirection.x
        y+=getdirection.y+lastdirection.y
        TurnAngle+=getangle+lastangle
       
        If OutOfBounds(p()) Then
            x=400:y=300:TurnAngle=0
            getdirection.x=0:getdirection.y=0:getangle=0
            lastdirection.x=0:lastdirection.y=0:lastangle=0
            life+=1
        End If
        flag=btn
        msg=Iif(measure(p(),q())=0,"trying","Done")
        Screenunlock
        Sleep regulate(60,getfps),1
    Loop Until Len(Inkey)
    Return 0
End Function


End start
Sleep

 
badidea
Posts: 1617
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Physics question

Postby badidea » Aug 18, 2019 20:06

dodicat wrote:One of the astronauts has unfortunately passed away.
But that is not the end of the story, he must now be laid to rest on a nearby asteroid.
The resting place has been prepared.
...

Sorry, my dead astronaut took his last intergalactic voyage.
BasicCoder2
Posts: 3404
Joined: Jan 01, 2009 7:03

Re: Physics question

Postby BasicCoder2 » Aug 19, 2019 0:56

badidea wrote:
BasicCoder2 wrote:Now maybe make it into some kind of game?

That is the plan, that is also why this 'physics question' is in the 'Game Dev' section :-)

I must say I find controlling the ship frustratingly impossible!

Of course fun retro computer games usually don't use real physics.

These 2d games can always be given a retro pseudo 3d view which I find more immersing.
The polygon version can always be shown at the same time maybe as a radar view.
For example the retro pseudo 3d view such as this one,
viewtopic.php?f=15&t=27076
I started writing code for a spaceship in an asteroid field using the retro pseudo 3d view by replacing the bushes with asteroid images and using a milky way background as shown below.
You could make this a window view from the inside of a space ship.
You would of course have different shaped asteroids and be able to vaporise them, or collect them, and so on maybe with other space ships to fight or compete with.

Asteroid belts as shown below are in fact just a work of fiction like a lot of the rubbish you see in science fiction films. Spacecraft can pass through the asteroid belt with virtually no chance of a collision. Space junk around the Earth however may be another issue over time.
Image
Last edited by BasicCoder2 on Aug 19, 2019 9:28, edited 6 times in total.

Return to “Game Dev”

Who is online

Users browsing this forum: No registered users and 1 guest