Code: Select all
DECLARE SUB Pyramid ()
DECLARE FUNCTION min! (a!, b!)
DECLARE FUNCTION max! (a!, b!)
SCREEN 12
TYPE ThreeD
X AS INTEGER
Y AS INTEGER
Z AS INTEGER
END TYPE
TYPE LIN
s AS INTEGER
e AS INTEGER
END TYPE
DIM SHARED PyrTmp(6) AS ThreeD
DIM SHARED CX
DIM SHARED CY
DIM SHARED fld%(50, 50)
CX = 250 'Defaults to center of screen
CY = 250
dir = 0
CONST pi = 3.14159
KEY 15, CHR$(128) + CHR$(75) 'left
KEY 16, CHR$(128) + CHR$(77) 'right
KEY 17, CHR$(128) + CHR$(72) 'up
KEY 18, CHR$(128) + CHR$(80) 'down
KEY 19, CHR$(0) + CHR$(1)
ON KEY(15) GOSUB left
ON KEY(16) GOSUB right
ON KEY(17) GOSUB up
ON KEY(18) GOSUB down
ON KEY(19) GOSUB donew:
KEY(15) ON
KEY(16) ON
KEY(17) ON
KEY(18) ON
KEY(19) ON
RANDOMIZE TIMER
FOR X = 1 TO 49
FOR Y = 1 TO 49
IF RND < .9 THEN
fld%(X, Y) = 1
END IF
NEXT Y
NEXT X
FOR i = 1 TO 5
READ PyrTmp(i).X, PyrTmp(i).Y, PyrTmp(i).Z
NEXT i
DO
COLOR 15
Pyramid
LOOP
up:
xoset = 0
yoset = 0
LINE (CX, CY)-STEP(11, 11), 0, BF
xoset = COS(dir) * 10
yoset = SIN(dir) * 10
mfx = (CX / 10 + xoset / 10)
mfy = (CY / 10 + yoset / 10)
IF fld%(CX / 10 + xoset / 10, CY / 10 + yoset / 10) = 0 AND mfx * mfy >= 1 AND mfx < 50 AND mfy < 50 THEN
CX = CX + xoset
CY = CY + yoset
END IF
RETURN
down:
xoset = 0
yoset = 0
LINE (CX, CY)-STEP(11, 11), 0, BF
mfx = (CX / 10 + xoset / 10)
mfy = (CY / 10 + yoset / 10)
xoset = COS(dir) * 10
yoset = SIN(dir) * 10
IF fld%(CX / 10 + xoset / 10, CY / 10 + yoset / 10) = 0 AND (mfx * mfy >= 0) AND mfx < 50 AND mfy < 50 THEN
CX = CX - xoset
CY = CY - yoset
END IF
RETURN
right:
dir = dir + pi * .1
IF dir > 2 * pi THEN dir = 0
RETURN
left:
dir = dir - pi * .1
IF dir < 0 THEN dir = 2 * pi
RETURN
donew:
END
RETURN
'x,y,z
DATA 0,10,0
DATA -10,0,-10
DATA 10,0,-10
DATA -10,0,10
DATA 10,0,10
FUNCTION max (a, b)
max = b
IF a > b THEN max = a
END FUNCTION
FUNCTION min (a, b)
min = b
IF a < b THEN min = a
END FUNCTION
SUB Pyramid
DIM Pyr(6) AS ThreeD
DIM TX AS LIN
DIM sx AS LIN
DIM Xf AS LIN
DIM Yf AS LIN
DIM Zf AS LIN
DIM FinX AS LIN
DIM FinY AS LIN
Theta = 0
Phi = 2 * pi - dir
Xmin% = max(CX / 10, 0)
Xmax% = min(CX / 10, 50)
Ymin% = max(CY / 10, 0)
Ymax% = min(CY / 10, 50)
RESTORE
FOR X = Ymin% TO Xmax%
FOR Y = Ymin% TO Ymax%
IF fld%(X, Y) THEN
FOR Start = 1 TO 5
FOR EndL = Start TO 5
TX.e = PyrTmp(Start).X - CX
TY.S = PyrTmp(Start).Y
TZ.S = PyrTmp(Start).Z - CY
TX.e = PyrTmp(EndL).X - CX
TY.E = PyrTmp(EndL).Y
TZ.E = PyrTmp(EndL).Z - CY
sx.s = ((TX.s + PyrTmp(Start).X) / (TZ.S + PyrTmp(Start).Z)) + (320)
sy.s = ((TY.S + PyrTmp(Start).Y) / (TZ.S + PyrTmp(Start).Z)) + (240)
sx.e = ((TX.e + PyrTmp(EndL).X) / (TZ.E + PyrTmp(EndL).Z)) + (320)
sy.e = ((TY.E + PyrTmp(EndL).Y) / (TZ.E + PyrTmp(EndL).Z)) + (240)
Xf.s = -sx.s * SIN(Theta) + COS(Theta)
Yf.s = -sx.s * COS(Theta) * COS(Phi) - sy.s * SIN(Theta) * COS(Phi) + SZ.S * SIN(Phi)
Zf.s = -sx.s * COS(Theta) * SIN(Phi) - sy.s * SIN(Theta) * SIN(Phi) - SZ.S * COS(Phi) + SQR(PyrTmp(Start).X ^ 2 + PyrTmp(Start).Y ^ 2 + PyrTmp(Start).Z ^ 2)
Xf.e = -sx.e * SIN(Theta) + COS(Theta)
Yf.e = -sx.e * COS(Theta) * COS(Phi) - sy.e * SIN(Theta) * COS(Phi) + SZ.E * SIN(Phi)
Zf.e = -sx.e * COS(Theta) * SIN(Phi) - sy.e * SIN(Theta) * SIN(Phi) - SZ.E * COS(Phi) + SQR(PyrTmp(EndL).X ^ 2 + PyrTmp(EndL).Y ^ 2 + PyrTmp(EndL).Z ^ 2)
LINE (sx.s, sy.s)-(sx.e, sy.e)
NEXT EndL
NEXT Start
END IF
NEXT Y
NEXT X
END SUB