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