<![CDATA[' ** sterioscopic VERS2.1 FEB/98 BY NICK VAN VLIET 3D SCULPTURE
' **
' 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.
DEFINT H-Z 'INTEGERS
DEFDBL A-G 'DOUBLES
DECLARE SUB DrawCcircle (xx, yy) 'DRAW CIRCLE
CONST PI = 3.141592654#
SCREEN 12 'high resolution graphics mode 640X480
RANDOMIZE TIMER 'seed random number generator
MaxX = 319 'half width (starts at 0)
MaxY = 239 'half height (starts at 0)
SegX = 319
SegY = 239
OFFSET = 340
DO 'start of main loop
DrawCcircle SegX / 2 - 3, SegY 'contrast background
DrawCcircle SegX / 2 + OFFSET - 1, SegY
COLOR RND * 14 + 1 'set current color to random (1 to 15)
COLOR RND * 8 + 7 'set current color to random (7 to 15)
DO
DO
x1 = RND * MaxX 'set X1 to a random (0 to max)
y1 = RND * MaxY 'ditto for Y1
x2 = RND * MaxX 'ditto for X2
y2 = RND * MaxY 'ditto for Y2
LOOP WHILE ((ABS(x2 - x1) < 1) OR (ABS(y2 - y1) < 1))
LOOP WHILE (ABS(ABS((y2 - y1) / (x2 - x1)) - 1) < 1) OR (ABS((y2 - y1) / (x2 - x1)) = 0)
DO
StepX1 = RND * 2 - 1 'set StepX1 to random (-2 to 2)
StepY1 = RND * 2 - 1 'ditto for StepY1
StepX2 = RND * 2 - 1 'ditto for StepX2
StepY2 = RND * 2 - 1 'ditto for StepY2
LOOP WHILE (StepX1 = 0 OR StepY1 = 0 OR StepX2 = 0 OR StepY2 = 0)
COLOR RND * 13 + 1 'set current color to random (1 to 14)
FOR Times = 1 TO 7 'do 7 sets of lines THICK LINE\
X3 = 319 - x1 'calculate points for
X4 = 319 - x2 '16 OBJECTS
X5 = x1 + 320 '8 X values
X6 = x2 + 320
X7 = X3 + 320
X8 = X4 + 320
Y3 = 239 - y1 '8 Y values
Y4 = 239 - y2
Y5 = y1 + 240
Y6 = y2 + 240
Y7 = Y3 + 240
Y8 = Y4 + 240
LINE (x1, y1)-(x2, y2) 'draw the lines \ bottom
LINE (X3, y1)-(X4, y2) ' \/ bottom
LINE (x1, Y3)-(x2, Y4) ' \/ \ top
LINE (X3, Y3)-(X4, Y4) ' \/ /\ TOP PAIR
B = 15: A = B: C = 0: D = -2 'd=12
LINE (X5 + C, y1)-(X6 + A, y2) '\/ /\ \
LINE (X7 + D, y1)-(X8 + B, y2) '\/ /\ \/ -3D BOTTOM
LINE (X5 + C, Y3)-(X6 + A, Y4) '
LINE (X7 + D, Y3)-(X8 + B, Y4) '\/ /\ \/ /\ 3D TOP
LINE (x1, Y5)-(x2, Y6) '\
LINE (X3, Y5)-(X4, Y6) '\/
LINE (x1, Y7)-(x2, Y8) '\/ /
LINE (X3, Y7)-(X4, Y8) '\/ /\ BOTTOM PAIR
LINE (X5 + C, Y5)-(X6 + A, Y6) '\/ /\ \
LINE (X7 + D, Y5)-(X8 + B, Y6) '\/ /\ \/ -3D BOTTOM'
LINE (X5 + C, Y7)-(X6 + A, Y8) '\/ /\ \/ /
LINE (X7 + D, Y7)-(X8 + B, Y8) '\/ /\ \/ /\ 3D TOP
LINE (280, 0)-(355, 600), 0, BF
LINE (0, 0)-(30, 600), 0, BF
LINE (603, 0)-(660, 600), 0, BF
x1 = x1 + StepX1 * (RND + 1.5) 'adjust with step value
y1 = y1 + StepY1 * (RND + 1.5) 'ditto
x2 = x2 + StepX2 * (RND + 1.5) 'ditto
y2 = y2 + StepY2 * (RND + 1.5) 'ditto
NEXT Times
cnt = cnt + 1 'count the number of loops
IF cnt = 5 THEN 'after 5 loops
cnt = 0 'reset loop count
FOR I = 0 TO 9000: FOR H = 0 TO 80: NEXT H: NEXT I 'pause
CLS 'clear the screen
END IF
Stroke$ = INKEY$ 'get any keystrokes
IF LEN(Stroke$) THEN KeyVal = ASC(Stroke$) 'convert to an integer
LOOP WHILE KeyVal <> 27 'QUIT: escape is pressed
END
SUB DrawCcircle (xx, yy)
scale = 5
x1 = 3 * scale
y1 = 0
FOR II = 0 TO 360
x2 = 10 * COS(II / 180 * PI) 'SCALE=
y2 = 10 * SIN(II / 180 * PI)
LINE (xx, yy)-(x2 + xx, y2 + yy), 1
NEXT II
END SUB
]]>