3d rotations: X and Y rotations are glitchy, please help =)

[teenserve]

Allright, here's the full code.

X + Y rotations seem so almost work, although they just seem to shrink and stretch (instead of a real rotation), and most angles on X or Y rotations make the wireframe look too small

It's something to do with the perspective, I believe, but I cannot figure it out.. calling all QB coders or trig experts or BASIC 3d programmers to please give a hand =)

A Z-axis rotation works fine...

I put comments throughout the code explaining stuff.
Sorry if my code is hard to understand =(



DECLARE SUB Draw3D (WF() AS ANY, R!, XR!, YR!)
DECLARE SUB Draw3DE (WF() AS ANY, R!, XR!, YR!)
'Perspective Functions
DECLARE FUNCTION X2D (X, Z) 'Convert X,Z to X (used only by Draw3D + Draw3DE)
DECLARE FUNCTION Y2D (Y, Z) 'Convert Y,Z to Y (used only by Draw3D + Draw3DE)

'Drawing Subroutines
DECLARE SUB Draw3D (WF() AS ANY, R, XR, YR) 'Draws a wireframe
'Uses functions to rotate each point in the Wireframe

DECLARE SUB Draw3DE (WF() AS ANY, R, XR, YR) 'Erases wireframe, shows stats
'Uses functions to rotate each point in the Wireframe

'Performs rotations by reference of variables
DECLARE SUB RX (Y, Z, R) 'Rotates about X axis (not working), used by Draw3D
DECLARE SUB RZ (Y, X, R) 'Rotates about Y axis (not working), used by Draw3D
DECLARE SUB RY (X, Z, R) 'Rotates about Z axis (working), used by Draw3D

TYPE Wireframe
X AS INTEGER '3D X Coordinant
Y AS INTEGER '3D Y Coordinant
Z AS INTEGER '3D Z Coordinant

'A,B,C can be used to link to points(another subscript in the
'array)

A AS INTEGER
B AS INTEGER
C AS INTEGER
END TYPE


SCREEN 12
CLS
PRINT "Which rotation to perform? (X/Y/Z)";

DO
K$ = UCASE$(INKEY$)
LOOP UNTIL K$ = "X" OR K$ = "Y" OR K$ = "Z"

'Sets the option to 1, because the angle is multiplied by 1 or 0 to tell
'Draw3D the rotation.

IF K$ = "X" THEN XXR = 1
IF K$ = "Y" THEN YYR = 1
IF K$ = "Z" THEN ZZR = 1





DIM SHARED HSRX, HSRY
HSRX = 320
HSRY = 240
'Used for perceptective... I don't think this would cause the rotation
'problem.


DIM Cube(8) AS Wireframe

'This is our wireframe
Cube(1).X = 100
Cube(1).Y = 100
Cube(1).Z = 1
Cube(1).A = 2
Cube(1).B = 5
Cube(2).X = 200
Cube(2).Y = 100
Cube(2).Z = 1
Cube(2).A = 4
Cube(2).B = 6
Cube(3).X = 100
Cube(3).Y = 200
Cube(3).Z = 1
Cube(3).A = 1
Cube(3).B = 7
Cube(4).X = 200
Cube(4).Y = 200
Cube(4).Z = 1
Cube(4).A = 3
Cube(4).B = 8
Cube(5).X = 150
Cube(5).Y = 150
Cube(5).Z = 2
Cube(5).A = 6
Cube(6).X = 250
Cube(6).Y = 150
Cube(6).Z = 2
Cube(6).A = 8
Cube(7).X = 150
Cube(7).Y = 250
Cube(7).Z = 2
Cube(7).A = 5
Cube(7).B = 8
Cube(8).X = 250
Cube(8).Y = 250
Cube(8).Z = 2
Cube(8).A = 8


'Call Drawing subs and rotate from 1* to 360*

FOR X = 1 TO 360 STEP 1
Draw3D Cube(), ZZR * X, XXR * X, YYR * X
IF X < 360 THEN Draw3DE Cube(), ZZR * X, XXR * X, YYR * X
NEXT X









SUB Draw3D (WF() AS Wireframe, R, XR, YR)

FOR PNT = 1 TO 8
XX = WF(PNT).X
YY = WF(PNT).Y
ZZ = WF(PNT).Z
'Get points into 3 variables

'Check for rotation parameters
'and rotate points
IF R > 0 THEN CALL RZ(YY, XX, R)
IF XR > 0 THEN CALL RX(YY, ZZ, XR)
IF YR > 0 THEN CALL RY(XX, ZZ, YR)

'Get the X and Y from x,y,z
X = X2D(XX, ZZ)
Y = Y2D(YY, ZZ)

'Place a color-coded circle on the point

CIRCLE (X, Y), 3, PNT

'Check for links, rotate them if needed, get X & Y, then draw a line.
IF WF(PNT).A > 0 THEN
A = WF(PNT).A
AX = WF(A).X
AY = WF(A).Y
AZ = WF(A).Z
IF R > 0 THEN CALL RZ(AY, AX, R)
IF XR > 0 THEN CALL RX(AY, AZ, XR)
IF YR > 0 THEN CALL RY(AX, AZ, YR)

xa = X2D(AX, AZ)
ya = Y2D(AY, AZ)
LINE (X, Y)-(xa, ya), 4
END IF
IF WF(PNT).B > 0 THEN
A = WF(PNT).B
AX = WF(A).X
AY = WF(A).Y
AZ = WF(A).Z
IF R > 0 THEN CALL RZ(AY, AX, R)
IF XR > 0 THEN CALL RX(AY, AZ, XR)
IF YR > 0 THEN CALL RY(AX, AZ, YR)


xa = X2D(AX, AZ)
ya = Y2D(AY, AZ)
LINE (X, Y)-(xa, ya), 4
END IF
IF WF(PNT).C > 0 THEN
A = WF(PNT).C
AX = WF(A).X
AY = WF(A).Y
AZ = WF(A).Z
IF R > 0 THEN CALL RZ(AY, AX, R)
IF XR > 0 THEN CALL RX(AY, AZ, XR)
IF YR > 0 THEN CALL RY(AX, AZ, YR)


xa = X2D(AX, AZ)
ya = Y2D(AY, AZ)
LINE (X, Y)-(xa, ya), 4
END IF
NEXT
END SUB

SUB Draw3DE (WF() AS Wireframe, R, XR, YR)
LOCATE 1, 1
COLOR 15
PRINT &quot;Z Rotation:&quot;; R; &quot;X Rotation:&quot;; XR; &quot;Y Rotation:&quot;; YR
FOR PNT = 1 TO 8
XX = WF(PNT).X
YY = WF(PNT).Y
ZZ = WF(PNT).Z
IF R > 0 THEN CALL RZ(YY, XX, R)
IF XR > 0 THEN CALL RX(YY, ZZ, XR)
IF YR > 0 THEN CALL RY(XX, ZZ, YR)
COLOR PNT
PRINT &quot;(&quot;; LTRIM$(RTRIM$(STR$(PNT))); &quotX:&quot;; XX; &quot;Y:&quot;; YY; &quot;Z:&quot;; ZZ;

X = X2D(XX, ZZ)
Y = Y2D(YY, ZZ)

PRINT &quot;NX:&quot;; X; &quot;NY:&quot;; Y

CIRCLE (X, Y), 3, 0
IF WF(PNT).A > 0 THEN
A = WF(PNT).A
AX = WF(A).X
AY = WF(A).Y
AZ = WF(A).Z
IF R > 0 THEN CALL RZ(AY, AX, R)
IF XR > 0 THEN CALL RX(AY, AZ, XR)
IF YR > 0 THEN CALL RY(AX, AZ, YR)



xa = X2D(AX, AZ)
ya = Y2D(AY, AZ)
LINE (X, Y)-(xa, ya), 0
END IF
IF WF(PNT).B > 0 THEN
A = WF(PNT).B
AX = WF(A).X
AY = WF(A).Y
AZ = WF(A).Z
IF R > 0 THEN CALL RZ(AY, AX, R)
IF XR > 0 THEN CALL RX(AY, AZ, XR)
IF YR > 0 THEN CALL RY(AX, AZ, YR)



xa = X2D(AX, AZ)
ya = Y2D(AY, AZ)
LINE (X, Y)-(xa, ya), 0
END IF
IF WF(PNT).C > 0 THEN
A = WF(PNT).C
AX = WF(A).X
AY = WF(A).Y
AZ = WF(A).Z
IF R > 0 THEN CALL RZ(AY, AX, R)
IF XR > 0 THEN CALL RX(AY, AZ, XR)
IF YR > 0 THEN CALL RY(AX, AZ, YR)




xa = X2D(AX, AZ)
ya = Y2D(AY, AZ)
LINE (X, Y)-(xa, ya), 0
END IF
NEXT

END SUB

SUB RX (Y, Z, R)
Rad = R * (3.14 / 180) 'Converts degrees to radians
YY = (Y * COS(Rad)) - (Z * SIN(Rad)) 'Performs y rotation
ZZ = (Y * SIN(Rad)) - (Z * COS(Rad)) 'Performs z rotation
Y = YY 'changes Y,Z
Z = ZZ
END SUB

SUB RY (X, Z, R)
Rad = R * (3.14 / 180)
XX = (Z * SIN(Rad)) + (X * COS(Rad))
ZZ = (Z * COS(Rad)) - (X * SIN(Rad))
X = XX
Z = ZZ

END SUB

SUB RZ (Y, X, R)
Rad = R * (3.14 / 180)
XX = (X * COS(Rad)) - (Y * SIN(Rad))
YY = (X * SIN(Rad)) + (Y * COS(Rad))
X = XX
Y = YY
END SUB

FUNCTION X2D (X, Z)
X2D = X / Z + HSRX
END FUNCTION

FUNCTION Y2D (Y, Z)
Y2D = Y / Z + HSRY
END FUNCTION

 

[tsh73]

I took that program; tried to fix problem posted. Notice: actually all 3 rotation should be similar (if not the same). But I think it's perspective that breaks that.
People here said &quot;It's smth in a math&quot; but no one got interested enough to look closer.
Anyway, I did'n quite get what projection you used... so I took your program, your data structures and fiddled with it for a week (or more?)
Anyway, here's what I got.

DECLARE FUNCTION ask! (b$)
DECLARE FUNCTION iif$ (cond!, yes$, no$)
DECLARE SUB ClearDraw (WF() AS ANY)
DECLARE SUB fillCube (WF() AS ANY)
'Performs rotations by reference of variables
DECLARE SUB Rot (y!, x!, R!)
DECLARE SUB Draw3D (WF() AS ANY, ZR!, XR!, YR!)
'3d->2d conversion
DECLARE FUNCTION X2D (x, y, z)
DECLARE FUNCTION Y2D (x, y, z)

TYPE Wireframe
		  x AS INTEGER '3D X Coordinant
		  y AS INTEGER '3D Y Coordinant
		  z AS INTEGER '3D Z Coordinant

		  'A,B,C can be used to link to points(another subscript in the
		  'array)

		  a AS INTEGER
		  b AS INTEGER
		  c AS INTEGER
END TYPE


'boolean consts
COMMON SHARED True, False

'some consts
DIM SHARED grad2rad, sqr3half, sqr2half
grad2rad = 3.1415915# / 180
sqr3half = SQR(3) / 2
sqr2half = SQR(2) / 2
False = 0: True = NOT False

'boolean controls
DIM SHARED usePerspective, isDimetry, isIzometry
'by def, isDimetry = NOT isIzometry

'internals, speed up: calculated 2d (screen) pts
DIM X2(8), Y2(8)

DIM Cube(8) AS Wireframe

fillCube Cube()

SCREEN 12
'let Basic do as much scaling as it could... Well, it could be slower

'--- Show all variety ---

FOR i = -1 TO 0   'for isIzometry
	x = 430 + 210 * i
	FOR p = -1 TO 0   'for projection
		y = 220 + 210 * p
		colr = 1 + (i + 1) + 2 * (p + 1)
		VIEW (x, y)-(x + 200, y + 200), , colr
		WINDOW (-200, -200)-(200, 200)
		isIzometry = i
		isDimetry = NOT isIzometry
		COLOR colr
		PRINT "Projection used: ";
		PRINT iif$(isDimetry, "Dimetry", "Izometry")
		usePerspective = p
		PRINT "Perspective used: ";
		PRINT iif$(usePerspective, "Yes", "No")

		Draw3D Cube(), 0, 0, 0

	NEXT
NEXT

a$ = INPUT$(1) 'pause till key pressed

'--- Now let user choose, then show rotation ---

COLOR 7
CLS 0
VIEW (230, 10)-(630, 410), , 1
WINDOW (-200, -200)-(200, 200)

usePerspective = False
PRINT "Press a key for Projection: "
PRINT "Izometry (ENTER) or Dimetry"
isIzometry = ask(CHR$(13))
isDimetry = NOT isIzometry

PRINT "Projection selected: ";
PRINT iif$(isDimetry, "Dimetry", "Izometry")

PRINT "Press a key for Perspective: "
PRINT "Use (ENTER) or Do Not Use"
usePerspective = ask(CHR$(13))

PRINT "Perspective selected: ";
PRINT iif$(usePerspective, "Yes", "No")

Draw3D Cube(), 0, 0, 0

PRINT "Which rotation ?"
PRINT "(X/Y/Z)"

DO
	k$ = UCASE$(INKEY$)
LOOP UNTIL k$ = "X" OR k$ = "Y" OR k$ = "Z"
PRINT "Rotation Selected: "; k$

'Sets the option to 1, because the angle is multiplied by 1 or 0 to tell
'Draw3D the rotation.

IF k$ = "X" THEN XXR = 1
IF k$ = "Y" THEN YYR = 1
IF k$ = "Z" THEN ZZR = 1


'Call Drawing subs and rotate from 1* to 360*

'clear old one first
ClearDraw Cube()

FOR x = 1 TO 360
	Draw3D Cube(), ZZR * x, XXR * x, YYR * x

	'have lotsa time - wait refresh?
	'Now it's commented out: for cube size ~100 it don't fast enough
	'You can try if you machine is faster
	'WAIT &H3DA, 8
	'WAIT &H3DA, 8, 8

	IF x < 360 THEN
		ClearDraw Cube()
	END IF
NEXT x

FUNCTION ask (b$)
	a$ = INPUT$(1)
	ask = (INSTR(b$, a$) > 0)
END FUNCTION

SUB ClearDraw (WF() AS Wireframe)
'clears pre-count points
SHARED X2(), Y2()
		  
'second part only: clear
FOR PNT = 1 TO 8
	CIRCLE (X2(PNT), Y2(PNT)), 3, 0
	'Check for links, rotate them if needed, get X & Y, then draw a line.
	PNT2 = WF(PNT).a
	IF PNT2 > 0 THEN LINE (X2(PNT), Y2(PNT))-(X2(PNT2), Y2(PNT2)), 0
	PNT2 = WF(PNT).b
	IF PNT2 > 0 THEN LINE (X2(PNT), Y2(PNT))-(X2(PNT2), Y2(PNT2)), 0
	PNT2 = WF(PNT).c
	IF PNT2 > 0 THEN LINE (X2(PNT), Y2(PNT))-(X2(PNT2), Y2(PNT2)), 0
NEXT

END SUB

SUB Draw3D (WF() AS Wireframe, RZ, XR, YR)
'I suggest first rotate all points that connect it (have to save in array)
'I think it speeds things up 'cause some points rotate several times
'Or at least it would be easier to write/understand

SHARED X2(), Y2()
'first part rotates
FOR PNT = 1 TO 8
	'Get points into 3 variables
	XX = WF(PNT).x
	YY = WF(PNT).y
	ZZ = WF(PNT).z
  
	'Check for rotation parameters
	'and rotate points
	IF RZ > 0 THEN Rot YY, XX, RZ
	IF XR > 0 THEN Rot YY, ZZ, XR
	IF YR > 0 THEN Rot XX, ZZ, YR

	'Get the X and Y from x,y,z
	x = X2D(XX, YY, ZZ)
	y = Y2D(XX, YY, ZZ)
	'save in array
	X2(PNT) = x
	Y2(PNT) = y

	'Place a color-coded circle on the point
	CIRCLE (x, y), 3, PNT
NEXT

'second part draw lines, uses rotated points
FOR PNT = 1 TO 8
	'Check for links, rotate them if needed, get X & Y, then draw a line.
	PNT2 = WF(PNT).a
	IF PNT2 > 0 THEN LINE (X2(PNT), Y2(PNT))-(X2(PNT2), Y2(PNT2)), 4
	PNT2 = WF(PNT).b
	IF PNT2 > 0 THEN LINE (X2(PNT), Y2(PNT))-(X2(PNT2), Y2(PNT2)), 4
	PNT2 = WF(PNT).c
	IF PNT2 > 0 THEN LINE (X2(PNT), Y2(PNT))-(X2(PNT2), Y2(PNT2)), 4
NEXT

END SUB

SUB fillCube (WF() AS Wireframe)
'fills coords. All things in range -100..100
'now fill ajacents
FOR pt1 = 0 TO 7
	i = pt1 MOD 2: j = (pt1 \ 2) MOD 2: k = (pt1 \ 4) MOD 2
	x = 100 * i - 50
	y = 100 * j - 50
	z = 100 * k - 50
	n = pt1 + 1
	WF(n).x = x
	WF(n).y = y
	WF(n).z = z
	'PRINT pt1, i, j, k
	cnt = 0
	FOR pt2 = 0 TO 7
	IF pt1 <> pt2 THEN
		i2 = pt2 MOD 2: j2 = (pt2 \ 2) MOD 2: k2 = (pt2 \ 4) MOD 2
		cond = ABS(i - i2) + ABS(j - j2) + ABS(k - k2)
		IF cond = 1 THEN
			cnt = cnt + 1
'         PRINT pt1, pt2
			SELECT CASE cnt
			CASE 1: WF(n).a = pt2 + 1
			CASE 2: WF(n).b = pt2 + 1
			CASE 3: WF(n).c = pt2 + 1
			END SELECT
		END IF
	END IF
	NEXT
NEXT
END SUB

FUNCTION iif$ (cond, yes$, no$)
	IF cond THEN
		iif$ = yes$
	ELSE
		iif$ = no$
	END IF
END FUNCTION

SUB Rot (y, x, R)
'that's essentially copy of RZ sub (working one)
'rotates into XY plane by R degrees
	rad = R * grad2rad
	c = COS(rad): s = SIN(rad)
	XX = x * c - y * s
	YY = x * s + y * c
	x = XX
	y = YY
END SUB

FUNCTION X2D (x, y, z)
	factor = 1
	IF isDimetry THEN
		IF usePerspective THEN factor = (1 - z * sqr2half / 600)
		X2D = (x - z * sqr2half) / factor
	ELSE  'izometry
		IF usePerspective THEN factor = (1 - (z + x) / 600)
		X2D = ((x - z) * sqr3half) / factor
	END IF
END FUNCTION

FUNCTION Y2D (x, y, z)
	factor = 1
	IF isDimetry THEN
		IF usePerspective THEN factor = (1 - z * sqr2half / 600)
		Y2D = (y - z * sqr2half) / factor
	ELSE  'izometry
		IF usePerspective THEN factor = (1 - (z + x) / 600)
		Y2D = (y - (x + z) / 2) / factor
	END IF
END FUNCTION

Hope this could help.

 

[CubeE101]

Here are the Subs I created and use for 3D...

You can use anything from this that you want...

I ripped them out of my Ghost Cube Program, so if I left any thing out let me know ;-)
I just started Re-Optimizing it, so if you don't understand something just ask...

*Note: I originally wrote this code about 4 or 5 years ago, so it might take me a minute to remember WHY i did certain things in these subs, but the method works pretty good...

TYPE PTYPE
  X AS SINGLE     'X coord
  Y AS SINGLE     'Y coord
  Z AS SINGLE     'Z coord
  XX AS INTEGER
  YY AS INTEGER
  DRW AS INTEGER
END TYPE

TYPE XYTYPE
  A AS INTEGER 'Point A
  b AS INTEGER 'Point B
END TYPE

TYPE CTYPE
  r AS PTYPE    'Rotation
  O AS PTYPE    'Offset
  NC AS INTEGER 'Num lines
  NP AS INTEGER 'Num Points
END TYPE

DIM SHARED OBJ3D AS CTYPE, SINT(360) AS SINGLE, COST(360)  AS SINGLE

'.... Setup stuff ....

REDIM SHARED OBJ3DP(OBJ3D.NP) AS PTYPE
REDIM SHARED OBJ3DC(OBJ3D.NC) AS XYTYPE

FOR N = 0 TO 360
  SINT(N) = SIN(RAD(N))
  COST(N) = COS(RAD(N))
NEXT

SUB ROTATE (P() AS PTYPE, C AS CTYPE)
  FOR N% = 1 TO C.NP
    ROTX P(N%).X, P(N%).Y, P(N%).Z, C.r.X
    ROTY P(N%).X, P(N%).Y, P(N%).Z, C.r.Y
    ROTZ P(N%).X, P(N%).Y, P(N%).Z, C.r.Z
    'Translate the 3D points to 2D coords in perspective
    P(N%).XX = INT((128 * P(N%).X) / (C.O.Z - P(N%).Z)) + C.O.X
    P(N%).YY = INT((128 * P(N%).Y) / (C.O.Z - P(N%).Z)) + C.O.Y
  NEXT
  C.r.X = 0
  C.r.Y = 0
  C.r.Z = 0
END SUB

SUB ROTX (X, Y, Z, D)
  DCS D, CA, SA
  T = Y * CA - Z * SA
  Z = Z * CA + Y * SA
  Y = T
END SUB

SUB ROTY (X, Y, Z, D)
  DCS D, CA, SA
  T = X * CA + Z * SA
  Z = Z * CA - X * SA
  X = T
END SUB

SUB ROTZ (X, Y, Z, D)
  DCS D, CA, SA
  T = X * CA - Y * SA
  Y = Y * CA + X * SA
  X = T
END SUB

SUB DCS (D, CA, SA) 'Degree, Cosine, Sine
  ANG = INT(D MOD 360)
  IF ANG < 0 THEN ANG = ANG + 360
  CA = COST(ANG)
  SA = SINT(ANG)
END SUB

SUB DRAWOBJ (P() AS PTYPE, C AS CTYPE, L() AS XYTYPE, CLR)
  FOR N = 1 TO C.NC
    A1 = P(L(N).A).XX
    B1 = P(L(N).A).YY
    A2 = P(L(N).b).XX
    B2 = P(L(N).b).YY
    LINE(A1, B1)-(A2, B2), CLR
  NEXT
END SUB

Have Fun, Be Young... Code BASIC
-Josh

http://cubee.topcities.com

PROGRAMMER: Red-eyed, mumbling mammal capable of conversing with inanimate objects.

 

[instinct]

Here is my personal rotational code that rotates around all 3 axies. I just created this now so it is not my best code and I have not tested this to see if it works

dim pts as integer
pts = 4
dim c(360),s(360)
dim x(pts),y(pts),z(pts)
dim x2(pts),y2(pts),z2(pts)
dim x3&(pts),y3&(pts)

'cos and sin values stored for quick access
for i = 0 to 360
c(i) = cos(i * 3.14 / 180)
s(i) = sin(i * 3.14 / 180)
next

'starting angles to which the object rotates
t = 360
p = 360
d = 360

'screen starting values
xc = 160
yc = 100
zc = 50

'add your own coordinates here
x(1)= 10
x(2)= 10
x(3)= -10
x(4)= -10
y(1)= 10
y(2)= -10
y(3)= 10
y(4)= -10
z(1)= 0
z(2)= 0
z(3)= 0
z(4)= 0

screen 7,0,1,0

DO
PRESS$=INKEY$

a = c(p) * c(d)
b = c(p) * s(d)
c = (s(p) * s(t) * c(d) - c(t) * s(d))
de = (s(p) * s(t) * s(d) + c(t) * c(d))
e = c(p) * s(t)
f = (s(p) * c(t) * c(d) + s(t) * s(d))
g = (s(p) * c(t) * s(d) - s(d) * c(d))
h = c(p) * c(t)

cls
FOR i = 1 TO pts
x2(i) = x(i) * a + y(i) * b - z(i) * s(p)
y2(i) = x(i) * c + y(i) * de + z(i) * e
z2(i) = x(i) * f + y(i) * g + z(i) * h

x3&(i) = 256 * (x2(i) / (z2(i) + zc)) + xc
y3&(i) = 256 * (y2(i) / (z2(i) + zc)) + yc
PSET (x3&(i), y3&(i)), 15
NEXT

PCOPY 1,0
'increments the angles by one
p = p + 1
t = t + 1
d = d + 1

'if angle >360 then it is set to be below this won't
'work for negative angles
p = p mod 360
t = t mod 360
d = d miod 360

'exit the program when the ESC key is pressed
LOOP UNTIL PRESS$=CHR$(27)