QB / QB64 Discussion Forum      Other Subforums, Links and Downloads
 

 Return to Index  

A good example

April 26 2010 at 8:56 AM
lawgin  (no login)


Response to Rotating Cubes?

 
The rotating cube challenge reminded me of a program I saw a while back which is reproduced below. The 4,6,8, and 2 keys cause the cube to rotate left, right, up, and down. "H", "P", "0", and "." do other things. It works especially well with qb64.

Giving proper attribution, the programmer is Dylan Hoen. This and some other interesting stuff can be found on his web page:
http://hoen.ca/programming/graphical.php



DECLARE SUB rot ()
DECLARE SUB xy ()
DECLARE SUB xz ()
DECLARE SUB yz ()
DECLARE SUB fov1 ()
DECLARE SUB ky ()
DECLARE SUB cubes ()
DECLARE SUB cubel ()
DECLARE SUB mono ()
COMMON SHARED pi!, an!, fov!, n, an2!, l, k$, h!, z!, y!, x!, co!, si!

CLS
SCREEN 12


pi! = 3.141593
an! = 5
sc! = 1
fov! = 45
n = 8
h! = 2 / TAN(pi! * fov! / 360)
DIM SHARED a(n, 2) AS SINGLE
DIM SHARED b(n, 3) AS SINGLE
DIM SHARED c(n, 4) AS SINGLE
cubes


h! = 2 / TAN(pi! * fov! / 360)
an2! = an! * pi! / 180
mono

END

SUB cubel




LINE (a(1, 1), a(1, 2))-(a(4, 1), a(4, 2))

LINE (a(1, 1), a(1, 2))-(a(2, 1), a(2, 2))

LINE (a(1, 1), a(1, 2))-(a(5, 1), a(5, 2))

LINE (a(7, 1), a(7, 2))-(a(3, 1), a(3, 2))

LINE (a(7, 1), a(7, 2))-(a(6, 1), a(6, 2))

LINE (a(7, 1), a(7, 2))-(a(8, 1), a(8, 2))

LINE (a(2, 1), a(2, 2))-(a(3, 1), a(3, 2))

LINE (a(3, 1), a(3, 2))-(a(4, 1), a(4, 2))

LINE (a(4, 1), a(4, 2))-(a(8, 1), a(8, 2))

LINE (a(8, 1), a(8, 2))-(a(5, 1), a(5, 2))

LINE (a(5, 1), a(5, 2))-(a(6, 1), a(6, 2))

LINE (a(6, 1), a(6, 2))-(a(2, 1), a(2, 2))




END SUB

SUB cubes

c(1, 1) = 1
c(1, 2) = 1
c(1, 3) = 1

c(2, 1) = -1
c(2, 2) = 1
c(2, 3) = 1

c(3, 1) = -1
c(3, 2) = -1
c(3, 3) = 1

c(4, 1) = 1
c(4, 2) = -1
c(4, 3) = 1

c(5, 1) = 1
c(5, 2) = 1
c(5, 3) = -1

c(6, 1) = -1
c(6, 2) = 1
c(6, 3) = -1

c(7, 1) = -1
c(7, 2) = -1
c(7, 3) = -1

c(8, 1) = 1
c(8, 2) = -1
c(8, 3) = -1

FOR l = 1 TO n
c(l, 4) = 0
NEXT l


END SUB

SUB fov1


FOR l = 1 TO n
no = 0
x! = (h! - c(l, 3))
IF x! > -.1 AND x! < .1 THEN
x! = 1
no = 1
END IF

z! = 120 * h! / x!
IF z! < 0 THEN
z! = 1
no = 1
END IF
a(l, 1) = c(l, 1) * z! + 320
a(l, 2) = c(l, 2) * z! + 240
IF no = 1 THEN
r! = 10000 / (c(l, 1) ^ 2 + c(l, 2) ^ 2) ^ .5
a(l, 1) = c(l, 1) * r! + 320
a(l, 2) = c(l, 2) * r! + 240
END IF

NEXT l

END SUB

SUB ky



k$ = ""
DO WHILE k$ = ""
k$ = INKEY$
LOOP
k$ = RIGHT$(k$, 1)


END SUB

SUB mono
COLOR 14
CLS

COLOR 15


ma:
fov1


CLS
cubel


mky:

ky

IF k$ = " " THEN GOTO mz
rot

GOTO ma
mz:
END SUB

SUB rot

SELECT CASE k$
CASE " "
GOTO rz
END

CASE CHR$(72)
FOR l = 1 TO n
c(l, 3) = c(l, 3) + .5
NEXT l
GOTO rz
END

CASE CHR$(80)
FOR l = 1 TO n
c(l, 3) = c(l, 3) - .5
NEXT l
GOTO rz
END

CASE "5"
stv! = 0
sth! = 0
GOTO rz
END


CASE "2"
si! = SIN(0 - an2!)
co! = COS(0 - an2!)
yz
GOTO rz
END


CASE "8"
si! = SIN(0 + an2!)
co! = COS(0 + an2!)
yz
GOTO rz
END


CASE "4"
si! = SIN(0 + an2!)
co! = COS(0 + an2!)
xz
GOTO rz
END


CASE "6"
si! = SIN(0 - an2!)
co! = COS(0 - an2!)
xz
GOTO rz
END


CASE "0"
si! = SIN(0 - an2!)
co! = COS(0 - an2!)
xy
GOTO rz
END


CASE "."
si! = SIN(0 + an2!)
co! = COS(0 + an2!)
xy
GOTO rz
END


CASE ELSE



GOTO rz
END
END SELECT
rz:
END SUB

SUB xy
FOR l = 1 TO n
x! = c(l, 1)
y! = c(l, 2)
c(l, 2) = y! * co! + x! * si!
c(l, 1) = x! * co! - y! * si!
NEXT l
END SUB

SUB xz
FOR l = 1 TO n
x! = c(l, 1)
z! = c(l, 3)
c(l, 3) = z! * co! + x! * si!
c(l, 1) = x! * co! - z! * si!
NEXT l
END SUB

SUB yz
FOR l = 1 TO n
y! = c(l, 2)
z! = c(l, 3)
c(l, 3) = z! * co! + y! * si!
c(l, 2) = y! * co! - z! * si!
NEXT l
END SUB


 
 Respond to this message   
Responses

 Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement