QuickBasic Cafe Forum

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
 &nbsp; &nbsp; &nbsp; &nbsp;IF RND < .9 THEN
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;fld%(X, Y) = 1
 &nbsp; &nbsp; &nbsp; &nbsp;END IF
 &nbsp; &nbsp;NEXT Y
NEXT X

FOR i = 1 TO 5
 &nbsp; &nbsp;READ PyrTmp(i).X, PyrTmp(i).Y, PyrTmp(i).Z
NEXT i

DO
 &nbsp; &nbsp;COLOR 15
 &nbsp; &nbsp;Pyramid
LOOP

up:
 &nbsp; &nbsp;xoset = 0
 &nbsp; &nbsp;yoset = 0
 &nbsp; &nbsp;LINE (CX, CY)-STEP(11, 11), 0, BF
 &nbsp; &nbsp; xoset = COS(dir) * 10
 &nbsp; &nbsp; yoset = SIN(dir) * 10
 &nbsp; &nbsp; mfx = (CX / 10 + xoset / 10)
 &nbsp; &nbsp; mfy = (CY / 10 + yoset / 10)
 &nbsp; &nbsp; IF fld%(CX / 10 + xoset / 10, CY / 10 + yoset / 10) = 0 AND mfx * mfy >= 1 AND mfx < 50 AND mfy < 50 THEN
 &nbsp; &nbsp; &nbsp; &nbsp;CX = CX + xoset
 &nbsp; &nbsp; &nbsp; &nbsp;CY = CY + yoset
 &nbsp; &nbsp; END IF

RETURN

down:
 &nbsp; &nbsp;xoset = 0
 &nbsp; &nbsp;yoset = 0
 &nbsp; &nbsp;LINE (CX, CY)-STEP(11, 11), 0, BF
 &nbsp; &nbsp;mfx = (CX / 10 + xoset / 10)
 &nbsp; &nbsp;mfy = (CY / 10 + yoset / 10)
 &nbsp; &nbsp;xoset = COS(dir) * 10
 &nbsp; &nbsp;yoset = SIN(dir) * 10
 &nbsp; &nbsp;IF fld%(CX / 10 + xoset / 10, CY / 10 + yoset / 10) = 0 AND (mfx * mfy >= 0) AND mfx < 50 AND mfy < 50 THEN
 &nbsp; &nbsp; &nbsp; &nbsp;CX = CX - xoset
 &nbsp; &nbsp; &nbsp; &nbsp;CY = CY - yoset
 &nbsp; &nbsp; END IF
RETURN
right:
 &nbsp; &nbsp;dir = dir + pi * .1
 &nbsp; &nbsp;IF dir > 2 * pi THEN dir = 0
RETURN

left:
 &nbsp; &nbsp;dir = dir - pi * .1
 &nbsp; &nbsp;IF dir < 0 THEN dir = 2 * pi
RETURN
 &nbsp; &nbsp;
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%
 &nbsp; &nbsp;FOR Y = Ymin% TO Ymax%
 &nbsp; &nbsp; &nbsp; &nbsp;IF fld%(X, Y) THEN
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;FOR Start = 1 TO 5
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;FOR EndL = Start TO 5
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;TX.e = PyrTmp(Start).X - CX
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;TY.S = PyrTmp(Start).Y
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;TZ.S = PyrTmp(Start).Z - CY

 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;TX.e = PyrTmp(EndL).X - CX
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;TY.E = PyrTmp(EndL).Y
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;TZ.E = PyrTmp(EndL).Z - CY
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; 
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;sx.s = ((TX.s + PyrTmp(Start).X) / (TZ.S + PyrTmp(Start).Z)) + (320)
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;sy.s = ((TY.S + PyrTmp(Start).Y) / (TZ.S + PyrTmp(Start).Z)) + (240)
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;sx.e = ((TX.e + PyrTmp(EndL).X) / (TZ.E + PyrTmp(EndL).Z)) + (320)
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;sy.e = ((TY.E + PyrTmp(EndL).Y) / (TZ.E + PyrTmp(EndL).Z)) + (240)
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; 
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;Xf.s = -sx.s * SIN(Theta) + COS(Theta)
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;Yf.s = -sx.s * COS(Theta) * COS(Phi) - sy.s * SIN(Theta) * COS(Phi) + SZ.S * SIN(Phi)
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;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)
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;Xf.e = -sx.e * SIN(Theta) + COS(Theta)
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;Yf.e = -sx.e * COS(Theta) * COS(Phi) - sy.e * SIN(Theta) * COS(Phi) + SZ.E * SIN(Phi)
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;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)
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;LINE (sx.s, sy.s)-(sx.e, sy.e)
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;NEXT EndL
 &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;NEXT Start
 &nbsp; &nbsp; &nbsp; &nbsp;END IF
 &nbsp; &nbsp;NEXT Y
NEXT X

END SUB