how to rotate around an arbitrary axis

General FreeBASIC programming questions.
Post Reply
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

how to rotate around an arbitrary axis

Post by BasicCoder2 »

The problem is what equations could be used so the keys only allow rotation around one axis.
The up/down cursor keys always seem to have complete control over rotation around the green axis however the other keys do not unless the cube is in its starting position (hit space key to reset to starting position).

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

screenres 640,480,32
color rgb(0,0,0),rgb(255,255,255):cls

const iw = 100
const ih = 100

dim shared as any ptr image(0 to 5)
for i as integer = 0 to 5
    image(i) = imagecreate(iw,ih)
    line image(i),(0,0)-(iw-1,ih-1),rgb(int(rnd(1)*256),int(rnd(1)*256),int(rnd(1)*256)),bf
    circle image(i),(iw/2,ih/2),34,rgb(int(rnd(1)*256),int(rnd(1)*256),int(rnd(1)*256)),,,,f
next i

dim shared as integer posx,posy,inv
posx = 320  'position of iso display on screen
posy = 240

type POINT3D
    as single x
    as single y
    as single z
    as ulong  c
end type

'make eight points of a absPt
'compute max dots to display and total dots to rotate
dim shared as integer TOT_DOTS

for x as integer = 0 to iw-1
    for y as integer = 0 to ih-1
        TOT_DOTS = TOT_DOTS + 1
    next y
next x

for x as integer = 0 to iw-1
    for y as integer = 0 to ih-1
        TOT_DOTS = TOT_DOTS + 1
    next y
next x

for x as integer = 0 to iw-1
    for y as integer = 0 to ih-1
        TOT_DOTS = TOT_DOTS + 1
    next y
next x

for x as integer = 0 to iw-1
    for y as integer = 0 to ih-1
        TOT_DOTS = TOT_DOTS + 1
    next y
next x

for x as integer = 0 to iw-1
    for y as integer = 0 to ih-1
        TOT_DOTS = TOT_DOTS + 1
    next y
next x

for x as integer = 0 to iw-1
    for y as integer = 0 to ih-1
        TOT_DOTS = TOT_DOTS + 1
    next y
next x

'create axis points not rotated
for x as single = -200 to 200
    TOT_DOTS = TOT_DOTS + 1
next x

for y as single = -200 to 200
    TOT_DOTS = TOT_DOTS + 1
next y

for z as single = -200 to 200
    TOT_DOTS = TOT_DOTS + 1
next z

'=============   THESE LOOPS COMPUTE TOT_DOTS ==============

dim shared as Point3D abs3D(0 to TOT_DOTS)  'absolute positions
dim shared as Point3D rel3D(0 to TOT_DOTS)  'relative positions after any rotation
dim shared as single angle,x,y,z,rx,ry,rz,px,py
dim shared as single aRotX,aRotY,aRotZ

'now give values to dots on each square surface
dim as integer ii
for x as integer = 0 to iw-1
    for y as integer = 0 to ih-1
        abs3D(ii).x = x-50
        abs3D(ii).y = y-50
        abs3D(ii).z = -50
        abs3D(ii).c = point(x,y,image(0))
        ii = ii + 1
    next y
next x

for x as integer = 0 to iw-1
    for y as integer = 0 to ih-1
        abs3D(ii).x = x-50
        abs3D(ii).y = y-50
        abs3D(ii).z = 50
        abs3D(ii).c = point(x,y,image(1))
        ii = ii + 1
    next y
next x

for x as integer = 0 to iw-1
    for y as integer = 0 to ih-1
        abs3D(ii).z = x-50
        abs3D(ii).y = y-50
        abs3D(ii).x = -50
        abs3D(ii).c = point(x,y,image(2))
        ii = ii + 1
    next y
next x

for x as integer = 0 to iw-1
    for y as integer = 0 to ih-1
        abs3D(ii).z = x-50
        abs3D(ii).y = y-50
        abs3D(ii).x = 50
        abs3D(ii).c = point(x,y,image(3))
        ii = ii + 1
    next y
next x

for x as integer = 0 to iw-1
    for y as integer = 0 to ih-1
        abs3D(ii).x = x-50
        abs3D(ii).z = y-50
        abs3D(ii).y = -50
        abs3D(ii).c = point(x,y,image(4))
        ii = ii + 1
    next y
next x

for x as integer = 0 to iw-1
    for y as integer = 0 to ih-1
        abs3D(ii).x = x-50
        abs3D(ii).z = y-50
        abs3D(ii).y = 50
        abs3D(ii).c = point(x,y,image(5))
        ii = ii + 1
    next y
next x

'create axis points not rotated
for x as single = -200 to 200
    abs3D(ii).x = x
    abs3D(ii).y = 0
    abs3D(ii).z = 0
    abs3D(ii).c = rgb(255,0,0)
    ii = ii + 1
next x

for y as single = -200 to 200
    abs3D(ii).x = 0
    abs3D(ii).y = y
    abs3D(ii).z = 0
    abs3D(ii).c = rgb(0,255,0)
    ii = ii + 1
next y

for z as single = -200 to 200
    abs3D(ii).x = 0
    abs3D(ii).y = 0
    abs3D(ii).z = z
    abs3D(ii).c = rgb(0,0,255)
    ii = ii + 1
next z

' sub coded by dodicat
Sub QsortZ(array() As Point3D,begin As Long,Finish As Ulong)
    Dim As Long i=begin,j=finish
    Dim As Point3D x =array(((I+J)\2))
    While I <= J
        While array(I).z > X .z:I+=1:Wend
        While array(J).z < X .z:J-=1:Wend
        If I<=J Then Swap array(I),array(J): I+=1:J-=1
    Wend
    If J >begin Then QsortZ(array(),begin,J)
    If I <Finish Then QsortZ(array(),I,Finish)
End Sub

'rotate points up to TOT_DOTS and copy the result to relative list
'also copy non rotated points to relative list as well for display routine



sub rotatePoints()
    
    dim as single cosAngleX,sinAngleX,angleX
    dim as single cosAngleY,sinAngleY,angleY
    dim as single cosAngleZ,sinAngleZ,angleZ
    
    angleX    = aRotX*DtoR    
    cosAngleX = cos(angleX)
    sinAngleX = sin(angleX)
    
    angleY    = aRotY*DtoR    
    cosAngleY = cos(angleY)
    sinAngleY = sin(angleY)
    
    angleZ    = aRotZ*DtoR    
    cosAngleZ = cos(angleZ)
    sinAngleZ = sin(angleZ)
    
    '=========================================
    dim as single px,py,pz,rx,ry,rz
    for i as integer = 0 to TOT_DOTS - 1
        
 
        
        'rotate x axis
        px = abs3D(i).x
        py = abs3D(i).y
        pz = abs3D(i).z
                
        rel3D(i).x = (cosAngleX * px) - (sinAngleX * pz)
        rel3D(i).y = py
        rel3D(i).z = (sinAngleX * px) + (cosAngleX * pz)
        'rotate Y axis
        px = rel3D(i).x
        py = rel3D(i).y
        pz = rel3D(i).z        
        
        rel3D(i).x = px
        rel3D(i).y = (cosAngleY * py) - (sinAngleY * pz)
        rel3D(i).z = (sinAngleY * py) + (cosAngleY * pz)  
        'rotate Z axis
        px = rel3D(i).x
        py = rel3D(i).y
        pz = rel3D(i).z
        
        rel3D(i).x = (cosAngleZ * px) - (sinAngleZ * py)
        rel3D(i).y = (sinAngleZ * px) + (cosAngleZ * py)
        rel3D(i).z = pz
        
        rel3D(i).c = abs3D(i).c
        
    next i
    
    'sort by distance along z axis
    Qsortz(rel3D(),Lbound(rel3D),Ubound(rel3D)) '***dodisort code ***
    
end sub



sub update()
    
    screenlock
    cls
    'draw points in rel3D list
    for i as integer = 0 to TOT_DOTS-1
        circle (rel3D(i).x - (-rel3D(i).z) + posx,((rel3D(i).x + (-rel3D(i).z) ) / 2) + posy + rel3D(i).y),1,rel3D(i).c,,,,f
    next i
    
    locate 2,1
    print " Left/right arrow keys rotates pixels around red x axis"
    print " Up/down arrow keys rotates pixels around green y axis"
    print " K or Z key rotates pixels around blue z axis"
    print " Space bar resets all degrees of rotation to zero"

    screenunlock
    
end sub

update()
dim as double st
st = timer

do

    if timer - st > 0.01 then
        st = timer
        rotatePoints()
        
        if multikey(&H39) then  'space key to reset all angles of rotation to zero
            aRotX = 0
            aRotY = 0
            aRotZ = 0
            while multikey(&H39):wend
        end if
        
        'rotate around x axis
        if multikey(&H48) then
            aRotX = aRotX + 1
            if aRotX = 360 then aRotX = 0
        end if
        if multikey(&H50) then
            aRotX = aRotX - 1
            if aRotX < 0 then aRotX = 359
        end if
        
        'rotate around y axis
        if multikey(&H4B) then
            aRotY = aRotY + 1
            if aRotY = 360 then aRotY = 0
        end if
        if multikey(&H4D) then
            aRotY = aRotY - 1
            if aRotY < 0 then aRotY = 359
        end if
        
        'rotate around z axis
        if multikey(&H2C) then   'Z KEY
            aRotZ = aRotZ + 1
            if aRotZ = 360 then aRotZ = 0
        end if
        if multikey(&H2D) then   'X KEY
            aRotZ = aRotZ - 1
            if aRotZ < 0 then aRotZ = 359
        end if
        
    end if
    
    update()
    
    sleep 2
loop until multikey(&H01)

for i as integer = 0 to 5
    imagedestroy image(i)
next i
Last edited by BasicCoder2 on Mar 02, 2019 23:50, edited 3 times in total.
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Positioning a cube

Post by badidea »

The "Gimbal lock" problem (https://en.wikipedia.org/wiki/Gimbal_lock)
Rotate 90 degrees by pressing "right" key. Then try UP/DOWN and Z/X, same axis.
I think you need Quaternion (https://en.wikipedia.org/wiki/Quaternion) instead of rotation by Euler angles.

BTW: dim as double now1
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Rotating a single axis only

Post by BasicCoder2 »

@badidea,
Yes I remember the mention of a "gimbal lock" and "quaternion".
There is also treating a point as a vector ?
https://medium.com/@behreajj/3d-rotatio ... e2fed5f0a3
My problem is understanding (visualizing) the concepts and translating the mathematical notation into FreeBasic code.

Fixed the timer variable. The example was old code.
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: how to rotate around an arbitrary axis

Post by BasicCoder2 »

Still haven't been able to find a function to rotate a point around any arbitrary axis to fly the cube around like a paper plane but I am still looking. It appears it must use quaternions to avoid gimble lock.

A hobby programmer hopes there might be already written functions that do common tasks, such as the function that computes the SINE of an angle, without the user having to understand how it works only how to use it.

The cube in the example below can still only be rotated around the green axis but the other rotations only work properly when the orientation is reset by the space bar. The cube can now also be moved along any axis of the world.

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

const scrw = 1280
const scrh = 600
screenres scrw,scrh,32
color rgb(0,0,0),rgb(255,255,255):cls


const iw = 50
const ih = 50

dim shared as any ptr image(0 to 5)
for i as integer = 0 to 5
    image(i) = imagecreate(iw,ih)
    line image(i),(0,0)-(iw-1,ih-1),rgb(int(rnd(1)*256),int(rnd(1)*256),int(rnd(1)*256)),bf
    circle image(i),(iw/2,ih/2),12,rgb(int(rnd(1)*256),int(rnd(1)*256),int(rnd(1)*256)),,,,f
next i

dim shared as integer posx,posy,inv
posx = scrw\2  'position of iso display on screen
posy = scrh\2

type POINT3D
    as single x
    as single y
    as single z
    as ulong  c
end type

dim shared as single cx,cy,cz   'translation along world axis


'make eight points of a absPt
'compute max dots to display and total dots to rotate
dim shared as integer TOT_DOTS,MAX_DOTS

for x as integer = 0 to iw-1
    for y as integer = 0 to ih-1
        TOT_DOTS = TOT_DOTS + 1
    next y
next x

for x as integer = 0 to iw-1
    for y as integer = 0 to ih-1
        TOT_DOTS = TOT_DOTS + 1
    next y
next x

for x as integer = 0 to iw-1
    for y as integer = 0 to ih-1
        TOT_DOTS = TOT_DOTS + 1
    next y
next x

for x as integer = 0 to iw-1
    for y as integer = 0 to ih-1
        TOT_DOTS = TOT_DOTS + 1
    next y
next x

for x as integer = 0 to iw-1
    for y as integer = 0 to ih-1
        TOT_DOTS = TOT_DOTS + 1
    next y
next x

for x as integer = 0 to iw-1
    for y as integer = 0 to ih-1
        TOT_DOTS = TOT_DOTS + 1
    next y
next x

'create axis points of cube
for x as single = -100 to 100
    TOT_DOTS = TOT_DOTS + 1
next x

for y as single = -100 to 100
    TOT_DOTS = TOT_DOTS + 1
next y

for z as single = -100 to 100
    TOT_DOTS = TOT_DOTS + 1
next z

MAX_DOTS = TOT_DOTS

'create axis points not rotated
for x as single = -200 to 200
    MAX_DOTS = MAX_DOTS + 1
next x

for y as single = -200 to 200
    MAX_DOTS = MAX_DOTS + 1
next y

for z as single = -200 to 200
    MAX_DOTS = MAX_DOTS + 1
next z


for y as single = -190 to 190 step 3
    for x as single = -190 to 190 step 3
        MAX_DOTS = MAX_DOTS + 1
    next x
next y

'=============   THESE LOOPS COMPUTE MAX_DOTS ==============

dim shared as Point3D abs3D(0 to MAX_DOTS)  'absolute positions
dim shared as Point3D rel3D(0 to MAX_DOTS)  'relative positions after any rotation
dim shared as single angle,x,y,z,rx,ry,rz,px,py
dim shared as single aRotX,aRotY,aRotZ

'now give values to dots on each square surface
dim as integer ii
for x as integer = 0 to iw-1
    for y as integer = 0 to ih-1
        abs3D(ii).x = x-25
        abs3D(ii).y = y-25
        abs3D(ii).z = -25
        abs3D(ii).c = point(x,y,image(0))
        ii = ii + 1
    next y
next x

for x as integer = 0 to iw-1
    for y as integer = 0 to ih-1
        abs3D(ii).x = x-25
        abs3D(ii).y = y-25
        abs3D(ii).z = 25
        abs3D(ii).c = point(x,y,image(1))
        ii = ii + 1
    next y
next x

for x as integer = 0 to iw-1
    for y as integer = 0 to ih-1
        abs3D(ii).z = x-25
        abs3D(ii).y = y-25
        abs3D(ii).x = -25
        abs3D(ii).c = point(x,y,image(2))
        ii = ii + 1
    next y
next x

for x as integer = 0 to iw-1
    for y as integer = 0 to ih-1
        abs3D(ii).z = x-25
        abs3D(ii).y = y-25
        abs3D(ii).x = 25
        abs3D(ii).c = point(x,y,image(3))
        ii = ii + 1
    next y
next x

for x as integer = 0 to iw-1
    for y as integer = 0 to ih-1
        abs3D(ii).x = x-25
        abs3D(ii).z = y-25
        abs3D(ii).y = -25
        abs3D(ii).c = point(x,y,image(4))
        ii = ii + 1
    next y
next x

for x as integer = 0 to iw-1
    for y as integer = 0 to ih-1
        abs3D(ii).x = x-25
        abs3D(ii).z = y-25
        abs3D(ii).y = 25
        abs3D(ii).c = point(x,y,image(5))
        ii = ii + 1
    next y
next x

'create axis points of cube
for x as single = -100 to 100
    abs3D(ii).x = x
    abs3D(ii).y = 0
    abs3D(ii).z = 0
    abs3D(ii).c = rgb(255,0,0)
    ii = ii + 1
next x

for y as single = -100 to 100
    abs3D(ii).x = 0
    abs3D(ii).y = y
    abs3D(ii).z = 0
    abs3D(ii).c = rgb(0,255,0)
    ii = ii + 1
next y

for z as single = -100 to 100
    abs3D(ii).x = 0
    abs3D(ii).y = 0
    abs3D(ii).z = z
    abs3D(ii).c = rgb(0,0,255)
    ii = ii + 1
next z


'create world axis points
for x as single = -200 to 200
    abs3D(ii).x = x
    abs3D(ii).y = 0
    abs3D(ii).z = 0
    abs3D(ii).c = rgb(255,0,0)
    ii = ii + 1
next x

for y as single = -200 to 200
    abs3D(ii).x = 0
    abs3D(ii).y = y
    abs3D(ii).z = 0
    abs3D(ii).c = rgb(0,255,0)
    ii = ii + 1
next y

for z as single = -200 to 200
    abs3D(ii).x = 0
    abs3D(ii).y = 0
    abs3D(ii).z = z
    abs3D(ii).c = rgb(0,0,255)
    ii = ii + 1
next z


for y as single = -190 to 190 step 3
    for x as single = -190 to 190 step 3
        abs3D(ii).x = x
        abs3D(ii).y = 0
        abs3D(ii).z = y
        abs3D(ii).c = rgb(100,100,255)
        ii = ii + 1
    next x
next y

' sub coded by dodicat
Sub QsortZ(array() As Point3D,begin As Long,Finish As Ulong)
    Dim As Long i=begin,j=finish
    Dim As Point3D x =array(((I+J)\2))
    While I <= J
        While array(I).z > X .z:I+=1:Wend
        While array(J).z < X .z:J-=1:Wend
        If I<=J Then Swap array(I),array(J): I+=1:J-=1
    Wend
    If J >begin Then QsortZ(array(),begin,J)
    If I <Finish Then QsortZ(array(),I,Finish)
End Sub

'rotate points up to TOT_DOTS and copy the result to relative list
'also copy non rotated points to relative list as well for display routine



sub rotatePoints()
    
    dim as single cosAngleX,sinAngleX,angleX
    dim as single cosAngleY,sinAngleY,angleY
    dim as single cosAngleZ,sinAngleZ,angleZ
    
    angleX    = aRotX*DtoR    
    cosAngleX = cos(angleX)
    sinAngleX = sin(angleX)
    
    angleY    = aRotY*DtoR    
    cosAngleY = cos(angleY)
    sinAngleY = sin(angleY)
    
    angleZ    = aRotZ*DtoR    
    cosAngleZ = cos(angleZ)
    sinAngleZ = sin(angleZ)
    
    '=========================================
    dim as single px,py,pz,rx,ry,rz
    for i as integer = 0 to TOT_DOTS - 1

        'rotate x axis
        px = abs3D(i).x
        py = abs3D(i).y
        pz = abs3D(i).z
        
        rel3D(i).x = (cosAngleX * px) - (sinAngleX * pz)
        rel3D(i).y = py
        rel3D(i).z = (sinAngleX * px) + (cosAngleX * pz)
        
        '===============================================
        
        'rotate Y axis
        px = rel3D(i).x
        py = rel3D(i).y
        pz = rel3D(i).z  
        
        rel3D(i).x = px
        rel3D(i).y = (cosAngleY * py) - (sinAngleY * pz)
        rel3D(i).z = (sinAngleY * py) + (cosAngleY * pz)
        
        '===============================================
        
        'rotate Z axis
        px = rel3D(i).x
        py = rel3D(i).y
        pz = rel3D(i).z
        
        rel3D(i).x = (cosAngleZ * px) - (sinAngleZ * py)
        rel3D(i).y = (sinAngleZ * px) + (cosAngleZ * py)
        rel3D(i).z = pz
        
        
        '===============================================
        
        rel3D(i).x = rel3D(i).x + cx
        rel3D(i).y = rel3D(i).y + cy
        rel3D(i).z = rel3D(i).z + cz
        
        
        rel3D(i).c = abs3D(i).c
        
    next i
    
    for i as integer = TOT_DOTS to MAX_DOTS-1  'non rotated dots
        rel3D(i).x = abs3D(i).x
        rel3D(i).y = abs3D(i).y
        rel3D(i).z = abs3D(i).z
        rel3D(i).c = abs3D(i).c
    next i
    
    
    'sort by distance along z axis
    Qsortz(rel3D(),Lbound(rel3D),Ubound(rel3D)) '***dodisort code ***
    
end sub



sub update()
    
    screenlock
    cls

    'draw points in rel3D list
    for i as integer = 0 to MAX_DOTS-1
        circle (rel3D(i).x - (-rel3D(i).z) + posx,((rel3D(i).x + (-rel3D(i).z) ) / 2) + posy + rel3D(i).y),1,rel3D(i).c,,,,f
    next i
    
    locate 2,1
    print " HIT SPACE BAR TO RESET AXIS ORIENTATION"
    print " Up/down arrow keys rotates pixels around green y axis"
    print " The other rotation keys only work from the reset position"
    print " Left/right arrow keys rotates pixels around red x axis"
    print " K or Z key rotates pixels around blue z axis"
    print
    print " A or D key move along blue axis"
    print " W or S key move along red axis"
    print " U or P key move along green axis"

    screenunlock
    
end sub

update()
dim as single now1
now1 = timer

do

    if timer - now1 > 0.01 then
        now1 = timer
        rotatePoints()
        
        if multikey(&H39) then  'space key to reset all angles of rotation to zero
            aRotX = 0
            aRotY = 0
            aRotZ = 0
            while multikey(&H39):wend
        end if
        
        'rotate around x axis
        if multikey(&H48) then
            aRotX = aRotX + 1
            if aRotX = 360 then aRotX = 0
        end if
        if multikey(&H50) then
            aRotX = aRotX - 1
            if aRotX < 0 then aRotX = 359
        end if
        
        'rotate around y axis
        if multikey(&H4B) then
            aRotY = aRotY + 1
            if aRotY = 360 then aRotY = 0
        end if
        if multikey(&H4D) then
            aRotY = aRotY - 1
            if aRotY < 0 then aRotY = 359
        end if
        
        'rotate around z axis
        if multikey(&H2C) then   'Z KEY
            aRotZ = aRotZ + 1
            if aRotZ = 360 then aRotZ = 0
        end if
        if multikey(&H2D) then   'X KEY
            aRotZ = aRotZ - 1
            if aRotZ < 0 then aRotZ = 359
        end if
        
        if multikey(&H11) then  'W KEY
            cx = cx - 1
        end if
        
        if multikey(&H1F) then  'S KEY
            cx = cx + 1
        end if
        
        if multikey(&H1E) then  'A KEY
            cz = cz - 1
        end if
        
        if multikey(&H20) then  'D KEY
            cz = cz + 1
        end if
        
        if multikey(&H16) then  'U KEY
            cy = cy - 1
        end if
        
        if multikey(&H19) then  'P KEY
            cy = cy + 1
        end if
        
        
    end if
    
    update()
    
    sleep 2
loop until multikey(&H01)

for i as integer = 0 to 5
    imagedestroy image(i)
next i
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: how to rotate around an arbitrary axis

Post by dodicat »

I think maybe quaternions are a bit heavy going for this.
Here I use the Rodrigues rotator which rotates about an axis in space.
The axis must be a normalised direction (vector).
I use the three x,y,z axis set at the origin, but to draw a figure I must translate and blow up each of axis as they rotate.

Code: Select all

#include "fbgfx.bi"
Using fb  'for multikey

Dim Shared As Integer w,h
Screen 19,32

Screeninfo w,h
Const pi=4*Atn(1)


Type AxialAngle
    As Single Sin,Cos
End Type

Type v3
    As Single x,y,z
    As Ulong colour
End Type

Function normalize(v As V3) As V3
    Dim As Single L= Sqr(v.x*v.x+v.y*v.y+v.z*v.z)
    Return Type(v.x/L,v.y/L,v.z/L)
End Function

Function AxialRotate(centre As v3,Pt As V3,Angle As AxialAngle,norm As v3,T As Single=1) Byref  As v3
    #define crossP(v1,v2,N) Type<v3>( N*(v1.y*v2.z-v2.y*v1.z),N*(-(v1.x*v2.z-v2.x*v1.z)),N*(v1.x*v2.y-v2.x*v1.y))
    #define plus(v1,v2) Type<v3>(v1.x+v2.x,v1.y+v2.y,v1.z+v2.z)
    #define dotP(v1,v2) (v1.x*v2.x + v1.y*v2.y + v1.z*v2.z)
    #define mlt(f,v1) Type<v3>(f*v1.x,f*v1.y,f*v1.z) 
    Static As v3 result
    Dim As V3 V=Type(T*(Pt.x-centre.x),T*(Pt.y-centre.y),T*(Pt.z-centre.z))
    Dim As V3 T1=crossP(norm,V,Angle.sin)
    Dim As Single tmpS=dotP(Norm,V)
    Dim As V3 tmpV=mlt(tmpS,norm)
    tmpV=mlt((1-Angle.cos),tmpV)
    T1=plus(T1,tmpV)
    Dim As V3 tt=mlt(Angle.cos,V) 
    result=plus(tt,T1)
    result=plus(result,centre)
    result.colour=Pt.colour
    Return result
End Function

Function perspective(p As V3,eyepoint As V3) As V3
    Dim As Single   w=1+(p.z/eyepoint.z)
    Return Type((p.x-eyepoint.x)/w+eyepoint.x,_
    (p.y-eyepoint.y)/w+eyepoint.y,_
    (p.z-eyepoint.z)/w+eyepoint.z, _
    p.colour)
End Function

Sub QsortZ(array() As V3,begin As Long,Finish As Long)
    Dim As Long i=begin,j=finish
    Dim As V3 x =array(((I+J)\2))
    While I <= J
        While array(I).z > X .z:I+=1:Wend
            While array(J).z < X .z:J-=1:Wend
                If I<=J Then Swap array(I),array(J): I+=1:J-=1
            Wend
            If J >begin Then QsortZ(array(),begin,J)
            If I <Finish Then QsortZ(array(),I,Finish)
        End Sub
        
        Function setAxialangle(angle As Single) As AxialAngle
            Return Type(Sin(angle),Cos(angle))
        End Function
        
        Function keys(a As v3) As Integer
            Dim As Single jmp=.01
            a=Type(0,0,0)
            If Multikey(SC_LEFT)  Then a.y+=jmp:Return 1
            If Multikey(SC_RIGHT) Then a.y-=jmp:Return 1
            
            If Multikey(SC_UP   ) Then a.x+=jmp:Return 2
            If Multikey(SC_DOWN ) Then a.x-=jmp:Return 2
            
            If Multikey(SC_Q)     Then a.z+=jmp:Return 3
            If Multikey(SC_W)     Then a.z-=jmp:Return 3
        End Function
        
        Function translate(v As v3,sz As Long,np As v3) As v3
            Return Type(sz*v.x+np.x,sz*v.y+np.y,sz*v.z+np.z)
        End Function
        
        Function shortline(fp As v3,p As v3,length As Long) As v3 'to extend either side of the screen centre.
            Dim As Long diffx=p.x-fp.x,diffy=p.y-fp.y,diffz=p.z-fp.z
            Dim As Single L=Sqr(diffx*diffx+diffy*diffy+diffz*diffz)
            Return Type(fp.x+length*diffx/L,fp.y+length*diffy/L,fp.z+length*diffz/L)
        End Function
        
        Sub drawaxis(x As v3,y As v3,z As v3)
            #define map(a,b,x,c,d)  ((d)-(c))*((x)-(a))/((b)-(a))+(c)
            Dim As v3 centre=(w/2,h/2,0),eye=Type(w/2,h/2,700)
            Dim As Long l=200
            Var cx=translate(x,l,centre),c2x=shortline(cx,centre,l*2) 'cx --- c2x = cx to centre then centre to c2x
            Var cy=translate(y,l,centre),c2y=shortline(cy,centre,l*2)
            Var cz=translate(z,l,centre),c2z=shortline(cz,centre,l*2)
            cx=perspective(cx,eye):c2x=perspective(c2x,eye)
            cy=perspective(cy,eye):c2y=perspective(c2y,eye)
            cz=perspective(cz,eye):c2z=perspective(c2z,eye)
            Line(cx.x,cx.y)-(c2x.x,c2x.y),Rgb(200,0,0)
            Line(cy.x,cy.y)-(c2y.x,c2y.y),Rgb(0,200,0)
            Line(cz.x,cz.y)-(c2z.x,c2z.y),Rgb(0,0,200)
            
            Dim As v3 t(1 To 6)={cx,c2x,cy,c2y,cz,c2z} 'for circles
            t(1).colour=Rgb(200,0,0):t(2).colour=t(1).colour
            t(3).colour=Rgb(0,200,0):t(4).colour=t(3).colour
            t(5).colour=Rgb(0,0,200):t(6).colour=t(5).colour
            
            qsortz(t(),1,6)
            
            Circle(t(1).x,t(1).y),map(300,-300,t(1).z,5,10),t(1).colour,,,,f
            Circle(t(2).x,t(2).y),map(300,-300,t(2).z,5,10),t(2).colour,,,,f
            
            Circle(t(3).x,t(3).y),map(300,-300,t(3).z,5,10),t(3).colour,,,,f
            Circle(t(4).x,t(4).y),map(300,-300,t(4).z,5,10),t(4).colour,,,,f
            
            Circle(t(5).x,t(5).y),map(300,-300,t(5).z,5,10),t(5).colour,,,,f
            Circle(t(6).x,t(6).y),map(300,-300,t(6).z,5,10),t(6).colour,,,,f  
            
        End Sub
        
        Dim As v3 xaxis,yaxis,zaxis,rx,ry,rz
        xaxis=Type(1,0,0)
        yaxis=Type(0,1,0)
        zaxis=Type(0,0,1)
       
        Dim As axialangle ax,ay,az
        Dim As v3 centre,a
        Dim As Long k
        Do
           
            k=keys(a)
            
            Select Case k
            Case 1
                If a.y>=2*pi Then a.y=0
                ay=setaxialangle(a.y)
                rx=AxialRotate(centre,xaxis,ay,yaxis)
                rz=AxialRotate(centre,zaxis,ay,yaxis)
                xaxis=rx
                zaxis=rz
            Case 2
                If a.x>=2*pi Then a.x=0
                ax=setaxialangle(a.x)
                ry=AxialRotate(centre,yaxis,ax,xaxis)
                rz=AxialRotate(centre,zaxis,ax,xaxis)
                yaxis=ry
                zaxis=rz
            Case 3
                If a.z>=2*pi Then a.z=0
                az=setaxialangle(a.z)
                rx=AxialRotate(centre,xaxis,az,zaxis)
                ry=AxialRotate(centre,yaxis,az,zaxis)
                xaxis=rx
                yaxis=ry
            End Select
            
            xaxis=normalize(xaxis) 'incase of creep
            yaxis=normalize(yaxis)
            zaxis=normalize(zaxis)
            
            screenlock
            cls
            draw string(20,20),  "Keys q and w to rotate around the Z   (blue) axis"
            draw string(20,40),  "Keys right/left to rotate round the Y (green) axis"
             draw string(20,60),"Keys up/down to rotate round the X     (red) axis"
            drawaxis(xaxis,yaxis,zaxis)
            
            Screenunlock
            Sleep 1,1
        Loop Until Inkey=Chr(27)
        Sleep
        
          
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: how to rotate around an arbitrary axis

Post by BasicCoder2 »

@dodicat,

Another demo to add to the dodicat folder :)

Your code is of course beyond me to read. It is easy to translate a fully understood algorithm to code but not so easy for me to work out the algorithm from its coding particularly the higher level compact coding you use.

When I observed in my version that it always rotated around the green axis I played around with using three rotation sections as you seem to be doing with the Select Case k block but couldn't get it working properly. It would rotate around the chosen axis but only after flicking to a different orientation.

So are we going to get a textured cube version?
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: how to rotate around an arbitrary axis

Post by badidea »

This website (http://paulbourke.net/geometry/rotate/) shows two ways to do it:
1) Rotation by first aligning the other 2 axis, rotate around desired axis, reverse rotation of the previous 2 (also translation, but not applicable for your caseprobably)
2) Using quaternions
There is also some C and python code linked. And more interesting stuff on that website.
Post Reply