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