DECLARE SUB ling (x1%, y1%, x2%, y2%)
' Svjatoslav Agejenko, svjatoslav@svjatoslav.eu, svjatoslav.eu
' 2004.07

' Generate stereo image. Red & Green (blue) glasses necessary.

' arrow keys - move around
' 2, 6, 4, 8 - look around
' -          - fly up
' +          - fly down
' q, w       - change horisontal distance between left and right view


DECLARE SUB mkkoll ()
DECLARE SUB putkol ()
DECLARE SUB rend ()
DECLARE SUB env ()
DECLARE SUB start ()
DIM SHARED npo, nlo, np, nl
DIM SHARED px(1 TO 1000)
DIM SHARED py(1 TO 1000)
DIM SHARED pz(1 TO 1000)

DIM SHARED rpx(1 TO 1000)
DIM SHARED rpx2(1 TO 1000)
DIM SHARED rpy(1 TO 1000)

DIM SHARED orpx(1 TO 1000)
DIM SHARED orpx2(1 TO 1000)
DIM SHARED orpy(1 TO 1000)
DIM SHARED onp
DIM SHARED lin1(1 TO 1000)
DIM SHARED lin2(1 TO 1000)
DIM SHARED linc(1 TO 1000)
DIM SHARED olin1(1 TO 1000)
DIM SHARED olin2(1 TO 1000)
DIM SHARED onl
DIM SHARED myx, myy, myz
DIM SHARED myxs, myys, myzs
DIM SHARED an1, an2
DIM SHARED an1s, an2s
DIM SHARED kolx(1 TO 10)
DIM SHARED koly(1 TO 10)
DIM SHARED kolz(1 TO 10)
DIM SHARED kolxs(1 TO 10)
DIM SHARED kolys(1 TO 10)
DIM SHARED kolzs(1 TO 10)
DIM SHARED kolm
DIM SHARED difp

DIM SHARED spee

spee = 4
'ON ERROR GOTO 2

start
env
putkol
difp = -.1
1
PCOPY 0, 1
CLS

np = npo
nl = nlo

mkkoll
rend

myx = myx + myxs
myy = myy + myys
myz = myz + myzs
an1 = an1 + an1s
an2 = an2 + an2s

a$ = INKEY$
IF a$ <> "" THEN
IF a$ = CHR$(0) + "H" THEN
myzs = myzs - SIN(an1) / 100
myxs = myxs - COS(an1) / 100
END IF
IF a$ = CHR$(0) + "P" THEN
myzs = myzs + SIN(an1) / 100
myxs = myxs + COS(an1) / 100
END IF
IF a$ = CHR$(0) + "M" THEN
myzs = myzs + COS(an1) / 100
myxs = myxs - SIN(an1) / 100
END IF
IF a$ = CHR$(0) + "K" THEN
myzs = myzs - COS(an1) / 100
myxs = myxs + SIN(an1) / 100
END IF

IF a$ = "6" THEN an1s = an1s - .01
IF a$ = "4" THEN an1s = an1s + .01
IF a$ = "8" THEN an2s = an2s - .01
IF a$ = "2" THEN an2s = an2s + .01
IF a$ = "+" THEN myys = myys - .01
IF a$ = "-" THEN myys = myys + .01
IF a$ = "q" THEN difp = difp - .01
IF a$ = "w" THEN difp = difp + .01
IF a$ = " " THEN
  myxs = myxs / 2
  myys = myys / 2
  myzs = myzs / 2

  an1s = an1s / 2
  an2s = an2s / 2
  an3s = an3s / 2

END IF
IF a$ = CHR$(27) THEN SYSTEM
END IF
GOTO 1
2
END
RESUME

SUB env

FOR z = -5 TO 5
FOR x = -5 TO 5
np = np + 1
px(np) = x
py(np) = SIN(SQR(x * x + z * z) / 2)
pz(np) = z
IF x > -5 THEN
nl = nl + 1
lin1(nl) = np
lin2(nl) = np - 1
linc(nl) = 3
END IF
IF z > -5 THEN
nl = nl + 1
lin1(nl) = np
lin2(nl) = np - 11
linc(nl) = 3
END IF
NEXT x
NEXT z

npo = np
nlo = nl


END SUB

SUB env1

np = 1
px(np) = -2
py(np) = 0
pz(np) = 0
np = np + 1
px(np) = 2
py(np) = 0
pz(np) = 0

nl = 1
lin1(nl) = 1
lin2(nl) = 2
linc(nl) = 14

END SUB

SUB ling (x1%, y1%, x2%, y2%)

s = ABS(x1% - x2%)
s2 = ABS(y1% - y2%)
IF s2 > s THEN s = s2
IF s < 2 THEN GOTO 101
xp = x2% - x1%
yp = y2% - y1%

FOR a% = 1 TO s
  rx% = xp * a% / s + x1%
  ry% = yp * a% / s + y1%
  c% = POINT(rx%, ry%)
  IF c% = 0 THEN PSET (rx%, ry%), 2
  IF c% = 1 THEN PSET (rx%, ry%), 3
NEXT a%
101
END SUB

SUB linr (x1, y1, x2, y2)
  LINE (x1, y1)-(x2, y2), 1
END SUB

SUB mkkoll

FOR a = 1 TO kolm
x = kolx(a)
y = koly(a)
z = kolz(a)

xs = kolxs(a)
ys = kolys(a)
zs = kolzs(a)

ys = ys - .01

x = x + xs / spee
y = y + ys / spee
z = z + zs / spee

IF x > 5 THEN xs = -.1
IF z > 5 THEN zs = -.1
IF x < -5 THEN xs = .1
IF z < -5 THEN zs = .1
IF y < .5 THEN ys = RND * .2 + .1

nl = nl + 1
lin1(nl) = np + 1
lin2(nl) = np + 2
linc(nl) = 14

nl = nl + 1
lin1(nl) = np + 3
lin2(nl) = np + 2
linc(nl) = 14

nl = nl + 1
lin1(nl) = np + 3
lin2(nl) = np + 4
linc(nl) = 14

nl = nl + 1
lin1(nl) = np + 1
lin2(nl) = np + 4
linc(nl) = 14


nl = nl + 1
lin1(nl) = np + 1
lin2(nl) = np + 5
linc(nl) = 14

nl = nl + 1
lin1(nl) = np + 2
lin2(nl) = np + 6
linc(nl) = 14

nl = nl + 1
lin1(nl) = np + 3
lin2(nl) = np + 7
linc(nl) = 14

nl = nl + 1
lin1(nl) = np + 4
lin2(nl) = np + 8
linc(nl) = 14



nl = nl + 1
lin1(nl) = np + 5
lin2(nl) = np + 6
linc(nl) = 14

nl = nl + 1
lin1(nl) = np + 7
lin2(nl) = np + 6
linc(nl) = 14

nl = nl + 1
lin1(nl) = np + 7
lin2(nl) = np + 8
linc(nl) = 14

nl = nl + 1
lin1(nl) = np + 5
lin2(nl) = np + 8
linc(nl) = 14




np = np + 1
px(np) = x - .5
py(np) = y - .5
pz(np) = z - .5

np = np + 1
px(np) = x + .5
py(np) = y - .5
pz(np) = z - .5

np = np + 1
px(np) = x + .5
py(np) = y + .5
pz(np) = z - .5

np = np + 1
px(np) = x - .5
py(np) = y + .5
pz(np) = z - .5

np = np + 1
px(np) = x - .5
py(np) = y - .5
pz(np) = z + .5

np = np + 1
px(np) = x + .5
py(np) = y - .5
pz(np) = z + .5

np = np + 1
px(np) = x + .5
py(np) = y + .5
pz(np) = z + .5

np = np + 1
px(np) = x - .5
py(np) = y + .5
pz(np) = z + .5




kolx(a) = x
koly(a) = y
kolz(a) = z
kolxs(a) = xs
kolys(a) = ys
kolzs(a) = zs
NEXT a

END SUB

SUB putkol

s = 1
FOR a = 1 TO kolm
kolx(a) = RND * 10 - 5
koly(a) = 2
kolz(a) = RND * 10 - 5
kolxs(a) = (RND * .5 - .25) / s
kolys(a) = (RND * .5 + .1) / s
kolzs(a) = (RND * .5 - .25) / s
NEXT a
END SUB

SUB rend
'C3& = Cosine&(Deg3): S3& = Sine&(Deg3)

s1 = SIN(an1)
c1 = COS(an1)
s2 = SIN(an2)
c2 = COS(an2)

FOR a = 1 TO np
x = px(a) + myx
y = py(a) - myy
z = pz(a) + myz
      
x1 = x * s1 - z * c1
z1 = x * c1 + z * s1
y1 = y * s2 - z1 * c2
z2 = y * c2 + z1 * s2
    
IF z2 < .1 THEN
rpx(a) = -1
ELSE
rpx(a) = 160 + ((x1 + difp) / z2 * 200)
rpx2(a) = 160 + ((x1 - difp) / z2 * 200)
rpy(a) = 100 - (y1 / z2 * 200)

END IF
NEXT a
    

FOR a = 1 TO nl
l1 = lin1(a)
l2 = lin2(a)
IF rpx(l1) = -1 OR rpx(l2) = -1 THEN
  ELSE
  LINE (rpx(l1), rpy(l1))-(rpx(l2), rpy(l2)), 1
END IF
NEXT

FOR a = 1 TO nl
l1 = lin1(a)
l2 = lin2(a)
IF rpx(l1) = -1 OR rpx(l2) = -1 THEN
  ELSE
  ling INT(rpx2(l1)), INT(rpy(l1)), INT(rpx2(l2)), INT(rpy(l2))
END IF
NEXT


END SUB

SUB start
SCREEN 7, , , 1

OUT &H3C8, 0
OUT &H3C9, 63
OUT &H3C9, 63
OUT &H3C9, 63


OUT &H3C8, 1
OUT &H3C9, 63
OUT &H3C9, 0
OUT &H3C9, 0

OUT &H3C8, 2
OUT &H3C9, 0
OUT &H3C9, 63
OUT &H3C9, 63

OUT &H3C8, 3
OUT &H3C9, 0
OUT &H3C9, 0
OUT &H3C9, 0


npo = 0
nlo = 0
np = npo
nl = nlo
kolm = 9

myx = 0
myy = 4
myz = 7
an1 = 3.14 / 2
an2 = an1 + .6

FOR a = 1 TO 1000
linc(a) = 4
NEXT a

FOR a = 1 TO 1000
olin1(a) = 1
olin2(a) = 1
NEXT a



END SUB