Physics question

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

Physics question

Post by badidea »

Hello all, I am trying to make a small space ship simulation game, but I got confused with the physics. Maybe someone likes to help.

Lets say I have circular space ship (a flying Saucer) with 2 forward thrusters placed off-axis of which only 1 working. Drawing:

Image

Space ship at rest. The thruster fires shortly, the space ship will start to make a linear motion and angular motion (rotation). When the thruster stops, no significant rotation has happened yet. Questions I am struggling with:

In which will be the direction of the linear motion? (y-direction only?)
How large is the force in this direction? (compared to F_thrust, a part must go to torque right?)
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: Physics question

Post by deltarho[1859] »

No response so far, 40 views, so I will take a wild guess.

Image

Thrust will be split into two forces; One toward the centre of the saucer; the other as angular momentum - he says with such confidence. <laugh>

We have

Sin(90-beta) = (towards centre)/F

So, towards centre = F * Cos(beta)

Sin(beta) = (angular momentum)/F

So, angular momentum = F * Sin(beta)
deltarho[1859]
Posts: 4292
Joined: Jan 02, 2017 0:34
Location: UK
Contact:

Re: Physics question

Post by deltarho[1859] »

The 'towards centre' force can be broken into x-y components, and we get:

dx = - F * Sin(beta) * Cos(beta) and dy = F * Cos(beta) * Cos(beta)

I reckon. <smile>
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Physics question

Post by dodicat »

Thought I would give this a try.
Every impulse depends on the weight of the mouse.
The resultant motion depends only on the given internal angle.

Code: Select all

Type pt
    As Single x,y,z
End Type

Operator -(p1 As pt,p2 As pt) As pt
Return Type(p1.x-p2.x,p1.y-p2.y)
End Operator

Operator +(p1 As pt,p2 As pt) As pt
Return Type(p1.x+p2.x,p1.y+p2.y)
End Operator

Operator *(f As Single,p As pt) As pt
Return Type(f*p.x,f*p.y)
End Operator

Type Circle
    As Single x,y
    As Long r
End Type

Const pi=4*Atn(1)

Function length(p1 As pt,p2 As pt) As Single
    Dim As Single diffx=p1.x-p2.x,diffy=p1.y-p2.y
    Return Sqr(diffx*diffx+diffy*diffy)
End Function

Function unit(p1 As pt) As pt
   #define lngth(p)  Sqr( (p1.x)^2 + (p1.y)^2+ (p1.z)^2)
    Dim As Single L=lngth(p1)
    Return Type(p1.x/L,p1.y/L,p1.z/L)
End Function

Function dot(v1 As pt,v2 As pt) As Single 'dot product |v1| * |v2| *cos(angle between v1 and v2)
    Return v1.x*v2.x+v1.y*v2.y+v1.z*v2.z
End Function

Function cross(v1 As pt,v2 As pt) As pt '|cross product|= |v1| * |v2| *sin(angle between v1 and v2)
    Return Type(v1.y*v2.z-v2.y*v1.z,-(v1.x*v2.z-v2.x*v1.z),v1.x*v2.y-v2.x*v1.y)
End Function

Function getangle(p() As pt) As Single
    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
    Dim As Single angle=Acos(dot(unit(L1),unit(L2)))*(180/pi)'angle between legs in degrees
    If cross(l1,l2).z>0 Then angle=360-angle
    Return angle
End Function

Sub rotateimage(Byref dest As Any Ptr=0,im As Any Ptr,angle As Single,shiftx As Long=0,shifty As Long=0,sc As Single=1,miss As Ulong=Rgb(255,0,255),fixedpivot As boolean=false)
    Static As Integer pitch,pitchs,xres,yres,runflag
    Static As Any Ptr row,rows
    Static As Integer ddx,ddy,resultx,resulty
    Imageinfo im,ddx,ddy,,pitch,row
    If dest=0 Then
    Screeninfo xres,yres,,,pitchS
    rowS=Screenptr
    Else
    If sc<>1 Then 
        Dim As Integer x,y
        Imageinfo dest,x,y
    Imagedestroy dest:dest=0: dest=Imagecreate(x*sc,y*sc)
    End If
    Imageinfo dest, xres,yres,,pitchS,rows
    End If
    Dim As Long centreX=ddx\2,centreY=ddy\2
    Dim As Single sx=Sin(angle)
    Dim As Single cx=Cos(angle)
    Dim As Long mx=Iif(ddx>=ddy,ddx,ddy),shftx,shfty
    Var fx=sc*.7071067811865476,sc2=1/sc
    If fixedpivot=false Then
     shiftx+=centreX*sc-centrex
     shiftY+=centrey*sc-centrey
     End If
    For y As Long=centrey-fx*mx+1 To centrey+ fx*mx 
        Dim As Single sxcy=Sx*(y-centrey),cxcy=Cx*(y-centrey)
        shfty=y+shifty
        For x As Long=centrex-mx*fx To centrex+mx*fx 
                 If x+shiftx >=0 Then 'on the screen
                    If x+shiftx <xres Then
                        If shfty >=0 Then
                            If shfty<yres Then
            resultx=sc2*(Cx*(x-centrex)-Sxcy) +centrex:resulty=sc2*(Sx*(x-centrex)+Cxcy) +centrey
                If resultx >=0 Then 'on the image
                    If resultx<ddx Then
                        If resulty>=0 Then
                            If resulty<ddy Then
    Dim As Ulong u=*Cast(Ulong Ptr,row+pitch*((resultY))+((resultX)) Shl 2 ) 'point(image)
   If u<>miss Then *Cast(Ulong Ptr,rowS+pitchS*(y+shifty)+(x+shiftx) Shl 2)= u 'pset (screen)
                End If:End If:End If:End If
                End If:End If:End If:End If
        Next x
    Next y
End Sub


Sub createimage(Byref i As Any Ptr)
    #define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
     i=Imagecreate(200,200)
Circle i,(100,100),99,Rgb(0,100,0),,,,f
circle i,(50,50),20,rgb(200,0,0),,,,f
circle i,(150,50),20,rgb(0,200,0),,,,f
circle i,(150,150),20,rgb(0,0,200),,,,f
circle i,(50,150),20,rgb(200,200,200),,,,f
End Sub

Function shortline(fp As pt,p As pt,Ln As Long) As pt
    Dim As Single diffx=p.x-fp.x,diffy=p.y-fp.y
    Dim As Single L=Sqr(diffx*diffx+diffy*diffy)
    Return Type(fp.x+Ln*diffx/L,fp.y+Ln*diffy/L)
End Function

Function lineto(fp As pt,lp As pt,c As Circle,_out As pt) As Single
     #define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
   
   Var L=length(fp,lp)
    Dim As pt p=fp
    Dim As Long ic,ctr
    Do
        p=shortline(p,lp,1)
        ic=incircle(c.x,c.y,100,p.x,p.y)
        ctr+=1
    Loop Until ic Or ctr>L 'when it hits the circle at p
    Line(fp.x,fp.y)-(p.x,p.y)
     Line(c.x,c.y)-(p.x,p.y)
    Var q=shortline(Type(c.x,c.y),Type(c.x,c.y+100),100)
     Line(c.x,c.y)-(q.x,q.y)
     Dim As pt t=(c.x,c.y)
     Dim As pt pp(1 To 3)={t+(t-q),t,t+(t-p)}
     
   Var dx=p.x-c.x,dy=p.y-c.y
   Dim As pt r
   If p.x>=c.x Then 
    r=shortline(p,p+Type(dy,-dx),100)
    Else
    r=shortline(p,p-Type(dy,-dx),100)
    End If
   Line(p.x,p.y)-(r.x,r.y)
   _out=p
   dim as pt centre=(c.x,c.y)
   Dim As pt d=.3333*(p+q+centre)'to show the angle
    Draw String(d.x,d.y),Str(  Int(getangle(pp())))
   Return getangle(pp())*pi/180
    End Function

 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

Screen 20,32
Dim As Any Ptr i
createimage(i)
Dim As Single dx,dy,a,turn,angularimpulse,dist
Dim As Long mx,my,btn,flag,flag2,fps
Dim As Circle c
Var icx=412+dx,icy=284+dy
Dim As pt _out
start:
Do
    flag2=0
    Getmouse mx,my,,btn
    Screenlock
    Cls
    draw string(20,20),"Set the mouse underneath the circle"
    draw string(20,50),"Left mouse click for impulse"
    draw string(20,80),"Right mouse click to reset"
    draw string(20,110),"framerate = " &fps,rgb(0,200,0)
    
c=Type<Circle>(icx+100,icy+100,100)

rotateimage(,i,turn,icx,icy,1,,true)
If my>icy+200 And mx>icx And mx<icx+200 And flag=0 Then
    Locate 10
    Print "weight "; dist
    flag2=1
   a=  lineto(Type<pt>(mx,my),Type<pt>(mx,icy),c,_out)
End If

  If btn=1 and flag2 Then
      flag=1
  dx=-Sin(a)
  dy=-Cos(a)
  angularimpulse=dist*Sin(a)
End If
if flag=0 then dist=length(Type<pt>(mx,my),_out)

icx+=dx*dist/200
icy+=dy*dist/200
turn+=.0002*angularimpulse
If btn=2 or c.x<100  or c.x>1024-100 or c.y<100 Then
Screenunlock
dx=0
dy=0
icx=412+dx:icy=284+dy
a=0:flag=0
angularimpulse=0
Goto start
End If
Screenunlock
Sleep regulate(60,fps),1
Loop Until Inkey=Chr(27)
Sleep


  
A motion is easy enough to deduce from the angle, a multiple of a sin or cos of the angle.
But getting the angle and showing the lines uses up code.
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Physics question

Post by BasicCoder2 »

No math expert to explain it?

A verbal description of what I image would happen is that every time the single engine was fired the resultant force would be divided into two amounts with one going to increasing the velocity of the rocket in the opposite direction to the rocket engine firing and the other part of the force going into increasing the rotation of the rocket. The rocket rotation would simple get faster and faster. Probably what happens when a real rocket curves into a spinning death dive. The division of the force into the velocity of the rocket and the rotation of the rocket at any instance I guess is a vector problem maybe involving calculus?

Computer games often don't use real physics it only has to look good.

Here is a quick example of a rotating saucer shaped rocket with a fixed direction ship.ww and a fixed rate of rotation ship.rot but I haven't added any firing rocket to change these values as at the moment I am too busy with other projects not involving FreeBasic programming.

Edit: Dodicat's post appeared while I was composing a response. Although I can't follow his math the result looks ok. My assumption is if there were a series of impulses (continual firing) the rocket would keep changing direction and spin faster and faster.

Code: Select all

'some useful defines
Const Pi = 4 * Atn(1)
Dim Shared As single TwoPi = 8 * Atn(1)
Dim Shared As single RtoD = 180 / Pi   ' radians * RtoD = degrees
Dim Shared As single DtoR = Pi / 180   ' degrees * DtoR = radians40

const SCRW = 640
const SCRH = 480

screenres SCRW,SCRH,32
color rgb(0,0,0),rgb(255,255,255):cls

type SPACESHIP
    as single  px(0 to 10)   'x position of points around axis
    as single  py(0 to 10)
    as single  rx(0 to 10)   'rotated by ww positions around axis
    as single  ry(0 to 10)
    as single  cx       'center on screen
    as single  cy    
    as integer size     'size
    as single  ww       'direction
    as integer mv       'velocity
    as single  rot      'direction of rotation +1,0,-1
    as integer alive    'flag asteroid exists
end type

dim shared as SPACESHIP ship

'read points
for i as integer = 0 to 10
    read ship.px(i),ship.py(i)
    ship.px(i) = ship.px(i)-50
    ship.py(i) = ship.py(i)-50
next i

ship.size = 5
ship.cx = SCRW\2
ship.cy = SCRH\2
ship.rot = 1*DtoR   'rotation rate in degrees
ship.mv = 1         'change in position along angle ww
ship.ww = 45        'direction of ship (0 to 359)

sub drawShip()
    screenlock
    cls
    for i as integer = 1 to 10
        line (ship.px(i-1)+ship.cx,ship.py(i-1)+ship.cy)-(ship.px(i)+ship.cx,ship.py(i)+ship.cy),rgb(0,0,0)
    next i
    circle (ship.cx,ship.cy),1,rgb(255,0,255)
    circle (ship.cx,ship.cy),50,rgb(0,0,0)
    screenunlock
end sub

dim as single tpx,tpy,dx,dy

do
    
    'rotate ship
    for i as integer = 0 to 10
        tpx = cos(ship.rot)*ship.px(i) - sin(ship.rot)*ship.py(i)
        tpy = cos(ship.rot)*ship.py(i) + sin(ship.rot)*ship.px(i)
        ship.px(i) = tpx
        ship.py(i) = tpy
    next i

    'move and draw ship
    dx = cos(ship.ww) * ship.mv
    dy = sin(ship.ww) * ship.mv

    ship.cx = ship.cx + dx
    ship.cy = ship.cy + dy
  
    'adjust for wrap around
    if ship.cx > SCRW then ship.cx = 0
    if ship.cx < 0    then ship.cx = SCRW
    if ship.cy > SCRH then ship.cy = 0
    if ship.cy < 0    then ship.cy = SCRH
    drawship()

    sleep 20
    
loop until multikey(&H01)

data 50,0
data 62,36
data 98,36
data 69,57
data 80,90
data 50,70
data 20,90
data 31,57
data 2,36
data 38,36
data 50,0
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Physics question

Post by badidea »

Somehow it seems counter-intuitive that if the thrust is in the y-direction only that the resulting linear motion can be in a different direction.
If it be would be a billiard ball and the arrow a cue (stick) with friction between them then motion like in docicat's code seems correct. I'll think some more...
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: Physics question

Post by D.J.Peters »

The axis of rotation "r" is the cross product of (d,F)

where
F: is the force from the engine acts on the spaceship
d: is the direction from center of the space chip to the point where the force acts on

In space (without gravity) the center is the center of the object COO your spaceship
but for example on earth the center is the center of mass COM you know the difference ?

If not here are tutorials about physics in games:
https://research.ncl.ac.uk/game/masters ... tutorials/

Joshy
Last edited by D.J.Peters on Jul 16, 2019 22:18, edited 1 time in total.
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Physics question

Post by BasicCoder2 »

The force is not through the centre of mass even if it is in "the y direction". Try pushing a cup with your finger. If it is through the centre of mass it will go in whatever direction you push. If however you use your finger to push at the left or right of the centre of mass (nothing to do with being along the y direction as such) the cup will rotate as well as move. Perhaps a better example is hitting a stick (in the y direction if you like although that isn't relevant). Hit it dead centre and it will fly away without rotating. Hit it toward one end and it will spin as well.
Last edited by BasicCoder2 on Jul 16, 2019 22:24, edited 3 times in total.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Physics question

Post by dodicat »

By the way D.J.Peters I forgot to thank you for speeding up my image rotate.
I used my old rotate here, but I may use the speeded up version in future.
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: Physics question

Post by D.J.Peters »

dodicat wrote:... I forgot to thank you for speeding up my image rotate ...
No problem it was fun for me.
By the way I compared the optimized version of your rotation code with MultiPut V2.0 I would prefer MultiPut for games.

Joshy
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Physics question

Post by BasicCoder2 »

You have piqued my interest in the problem so I am working on it some more. Maybe I will figure it out, maybe not. Will perhaps give it another look tomorrow. I see the problem as the same physics (but without water friction) of a boat with an outboard motor.

The left/right arrow keys increase rotational thrust clockwise or counter clockwise. Imagine two rocket engines at right angles to the centre of mass.

The up/down arrow keys increase or decrease linear velocity (along current direction). Imagine a rocket engine firing away from the centre of mass and another rocket engine (retro rocket) firing toward the centre of mass.

I have not animated the firing of the rocket engines yet or worked out how the thrust would be distributed between the angular velocity and the linear velocity of the spaceship. The image is of your hypothetical spaceship and not the one currently being modelled in the actual program.

Have to copy paste this image to your Paint program then load and resave it as a bitmap file in the same folder as the spaceship program.
Image

Code: Select all

'some useful defines
Const Pi = 4 * Atn(1)
Dim Shared As single TwoPi = 8 * Atn(1)
Dim Shared As single RtoD = 180 / Pi   ' radians * RtoD = degrees
Dim Shared As single DtoR = Pi / 180   ' degrees * DtoR = radians

'badidea
'https://www.freebasic.net/forum/viewtopic.php?f=15&t=27011&hilit=multiput&start=15
sub sprite_rotate(srcImg as any ptr, dstImg as any ptr, rotation as single, defaultColour as integer)
  'replace point & pset with direct memory access
  dim as integer srcWidth, srcHeight, srcPitch, dstPitch
  dim as single xctr, yctr
  dim as integer xdst, ydst
  dim as integer xsrc, ysrc
  dim as ulong colour 'was integer
  dim as single ySin, yCos
  dim as single sinRot = sin(rotation)
  dim as single cosRot = cos(rotation)
  
  dim as ulong ptr scrPixels, dstPixels 'was integer
  imageInfo srcImg, srcWidth, srcHeight, , srcPitch, scrPixels
  imageInfo dstImg,         ,          , , dstPitch, dstPixels
  dstPitch shr= 2
  srcPitch shr= 2
    
  xctr = srcWidth / 2
  yctr = srcHeight / 2
  screenlock
  for ydst = 0 to srcHeight-1
    ySin = (yctr - ydst) * sinRot + xctr + 0.5
    yCos = (ydst - yctr) * cosRot + yctr + 0.5
    for xdst = 0 to srcWidth-1
      xsrc = int((xdst - xctr) * cosRot + ySin)
      ysrc = int((xdst - xctr) * sinRot + yCos)
      if (xsrc >= 0) and (xsrc < srcWidth) and (ysrc >= 0) and (ysrc < srcHeight) then
        'colour = point(xsrc, ysrc, srcImg)
        colour = scrPixels[ysrc * srcPitch + xsrc]
      else
        colour = defaultColour
      end if
      'pset dstImg, (xdst, ydst), colour
      dstPixels[ydst * dstPitch + xdst] = colour
    next
  next
  screenunlock
end sub

const SCRW = 1200
const SCRH = 600
screenres SCRW,SCRH,32
color rgb(0,0,0),rgb(255,255,255):cls

dim shared as any ptr image,rotImage
image = imagecreate(161,161)
rotImage = imagecreate(161,161)
bload "saucer.bmp",image

type SPACESHIP
    as single  cx       'center on screen
    as single  cy    
    as single  ww       'angle of spaceship
    as single  mv       'velocity along angle of rotation
    as single  rot      'rate of rotation
end type

dim shared as SPACESHIP ship

ship.cx = SCRW\2
ship.cy = SCRH\2
ship.rot = 0           'rotation rate in degrees
ship.mv  = 0           'velocity along angle ww
ship.ww  = 0           'direction of ship (0 to 359)

dim as single dx,dy

do
    
    'fire retro rocket engine
    if multikey(&H50) then ship.mv = ship.mv - 0.2
    'fire rocket engine
    if multikey(&H48) then ship.mv = ship.mv + 0.2

    'fire turning rocket engine1
    if multikey(&H4B) then
        ship.rot = ship.rot - 0.2
        if ship.rot < 0 then
            ship.rot = ship.rot + 360
        end if
    end if
    
    'fire turning rocket engine2
    if multikey(&H4D) then
        ship.rot = ship.rot + 0.2
        if ship.rot > 359 then
            ship.rot = ship.rot - 360
        end if
    end if
        
    'add rotation to current direction
    ship.ww = ship.ww + ship.rot
    
    if ship.ww > 359 then
        ship.ww = ship.ww - 360
    end if
    
    'move along direction by ships velocity
    dx = cos(ship.ww*DtoR) * ship.mv
    dy = sin(ship.ww*DtoR) * ship.mv

    ship.cx = ship.cx + dx
    ship.cy = ship.cy + dy
  
    'adjust for wrap around
    if ship.cx > SCRW then ship.cx = 0
    if ship.cx < 0    then ship.cx = SCRW
    if ship.cy > SCRH then ship.cy = 0
    if ship.cy < 0    then ship.cy = SCRH
    
    screenlock
    cls
    locate 2,2
    print ship.ww
    sprite_rotate(image,rotImage,(360-ship.ww)*DtoR,rgb(255,255,255))
    put (ship.cx,ship.cy),rotImage,trans
    screenunlock
    
    sleep 20
    
loop until multikey(&H01)
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Physics question

Post by badidea »

BasicCoder2 wrote:...
Nice demo, but you skip most of the physics involved (forces, mass, inertia). Direct change of rotation and speed. Which is fine for a game, but not what I am looking for (in my game).
D.J.Peters wrote:In space (without gravity) the center is the center of the object COO your spaceship
but for example on earth the center is the center of mass COM you know the difference ?
I don't know center of the object COO. I did read about center of gravity, but my space ship is in space, gravity can be ignored for now.
Also, my flying saucer is a disc of uniform density formed by a perfect circle and a fixed height/thickness.
D.J.Peters wrote: If not here are tutorials about physics in games:
https://research.ncl.ac.uk/game/masters ... tutorials/
Thanks.

I may sound like Albert now, but I think you are all wrong.
Allow me to present the following similar case:

Image

The space ship is now a borg cube and a bullet is fired at the edge once.
Again, in which direction will the linear motion be, and is this case different (except for the different I/m ratio)?

Image

Reading more about Rigid Body Dynamics in the mean time...
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Physics question

Post by BasicCoder2 »

badidea wrote:Nice demo, but you skip most of the physics involved (forces, mass, inertia). Direct change of rotation and speed. Which is fine for a game, but not what I am looking for (in my game).
Maybe you need a 2d physics engine?
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Physics question

Post by badidea »

BasicCoder2 wrote:
badidea wrote:Nice demo, but you skip most of the physics involved (forces, mass, inertia). Direct change of rotation and speed. Which is fine for a game, but not what I am looking for (in my game).
Maybe you need a 2d physics engine?
That is an option, but I prefer to grok the physics and implement it myself.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Physics question

Post by dodicat »

Here is a general strike.
I have used the property of mass of a disc and moment of inertia of a disc.
I have applied a system constant to keep the motion reasonable.
Drag the dots and press a key to apply an impulse.
Right click to reset.
(The laws of physics apply everywhere), maybe not here.

Code: Select all

  
Const pi=4*Atn(1)
Const systemconstant=.01
Const radius=100 

#define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
#define onscreen (mx>0) and (mx<xres) and (my>0) and (my<yres)

Type pt
    As Single x,y,z
End Type

Operator -(p1 As pt,p2 As pt) As pt
Return Type(p1.x-p2.x,p1.y-p2.y)
End Operator

Operator +(p1 As pt,p2 As pt) As pt
Return Type(p1.x+p2.x,p1.y+p2.y)
End Operator

Operator *(f As Single,p As pt) As pt
Return Type(f*p.x,f*p.y)
End Operator

Type Circle
    As Single x,y
    As Long r
End Type

Function length(p1 As pt,p2 As pt) As Single
    Dim As Single diffx=p1.x-p2.x,diffy=p1.y-p2.y
    Return Sqr(diffx*diffx+diffy*diffy)
End Function

Function unit(p1 As pt) As pt
   #define lngth(p)  Sqr( (p1.x)^2 + (p1.y)^2+ (p1.z)^2)
    Dim As Single L=lngth(p1)
    Return Type(p1.x/L,p1.y/L,p1.z/L)
End Function

Function dot(v1 As pt,v2 As pt) As Single 'dot product |v1| * |v2| *cos(angle between v1 and v2)
    Return v1.x*v2.x+v1.y*v2.y+v1.z*v2.z
End Function

Function cross(v1 As pt,v2 As pt) As pt '|cross product|= |v1| * |v2| *sin(angle between v1 and v2)
    Return Type(v1.y*v2.z-v2.y*v1.z,-(v1.x*v2.z-v2.x*v1.z),v1.x*v2.y-v2.x*v1.y)
End Function

Function getangle(p() As pt) As Single
    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
    Dim As Single angle=Acos(dot(unit(L1),unit(L2)))*(180/pi)'angle between legs in degrees
    If cross(l1,l2).z>0 Then angle=360-angle
    Return angle
End Function
  
Sub rotateimage(Byref dest As Any Ptr=0,im As Any Ptr,angle As Single,shiftx As Long=0,shifty As Long=0,sc As Single=1,miss As Ulong=Rgb(255,0,255),fixedpivot As boolean=false)
    Static As Integer pitch,pitchs,xres,yres,runflag
    Static As Any Ptr row,rows
    Static As Integer ddx,ddy,resultx,resulty
    Imageinfo im,ddx,ddy,,pitch,row
    If dest=0 Then
    Screeninfo xres,yres,,,pitchS
    rowS=Screenptr
    Else
    If sc<>1 Then 
        Dim As Integer x,y
        Imageinfo dest,x,y
    Imagedestroy dest:dest=0: dest=Imagecreate(x*sc,y*sc)
    End If
    Imageinfo dest, xres,yres,,pitchS,rows
    End If
    Dim As Long centreX=ddx\2,centreY=ddy\2
    Dim As Single sx=Sin(angle)
    Dim As Single cx=Cos(angle)
    Dim As Long mx=Iif(ddx>=ddy,ddx,ddy),shftx,shfty
    Var fx=sc*.7071067811865476,sc2=1/sc
    If fixedpivot=false Then
     shiftx+=centreX*sc-centrex
     shiftY+=centrey*sc-centrey
     End If
    For y As Long=centrey-fx*mx+1 To centrey+ fx*mx 
        Dim As Single sxcy=Sx*(y-centrey),cxcy=Cx*(y-centrey)
        shfty=y+shifty
        For x As Long=centrex-mx*fx To centrex+mx*fx 
                 If x+shiftx >=0 Then 'on the screen
                    If x+shiftx <xres Then
                        If shfty >=0 Then
                            If shfty<yres Then
            resultx=sc2*(Cx*(x-centrex)-Sxcy) +centrex:resulty=sc2*(Sx*(x-centrex)+Cxcy) +centrey
                If resultx >=0 Then 'on the image
                    If resultx<ddx Then
                        If resulty>=0 Then
                            If resulty<ddy Then
    Dim As Ulong u=*Cast(Ulong Ptr,row+pitch*((resultY))+((resultX)) Shl 2 ) 'point(image)
   If u<>miss Then *Cast(Ulong Ptr,rowS+pitchS*(y+shifty)+(x+shiftx) Shl 2)= u 'pset (screen)
                End If:End If:End If:End If
                End If:End If:End If:End If
        Next x
    Next y
End Sub

Sub createimage(Byref i As Any Ptr)
     i=Imagecreate(200,200)
Circle i,(100,100),100,Rgb(0,100,0),,,,f
Circle i,(50,50),20,Rgb(200,0,0),,,,f
Circle i,(150,50),20,Rgb(0,200,0),,,,f
Circle i,(150,150),20,Rgb(0,0,200),,,,f
Circle i,(50,150),20,Rgb(200,200,200),,,,f
End Sub

Function shortline(fp As pt,p As pt,Ln As Long) As pt
    Dim As Single diffx=p.x-fp.x,diffy=p.y-fp.y
    Dim As Single L=Sqr(diffx*diffx+diffy*diffy)
    Return Type(fp.x+Ln*diffx/L,fp.y+Ln*diffy/L)
End Function

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

Function lineto(c As Circle,_out As pt,p2() As pt,dirn As pt,Byref strike As Long) As Single
    Var L=length(p2(1),p2(2))
    Var ang=Atan2(p2(2).y-p2(1).y,p2(2).x-p2(1).x)
    Dim As pt p=p2(1)
    Dim As Long ic,ctr
    Do
         p=shortline(p,p2(2),1)
        ic=incircle(c.x,c.y,100,p.x,p.y)
        ctr+=1
        If ic Then strike=1 Else strike=0
    Loop Until ic Or ctr>L 'when it hits the circle at p

    Line(p.x,p.y)-(p2(1).x,p2(1).y),Rgb(0,200,0)
  
    If strike Then  Line(c.x,c.y)-(p.x,p.y)
    Var q=drawline(c.x,c.y,ang,-100)
     If strike Then Line(c.x,c.y)-(q.x,q.y)
     Dim As pt t=(c.x,c.y)
     Dim As pt pp(1 To 3)={t+(t-q),t,t+(t-p)} 'array to hold three points (two legs metting at t)
   _out=p          'out the intersection wth disc  
   dirn=unit(p-t)  'out the direction
   Dim As pt centre=(c.x,c.y)
   Dim As pt d=.3333*(p+q+centre)'to show the angle
   Dim As Single angle=getangle(pp())
   If strike Then Draw String(d.x,d.y),Str(Int(angle))
   Return angle*pi/180 'return in radians
    End Function

 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

#macro display
 flag2=0
    Screenlock
    Cls
    Draw String(20,20),"Move the small circles by mouse"
    Draw String(20,50),"Press spacebar for impulse"
    Draw String(20,80),"Right mouse click to reset"
    Draw String(20,110),"Angular speed " &abs(angularimpulse*180/pi)
    Draw String(20,140),"Linear speed " &speed
    Draw String(20,170),"framerate = " &fps,Rgb(0,200,0)
 
rotateimage(,i,turn,icx,icy,1) 'apply motion
c=Type<Circle>(icx+100,icy+100,100) 'centre and radius
If flag=0  Then
    Locate 15
    Print "     weight "; impulse
    flag2=1
   a=  lineto(c,_out,p2(),dirn,strike) 'a=angle return as shown in radians
End If

  If Len(Inkey) And flag2 And strike Then
      flag=1
  linearimpulse=impulse*Cos(a)/mass 
  dx=-dirn.x*linearimpulse
  dy=-dirn.y*linearimpulse
  angularimpulse=impulse*Sin(a)/anginertia 
  speed=Sqr(dx*dx+dy*dy) 'to show value on screen
End If


For z As Long=1 To 2 'the two drag spots
    Dim As Ulong clr=Iif(z=1,Rgb(200,0,0),Rgb(0,200,0))
    Circle (p2(z).x,p2(z).y),5,clr,,,,f
Next

If flag=0 Then impulse=2*length(p2(1),_out) 'arbitrary weight as a function of mouse potition

'=====  motion ======
icx+=dx
icy+=dy
turn+=angularimpulse
Screenunlock

'====================
#endmacro

#macro mouse(m)
Scope
Dim As Long x=mx,y=my,dx2,dy2
While btn = 1 Or btn=2
    Display()
    Getmouse mx,my,,btn
    If onscreen Then
        If mx<>x Or my<>y  Then
            dx2 = mx - x
            dy2 = my - y
            x = mx
            y = my
            p2(m).x=x+dx2
            p2(m).y=y+dy2
        End If
    End If
Wend
End Scope
#endmacro

Screen 20,32
Dim As Integer xres,yres
Screeninfo xres,yres
Dim As Any Ptr i
createimage(i)
Dim As Single dx,dy,a,turn,angularimpulse,impulse,linearimpulse,speed


Dim As Single mass= systemconstant*pi*radius^2
Dim As Single anginertia=systemconstant*.5*mass*radius^2   'moment of inertia of a disc
Dim As Long mx,my,btn,flag,flag2,fps,strike

Dim As Circle c
Var icx=412.0,icy=284.0 'set at this position icx,icy (top left of image)
Dim As pt _out,p2(1 To 2)={(200,200),(600,500)},dirn

start:
Do
    Getmouse mx,my,,btn
    strike=0
display

 For n As Long=1 To 2
        If incircle(p2(n).x,p2(n).y,10,mx,my) And btn=1  Then
            mouse(n)
        End If
    Next n

If btn=2 Or c.x<radius  Or c.x>xres-radius Or c.y<radius Or c.y>yres-radius Then 'reset
Screenunlock
dx=0
dy=0
icx=412:icy=284
a=0:flag=0
angularimpulse=0
speed=0
Goto start
End If
Sleep regulate(60,fps),1
Loop Until Multikey(1)
Sleep


Post Reply