' PARADICE.BAS (PAIR OF DICE) FEB/98 BY NICK K. VAN VLIET
' STERIOSCOPIC PROJECTIONS OF A CUBE VERS 2.55 REV 99
' UNIQUE 3D POINTS IS A POINT IN THE LEFT VIEW THAT IS EXACTLY HORIZONTAL
' TO THE SAME UNIQUE POINT IN THE RIGHT VIEW. UNIQUE POINTS THAT ARE NOT
' EXACTLY ON A HORIZONTAL LINE ARE SEEN AS A BLUR; THE SAME BLUR THAT IN-
' DICATES TO THE MIND THAT THE OBJECT IS EITHER ROTATING OR FALLING OR
' RISING. AND THE BLUR IS AN INDICATION OF ITS SPEED.
' WHEN ONE LOOKS AT NEAR OBJECTS THE EYES ARE LINING UP WITH THE NOSE
' WHILE WHEN ONE LOOKS FAR AWAY THE EYES ARE IN FOCUS PARALLEL WITH EACH
' OTHER; THUS THIS ANGLE IS INTERPRETED AS DISTANCE. THIS AFFECT IS EASILY
' SEEN BY THE STRCUBES.BAS WHICH IS A SEEN AS NEARER THEN PARADICE.BAS AND
' AS MUCH AS BEING BETWEEN THE EYES AND THE SCREEN.
'
' TO VIEW 3D: HOLD A LONG PLAIN SHEET VERTICALLY BETWEEN THE CENTER OF THE
' SCREEN AND YOUR NOSE SO THAT EACH EYE SEES ONE OBJECT AND THE MIND SEES A 3D
' PROJECTION OF THE DESIRED EFFECT.
' IF YOU LOOK AT CONSECUTIVE FILM FRAMES (OR EVERY OTHER ONE) LIKE A STERIO-
' SCOPIC VIEW THEN AS LONG AS THERE IS MOTION IN IT YOU WILL SEE A 3D PRO-
' JECTION!
DEFINT H-Z 'default type = INT
DEFDBL A-G
TYPE COORD
X AS DOUBLE
Y AS DOUBLE
Z AS DOUBLE
END TYPE
DECLARE FUNCTION LimitR (Cube() AS COORD, ZL, KL) '?mid point
DECLARE SUB TranslateY (Rotation) 'new coordinates sterio
DECLARE SUB TranslateX () 'new coordinates rot'n
DECLARE SUB TranslateYY () 'new coordinates rot'n
DECLARE SUB TranslateZ () 'new coordinates rot'n
DECLARE SUB PRSPCTV (Cube() AS COORD) 'perspective factor
DECLARE SUB FACE (Cube() AS COORD, R, S, T, u, X0, Y0, CLR, LTR$, SIDE)
'each face
DECLARE SUB DrawCubes (Cube() AS COORD, X0, Y0) 'draw a cube
DECLARE SUB BlankCubes (Cube() AS COORD, X0, Y0) 'blank a cube
DECLARE SUB HALO (Cube() AS COORD, X0, Y0) 'outline cube
DECLARE SUB DIE (Cube() AS COORD, R, S, T, u, X0, Y0, SIDE) 'add dots
DECLARE SUB CircleSpot (Cube() AS COORD, R, S, T, u, X0, Y0, SIDE, XC, YC)
DECLARE SUB DrawCircle (xx, yy) 'draw dot
DECLARE SUB CHNGPX ()
CONST PI = 3.141592654# 'pi/7=0.44880==super nova
CONST scale = 25# 'cubes' size
CONST FALSE = 0
CONST TRUE = NOT FALSE
CONST SegX = 320 - 1 'max X
CONST SegY = 200 - 1 'max Y
CONST Radius = SegX \ 4 '
COMMON SHARED LeftCube() AS COORD, RightCube() AS COORD, Cube() AS COORD
COMMON SHARED X0, Y0, e, SterioAngle, H, K, a$, R, S, T, u
COMMON SHARED ZL, KL, CLR, LTR$, WRFRM$, xx, yy, BHND
SCREEN 13 '320x200 w/256 colors
'LINE (1, 1)-(319, 199), 15, B: INPUT u$
CLS
DIM LeftCube(1 TO 17) AS COORD 'coord lft cube
DIM RightCube(1 TO 17) AS COORD 'coord rt cube
DIM Cube(1 TO 17) AS COORD 'WORKS WITHOUT THIS LINE
DIM ORG(1 TO 8) AS COORD 'restore perspective ETC.
a$ = " "
FOR I = 1 TO 8
READ a, B, c
'PRINT "( "; A; " , "; B; " , "; C; " )" 'READ CUBE COORDS
LeftCube(I).X = a * scale
LeftCube(I).Y = B * scale
LeftCube(I).Z = c * scale
NEXT I
CLS
COLOR 15 'OPTIONS
WRFRM$ = "ON"
LOCATE 10, 1: PRINT "WANT DICE OR WIRE FRAME D/ "; : INPUT u$
IF u$ = "D" OR u$ = "d" THEN WRFRM$ = "OFF"
CLS
IF WRFRM$ = "ON" THEN CW = -1 ELSE CW = -.1 '-2 + -.1
BHND = 14
OFFSET = 140
R = 1: L = 1: H = 30: K = -30 'ROTATION
SterioAngle = 11 'rotation in degrees for right eye 5-15
COLOR 9
DrawCircle Radius, SegY / 2 'contrast background
DrawCircle SegX - Radius, SegY / 2
'PAINT (10, 10), 8, 9 'cls 1,6 /// 9,6
DO 'MAIN LOOP
' RIGHT 23 FAR LEFTT -7 NEAR
' 33 MAX -12 MAX
BHND = BHND + CW: IF BHND >= 26 OR BHND <= -10 THEN CW = -CW '30 + 3
TranslateX 'translate LeftCube H degrees X-AXIS
TranslateYY 'translate LeftCube K degrees Y-AXIS
FOR I = 1 TO 8
ORG(I).X = LeftCube(I).X 'store coord before perspective
ORG(I).Y = LeftCube(I).Y 'destroys them
ORG(I).Z = LeftCube(I).Z
NEXT I
' 3 4
TranslateY (SterioAngle - INT((BHND + 3) / 4))'translate LeftCube 10 deg. sterio
DrawCubes LeftCube(), SegX / 4 + 10 - 15 + BHND, SegY / 2 + BHND - 10 'Left 3D Cube
DrawCubes RightCube(), SegX / 4 + 10 + 15 + OFFSET - BHND, SegY / 2 + BHND - 10 'Right 3D Cube
LOCATE 1, 1
IF WRFRM$ = "ON" THEN 'ERASE WIRE FRAME
FOR II = 0 TO 1000: FOR I = 0 TO 10: NEXT I: NEXT II
BlankCubes LeftCube(), SegX / 4 + 10 - 15 + BHND, SegY / 2 + BHND - 10
BlankCubes RightCube(), SegX / 4 + 10 + 15 + OFFSET - BHND, SegY / 2 + BHND - 10
END IF
FOR I = 1 TO 8
LeftCube(I).X = ORG(I).X 'restore cube values
LeftCube(I).Y = ORG(I).Y
LeftCube(I).Z = ORG(I).Z
NEXT I
DO
H = RAND * 4 - 2 'norm
K = RAND * 4 - 2
LOOP UNTIL (H AND K)
IF WRFRM$ = "ON" THEN K = 3 * K: H = 3 * H
Stroke$ = INKEY$ 'get any keystroke
IF LEN(Stroke$) THEN KeyVal = ASC(Stroke$) ELSE KeyVal = 0
LOOP WHILE KeyVal <> 27 'keep going until escape is pressed
END
' LeftCube original COORDINATES
'x y z
DATA -1 , -1 , -1: '1 left side
DATA -1 , +1 , -1: '2
DATA -1 , +1 , +1: '3
DATA -1 , -1 , +1: '4
DATA +1 , -1 , +1: '5 right side
DATA +1 , +1 , +1: '6
DATA +1 , +1 , -1: '7
DATA +1 , -1 , -1: '8
DATA 0, 0 , 0, 0
SUB BlankCubes (Cube() AS COORD, X0, Y0)
LINE (Cube(1).X + X0, Cube(1).Y + Y0)-(Cube(2).X + X0, Cube(2).Y + Y0), 0 'left face
LINE (Cube(2).X + X0, Cube(2).Y + Y0)-(Cube(3).X + X0, Cube(3).Y + Y0), 0
LINE (Cube(3).X + X0, Cube(3).Y + Y0)-(Cube(4).X + X0, Cube(4).Y + Y0), 0
LINE (Cube(4).X + X0, Cube(4).Y + Y0)-(Cube(1).X + X0, Cube(1).Y + Y0), 0
LINE (Cube(5).X + X0, Cube(5).Y + Y0)-(Cube(6).X + X0, Cube(6).Y + Y0), 0 'right face
LINE (Cube(6).X + X0, Cube(6).Y + Y0)-(Cube(7).X + X0, Cube(7).Y + Y0), 0
LINE (Cube(7).X + X0, Cube(7).Y + Y0)-(Cube(8).X + X0, Cube(8).Y + Y0), 0
LINE (Cube(8).X + X0, Cube(8).Y + Y0)-(Cube(5).X + X0, Cube(5).Y + Y0), 0
LINE (Cube(2).X + X0, Cube(2).Y + Y0)-(Cube(3).X + X0, Cube(3).Y + Y0), 0 'top face
LINE (Cube(3).X + X0, Cube(3).Y + Y0)-(Cube(6).X + X0, Cube(6).Y + Y0), 0
LINE (Cube(6).X + X0, Cube(6).Y + Y0)-(Cube(7).X + X0, Cube(7).Y + Y0), 0
LINE (Cube(7).X + X0, Cube(7).Y + Y0)-(Cube(2).X + X0, Cube(2).Y + Y0), 0
LINE (Cube(1).X + X0, Cube(1).Y + Y0)-(Cube(4).X + X0, Cube(4).Y + Y0), 0 'bottom face
LINE (Cube(4).X + X0, Cube(4).Y + Y0)-(Cube(5).X + X0, Cube(5).Y + Y0), 0
LINE (Cube(5).X + X0, Cube(5).Y + Y0)-(Cube(8).X + X0, Cube(8).Y + Y0), 0
LINE (Cube(8).X + X0, Cube(8).Y + Y0)-(Cube(1).X + X0, Cube(1).Y + Y0), 0
LINE (Cube(3).X + X0, Cube(3).Y + Y0)-(Cube(4).X + X0, Cube(4).Y + Y0), 0 'front face
LINE (Cube(4).X + X0, Cube(4).Y + Y0)-(Cube(5).X + X0, Cube(5).Y + Y0), 0
LINE (Cube(5).X + X0, Cube(5).Y + Y0)-(Cube(6).X + X0, Cube(6).Y + Y0), 0
LINE (Cube(6).X + X0, Cube(6).Y + Y0)-(Cube(3).X + X0, Cube(3).Y + Y0), 0
LINE (Cube(1).X + X0, Cube(1).Y + Y0)-(Cube(2).X + X0, Cube(2).Y + Y0), 0 'rear face
LINE (Cube(2).X + X0, Cube(2).Y + Y0)-(Cube(7).X + X0, Cube(7).Y + Y0), 0
LINE (Cube(7).X + X0, Cube(7).Y + Y0)-(Cube(8).X + X0, Cube(8).Y + Y0), 0
LINE (Cube(8).X + X0, Cube(8).Y + Y0)-(Cube(1).X + X0, Cube(1).Y + Y0), 0
END SUB
SUB CHNGPX
PAINT (10, 10), 0
PAINT (10, 10), 8
PAINT (10, 10), 0
DrawCircle SegX / 4 - 5, SegY / 2 'contrast background
DrawCircle SegX / 4 + 163 - BHND, SegY / 2
PAINT (10, 10), 8, 7
END SUB
SUB CircleSpot (Cube() AS COORD, R, S, T, u, X0, Y0, SIDE, XC, YC)
SPTSCL = 1 'scale for spot
dotclr = 14
x1 = X0 + XC + 2 * SPTSCL: y1 = Y0 + YC + 0
x2 = x1 - 1 * SPTSCL: y2 = y1 + SQR(3#) * SPTSCL
LINE (x1, y1)-(x2, y2), dotclr
X3 = x2 - 2 * SPTSCL: Y3 = y2
LINE (x2, y2)-(X3, Y3), dotclr
X4 = x1 - 4 * SPTSCL: Y4 = y1
LINE (X3, Y3)-(X4, Y4), dotclr
X5 = X4 + 1 * SPTSCL: Y5 = Y4 - SQR(3#) * SPTSCL
LINE (X4, Y4)-(X5, Y5), dotclr
X6 = X5 + 2 * SPTSCL: Y6 = Y5
LINE (X5, Y5)-(X6, Y6), dotclr
LINE (X6, Y6)-(x1, y1), dotclr
LINE (X4, Y4 - SQR(3#) / 2 * SPTSCL)-(X4, Y4 + SQR(3#) / 2 * SPTSCL), dotclr
PAINT (XC + X0, YC + Y0), dotclr, dotclr
END SUB
SUB DIE (Cube() AS COORD, R, S, T, u, X0, Y0, SIDE)
IF SIDE = 1 THEN
xx = CINT((CINT(Cube(R).X) + CINT(Cube(T).X)) / 2)
yy = CINT((CINT(Cube(R).Y) + CINT(Cube(T).Y)) / 2)
CircleSpot Cube(), R, S, T, u, X0, Y0, SIDE, xx, yy
END IF
IF SIDE = 2 THEN
xx = CINT((CINT(Cube(R).X) + (CINT(Cube(R).X) + CINT(Cube(T).X)) / 2) / 2)
yy = CINT((CINT(Cube(R).Y) + (CINT(Cube(R).Y) + CINT(Cube(T).Y)) / 2) / 2)
CircleSpot Cube(), R, S, T, u, X0, Y0, SIDE, xx, yy
xx = CINT((CINT(Cube(T).X) + (CINT(Cube(R).X) + CINT(Cube(T).X)) / 2) / 2)
yy = CINT((CINT(Cube(T).Y) + (CINT(Cube(R).Y) + CINT(Cube(T).Y)) / 2) / 2)
CircleSpot Cube(), R, S, T, u, X0, Y0, SIDE, xx, yy
END IF
IF SIDE = 3 THEN
xx = CINT((CINT(Cube(R).X) + CINT(Cube(T).X)) / 2)
yy = CINT((CINT(Cube(R).Y) + CINT(Cube(T).Y)) / 2)
CircleSpot Cube(), R, S, T, u, X0, Y0, SIDE, xx, yy
xx = CINT((CINT(Cube(R).X) + (CINT(Cube(R).X) + CINT(Cube(T).X)) / 2) / 2)
yy = CINT((CINT(Cube(R).Y) + (CINT(Cube(R).Y) + CINT(Cube(T).Y)) / 2) / 2)
CircleSpot Cube(), R, S, T, u, X0, Y0, SIDE, xx, yy
xx = CINT((CINT(Cube(T).X) + (CINT(Cube(R).X) + CINT(Cube(T).X)) / 2) / 2)
yy = CINT((CINT(Cube(T).Y) + (CINT(Cube(R).Y) + CINT(Cube(T).Y)) / 2) / 2)
CircleSpot Cube(), R, S, T, u, X0, Y0, SIDE, xx, yy
END IF
IF SIDE = 4 THEN
xx = CINT((CINT(Cube(R).X) + (CINT(Cube(R).X) + CINT(Cube(T).X)) / 2) / 2)
yy = CINT((CINT(Cube(R).Y) + (CINT(Cube(R).Y) + CINT(Cube(T).Y)) / 2) / 2)
CircleSpot Cube(), R, S, T, u, X0, Y0, SIDE, xx, yy
xx = CINT((CINT(Cube(T).X) + (CINT(Cube(R).X) + CINT(Cube(T).X)) / 2) / 2)
yy = CINT((CINT(Cube(T).Y) + (CINT(Cube(R).Y) + CINT(Cube(T).Y)) / 2) / 2)
CircleSpot Cube(), R, S, T, u, X0, Y0, SIDE, xx, yy
xx = CINT((CINT(Cube(S).X) + (CINT(Cube(S).X) + CINT(Cube(u).X)) / 2) / 2)
yy = CINT((CINT(Cube(S).Y) + (CINT(Cube(S).Y) + CINT(Cube(u).Y)) / 2) / 2)
CircleSpot Cube(), R, S, T, u, X0, Y0, SIDE, xx, yy
xx = CINT((CINT(Cube(u).X) + (CINT(Cube(S).X) + CINT(Cube(u).X)) / 2) / 2)
yy = CINT((CINT(Cube(u).Y) + (CINT(Cube(S).Y) + CINT(Cube(u).Y)) / 2) / 2)
CircleSpot Cube(), R, S, T, u, X0, Y0, SIDE, xx, yy
END IF
IF SIDE = 5 THEN
xx = CINT((CINT(Cube(R).X) + CINT(Cube(T).X)) / 2)
yy = CINT((CINT(Cube(R).Y) + CINT(Cube(T).Y)) / 2)
CircleSpot Cube(), R, S, T, u, X0, Y0, SIDE, xx, yy
xx = CINT((CINT(Cube(R).X) + (CINT(Cube(R).X) + CINT(Cube(T).X)) / 2) / 2)
yy = CINT((CINT(Cube(R).Y) + (CINT(Cube(R).Y) + CINT(Cube(T).Y)) / 2) / 2)
CircleSpot Cube(), R, S, T, u, X0, Y0, SIDE, xx, yy
xx = CINT((CINT(Cube(T).X) + (CINT(Cube(R).X) + CINT(Cube(T).X)) / 2) / 2)
yy = CINT((CINT(Cube(T).Y) + (CINT(Cube(R).Y) + CINT(Cube(T).Y)) / 2) / 2)
CircleSpot Cube(), R, S, T, u, X0, Y0, SIDE, xx, yy
xx = CINT((CINT(Cube(S).X) + (CINT(Cube(S).X) + CINT(Cube(u).X)) / 2) / 2)
yy = CINT((CINT(Cube(S).Y) + (CINT(Cube(S).Y) + CINT(Cube(u).Y)) / 2) / 2)
CircleSpot Cube(), R, S, T, u, X0, Y0, SIDE, xx, yy
xx = CINT((CINT(Cube(u).X) + (CINT(Cube(S).X) + CINT(Cube(u).X)) / 2) / 2)
yy = CINT((CINT(Cube(u).Y) + (CINT(Cube(S).Y) + CINT(Cube(u).Y)) / 2) / 2)
CircleSpot Cube(), R, S, T, u, X0, Y0, SIDE, xx, yy
END IF
IF SIDE = 6 THEN
xx = CINT((CINT(Cube(R).X) + (CINT(Cube(R).X) + CINT(Cube(T).X)) / 2) / 2)
yy = CINT((CINT(Cube(R).Y) + (CINT(Cube(R).Y) + CINT(Cube(T).Y)) / 2) / 2)
XR = xx: YR = yy
CircleSpot Cube(), R, S, T, u, X0, Y0, SIDE, xx, yy
xx = CINT((CINT(Cube(T).X) + (CINT(Cube(R).X) + CINT(Cube(T).X)) / 2) / 2)
yy = CINT((CINT(Cube(T).Y) + (CINT(Cube(R).Y) + CINT(Cube(T).Y)) / 2) / 2)
XT = xx: YT = yy
CircleSpot Cube(), R, S, T, u, X0, Y0, SIDE, xx, yy
xx = CINT((CINT(Cube(S).X) + (CINT(Cube(S).X) + CINT(Cube(u).X)) / 2) / 2)
yy = CINT((CINT(Cube(S).Y) + (CINT(Cube(S).Y) + CINT(Cube(u).Y)) / 2) / 2)
XS = xx: YS = yy
CircleSpot Cube(), R, S, T, u, X0, Y0, SIDE, xx, yy
xx = CINT((CINT(Cube(u).X) + (CINT(Cube(S).X) + CINT(Cube(u).X)) / 2) / 2)
yy = CINT((CINT(Cube(u).Y) + (CINT(Cube(S).Y) + CINT(Cube(u).Y)) / 2) / 2)
XU = xx: YU = yy
CircleSpot Cube(), R, S, T, u, X0, Y0, SIDE, xx, yy
xx = (XR + XU) / 2: yy = (YR + YU) / 2
CircleSpot Cube(), R, S, T, u, X0, Y0, SIDE, xx, yy
xx = (XS + XT) / 2: yy = (YS + YT) / 2
CircleSpot Cube(), R, S, T, u, X0, Y0, SIDE, xx, yy
END IF
END SUB
SUB DrawCircle (xx, yy)
x1 = Radius
y1 = 0
FOR II = 0 TO 361
x2 = Radius * COS(II / 2)
y2 = Radius * SIN(II / 2)
LINE (x1 + xx, y1 + yy)-(x2 + xx, y2 + yy), 9
x1 = x2: y1 = y2
NEXT II
END SUB
SUB DrawCubes (Cube() AS COORD, X0, Y0)
LOCATE 1, 1
PRSPCTV Cube()
COLOR 2
'1=BU 2=GN 3=CY 4=R 5=M 6=M-USED 7=LGY 8=DGY 9=LBU 10=LGN 11=LCY 12=O 13=LP 14=Y 15=W
',PTS ORG CLR LTR SIDE
FACE Cube(), 1, 2, 3, 4, X0, Y0, 11, "L", 1 'left LCYAN
COLOR 3
FACE Cube(), 5, 6, 7, 8, X0, Y0, 10, "R", 6 'right LGREEN
COLOR 4
FACE Cube(), 2, 3, 6, 7, X0, Y0, 12, "T", 3 '/top ORANGE
COLOR 5
FACE Cube(), 1, 4, 5, 8, X0, Y0, 13, "U", 4 '/bottom LPINK
COLOR 9
IF WRFRM$ = "OFF" THEN
FACE Cube(), 3, 4, 5, 6, X0, Y0, 9, "F", 5 '/front LBLUE
END IF
COLOR 7
IF WRFRM$ = "OFF" THEN
FACE Cube(), 1, 2, 7, 8, X0, Y0, 15, "B", 2 '/rear WHITE
END IF
IF WRFRM$ = "OFF" THEN HALO Cube(), X0, Y0
END SUB
SUB FACE (Cube() AS COORD, R, S, T, u, X0, Y0, CLR, LTR$, SIDE)
LOCATE 1, (X0 - 20) / 8
COLOR CLR
F = (CINT(Cube(R).Z) + CINT(Cube(T).Z) + CINT(Cube(S).Z) + CINT(Cube(u).Z)) / 4
a = (CINT(Cube(R).X) - CINT(Cube(T).X))
c = (CINT(Cube(S).X) - CINT(Cube(u).X))
B = (CINT(Cube(R).Y) - CINT(Cube(T).Y))
d = (CINT(Cube(S).Y) - CINT(Cube(u).Y))
IF WRFRM$ = "OFF" THEN 'WIRE FRAME
IF ABS(a) >= 2 AND ABS(B) >= 2 AND ABS(c) >= 2 AND ABS(d) >= 2 AND F < -2 THEN
'there is a clear mid point in the side
LINE (CINT(Cube(R).X + X0), CINT(Cube(R).Y + Y0))-(CINT(Cube(u).X + X0), CINT(Cube(u).Y + Y0)), 6
LINE (CINT(Cube(S).X + X0), CINT(Cube(S).Y + Y0))-(CINT(Cube(R).X + X0), CINT(Cube(R).Y + Y0)), 6
LINE (CINT(Cube(T).X + X0), CINT(Cube(T).Y + Y0))-(CINT(Cube(S).X + X0), CINT(Cube(S).Y + Y0)), 6
LINE (CINT(Cube(u).X + X0), CINT(Cube(u).Y + Y0))-(CINT(Cube(T).X + X0), CINT(Cube(T).Y + Y0)), 6
PAINT (CINT((Cube(R).X + Cube(T).X) / 2 + X0), CINT((Cube(R).Y + Cube(T).Y) / 2 + Y0)), 7, 6
LINE (CINT(Cube(R).X + X0), CINT(Cube(R).Y + Y0))-(CINT(Cube(u).X + X0), CINT(Cube(u).Y + Y0)), 6
LINE (CINT(Cube(S).X + X0), CINT(Cube(S).Y + Y0))-(CINT(Cube(R).X + X0), CINT(Cube(R).Y + Y0)), 6
LINE (CINT(Cube(T).X + X0), CINT(Cube(T).Y + Y0))-(CINT(Cube(S).X + X0), CINT(Cube(S).Y + Y0)), 6
LINE (CINT(Cube(u).X + X0), CINT(Cube(u).Y + Y0))-(CINT(Cube(T).X + X0), CINT(Cube(T).Y + Y0)), 6
PAINT (CINT((Cube(R).X + Cube(T).X) / 2 + X0), CINT((Cube(R).Y + Cube(T).Y) / 2 + Y0)), CLR, 6
LINE (CINT(Cube(R).X + X0), CINT(Cube(R).Y + Y0))-(CINT(Cube(u).X + X0), CINT(Cube(u).Y + Y0)), CLR
LINE (CINT(Cube(S).X + X0), CINT(Cube(S).Y + Y0))-(CINT(Cube(R).X + X0), CINT(Cube(R).Y + Y0)), CLR
LINE (CINT(Cube(T).X + X0), CINT(Cube(T).Y + Y0))-(CINT(Cube(S).X + X0), CINT(Cube(S).Y + Y0)), CLR
LINE (CINT(Cube(u).X + X0), CINT(Cube(u).Y + Y0))-(CINT(Cube(T).X + X0), CINT(Cube(T).Y + Y0)), CLR
END IF
ELSE
LINE (Cube(R).X + X0, Cube(R).Y + Y0)-(Cube(u).X + X0, Cube(u).Y + Y0), CLR
LINE (Cube(S).X + X0, Cube(S).Y + Y0)-(Cube(R).X + X0, Cube(R).Y + Y0), CLR
LINE (Cube(T).X + X0, Cube(T).Y + Y0)-(Cube(S).X + X0, Cube(S).Y + Y0), CLR
LINE (Cube(u).X + X0, Cube(u).Y + Y0)-(Cube(T).X + X0, Cube(T).Y + Y0), CLR
END IF
IF WRFRM$ = "OFF" THEN
IF F < -2 THEN DIE Cube(), R, S, T, u, X0, Y0, SIDE 'print spots
END IF
END SUB
SUB HALO (Cube() AS COORD, X0, Y0)
SCLM = scale + scale / 5 * 2: DUP = FALSE: HCLR = 0
Stp = FALSE
FOR I = 1 TO 7 'get lowest 2 radii IF not 4
a = CINT(Cube(I).X) * CINT(Cube(I).X) + CINT(Cube(I).Y) * CINT(Cube(I).Y)
FOR K = I + 1 TO 8
B = CINT(Cube(K).X) * CINT(Cube(K).X) + CINT(Cube(K).Y) * CINT(Cube(K).Y)
IF B < a THEN
Cube(9).X = Cube(I).X: a = B 'switch sorted
Cube(9).Y = Cube(I).Y
Cube(9).Z = Cube(I).Z
Cube(I).X = Cube(K).X
Cube(I).Y = Cube(K).Y
Cube(I).Z = Cube(K).Z
Cube(K).X = Cube(9).X
Cube(K).Y = Cube(9).Y
Cube(K).Z = Cube(9).Z
END IF
NEXT K
NEXT I
LL = 0: ZT = 0
FOR I = 2 TO 8 'get DUPLICATES
Z = ABS(CINT(Cube(1).Z))
IF LimitR(Cube(), Z, K) THEN DUP = TRUE
IF DUP THEN LL = LL + 1
NEXT I
IF LL THEN L = LL + 2 ELSE L = 3
IF DUP THEN
Z = ABS(CINT(Cube(1).Z))
FOR I = 1 TO 8
IF LimitR(Cube(), Z, I) THEN Cube(I).X = -1000: Cube(I).Z = -1000 '?0
NEXT I
ELSE
Cube(1).X = -1000: Cube(1).Z = -1000: Cube(2).X = -1000: Cube(2).Z = -1000
END IF
DUP = FALSE
FOR I = 1 TO 7 ' sort X 1-8
a = CINT(Cube(I).X): ' LOCATE 1, 1
FOR K = I + 1 TO 8
B = CINT(Cube(K).X)
IF B < a THEN
a = B
Cube(9).X = Cube(I).X 'switch
Cube(9).Y = Cube(I).Y
Cube(I).X = Cube(K).X
Cube(I).Y = Cube(K).Y
Cube(K).X = Cube(9).X
Cube(K).Y = Cube(9).Y
END IF
NEXT K
NEXT I
FOR I = 3 TO 7 ' sort X-8
a = CINT(Cube(I).X): B = CINT(Cube(I).Y): K = I + 1
c = CINT(Cube(K).X): d = CINT(Cube(K).Y)
IF a = c AND B < d THEN
Cube(9).X = Cube(I).X 'switch
Cube(9).Y = Cube(I).Y
Cube(I).X = Cube(K).X
Cube(I).Y = Cube(K).Y
Cube(K).X = Cube(9).X
Cube(K).Y = Cube(9).Y
END IF
NEXT I 'sorted
a = CINT(Cube(7).Y): B = CINT(Cube(8).Y)
c = CINT(Cube(L).Y): d = CINT(Cube(L + 1).Y)
e = CINT(Cube(6).Y): F = CINT(Cube(L + 2).Y)
Cube(9).X = Cube(8).X: Cube(9).Y = Cube(8).Y
IF (a > B) THEN 'too low
Cube(8).X = Cube(7).X
Cube(8).Y = Cube(7).Y
Cube(7).X = Cube(9).X
Cube(7).Y = Cube(9).Y
END IF
Cube(9).X = Cube(L).X: Cube(9).Y = Cube(L).Y
IF (c > d) THEN 'too high
Cube(L).X = Cube(L + 1).X
Cube(L).Y = Cube(L + 1).Y
Cube(L + 1).X = Cube(9).X
Cube(L + 1).Y = Cube(9).Y
END IF
FOR I = L TO 8: ' LOCATE 1, 1
a = CINT(Cube(I).X)
IF a = -1000 THEN L = I + 1
NEXT I
FOR I = L TO 7 'neg side
IF I = L THEN
a = CINT(Cube(I).X): B = CINT(Cube(I).Y)
END IF
FOR K = L TO 8
c = CINT(Cube(K).X): d = CINT(Cube(K).Y)
IF K < 8 AND (K = I OR (K <> L AND Cube(K).Y > 0)) THEN GOTO EXITK
Xa = SGN(a): Yb = SGN(B)
XC = SGN(c): Yd = SGN(d)
LINE (a + Xa + X0, B + Yb + Y0)-(c + XC + X0, d + Yd + Y0), HCLR
LINE (a + Xa / 2 + X0, B + Yb / 2 + Y0)-(c + XC / 2 + X0, d + Yd / 2 + Y0), HCLR
LINE (a + Xa + Xa + X0, B + Yb + Yb + Y0)-(c + XC + XC + X0, d + Yd + Yd + Y0), HCLR
LINE (a + Xa + Xa / 2 + X0, B + Yb + Yb / 2 + Y0)-(c + XC + XC / 2 + X0, d + Yd + Yd / 2 + Y0), HCLR
LINE (a + Xa + Xa + X0, B + Yb + Yb + Yb + Y0)-(c + XC + XC + X0, d + Yd + Yd + Yd + Y0), HCLR
LINE (a + Xa + Xa + Xa + X0, B + Yb + Yb + Y0)-(c + XC + XC + XC + X0, d + Yd + Yd + Y0), HCLR
LINE (a + Xa + Xa + Xa + X0, B + Yb + Yb + Yb + Y0)-(c + XC + XC + XC + X0, d + Yd + Yd + Yd + Y0), HCLR
a = c: B = d: I = K
EXITK:
NEXT K
NEXT I
FOR I = 8 TO L + 1 STEP -1 'pos side
IF I = 8 THEN
a = CINT(Cube(I).X): B = CINT(Cube(I).Y)
END IF
FOR K = 8 TO L STEP -1
c = CINT(Cube(K).X): d = CINT(Cube(K).Y)
IF K > L AND (K = I OR (K <> 8 AND Cube(K).Y < 0)) THEN GOTO EXITKK
Xa = SGN(a): Yb = SGN(B)
XC = SGN(c): Yd = SGN(d)
LINE (a + Xa + X0, B + Yb + Y0)-(c + XC + X0, d + Yd + Y0), HCLR
LINE (a + Xa / 2 + X0, B + Yb / 2 + Y0)-(c + XC / 2 + X0, d + Yd / 2 + Y0), HCLR
LINE (a + Xa + Xa + X0, B + Yb + Yb + Y0)-(c + XC + XC + X0, d + Yd + Yd + Y0), HCLR
LINE (a + Xa + Xa / 2 + X0, B + Yb + Yb / 2 + Y0)-(c + XC + XC / 2 + X0, d + Yd + Yd / 2 + Y0), HCLR
LINE (a + Xa + Xa + X0, B + Yb + Yb + Yb + Y0)-(c + XC + XC + X0, d + Yd + Yd + Yd + Y0), HCLR
LINE (a + Xa + Xa + Xa + X0, B + Yb + Yb + Y0)-(c + XC + XC + XC + X0, d + Yd + Yd + Y0), HCLR
LINE (a + Xa + Xa + Xa + X0, B + Yb + Yb + Yb + Y0)-(c + XC + XC + XC + X0, d + Yd + Yd + Yd + Y0), HCLR
a = c: B = d: I = K
EXITKK:
NEXT K
NEXT I
END SUB
FUNCTION LimitR (Cube() AS COORD, ZL, KL)
LimitRT = FALSE
IF ABS(ABS(ZL) - ABS(CINT(Cube(KL).Z))) < 6 THEN LimitRT = TRUE
LimitR = LimitRT
END FUNCTION
SUB PRSPCTV (Cube() AS COORD)
FOR I = 1 TO 8
Cube(I).X = (500# + BKND - Cube(I).Z) * Cube(I).X / 500#
Cube(I).Y = (500# + BKND - Cube(I).Z) * Cube(I).Y / 500#
NEXT I
END SUB
SUB TranslateX 'about x-axis
a = COS(CDBL(H) * PI / 180#)
B = SIN(CDBL(H) * PI / 180#)
FOR I = 1 TO 8
c = LeftCube(I).Y * a + LeftCube(I).Z * B
LeftCube(I).Z = -LeftCube(I).Y * B + LeftCube(I).Z * a
LeftCube(I).Y = c
LeftCube(I).X = LeftCube(I).X
NEXT I
END SUB
'about y'about x-axis -axis 'about y-axis
SUB TranslateY (Rotation)
a = COS(Rotation * PI / 180)
B = SIN(Rotation * PI / 180)
FOR I = 1 TO 8
c = LeftCube(I).X * a + LeftCube(I).Z * B
RightCube(I).Z = -LeftCube(I).X * B + LeftCube(I).Z * a
RightCube(I).X = c
RightCube(I).Y = LeftCube(I).Y
NEXT I
END SUB
SUB TranslateYY 'about y-axis
a = COS(CDBL(K) * PI / 180#)
B = SIN(CDBL(K) * PI / 180#)
FOR I = 1 TO 8
c = LeftCube(I).X * a + LeftCube(I).Z * B
LeftCube(I).Z = -LeftCube(I).X * B + LeftCube(I).Z * a
LeftCube(I).X = c
LeftCube(I).Y = LeftCube(I).Y
NEXT I
END SUB
SUB TranslateZ 'about z-axis
a = COS(CDBL(K) * PI / 180#)
B = SIN(CDBL(K) * PI / 180#)
FOR I = 1 TO 8
c = LeftCube(I).X * a + LeftCube(I).Y * B
LeftCube(I).Y = -LeftCube(I).X * B + LeftCube(I).Y * a
LeftCube(I).X = c
LeftCube(I).Z = LeftCube(I).Z
NEXT I
END SUB
RETURN TO TOP |
PMC MENU |
HOME PAGE