' Ray casting engine, written by Svjatoslav Agejenko
' E-mail:   svjatoslav@svjatoslav.eu
' Homepage: svjatoslav.eu
' 2003.03

' Quality will be automatically adjusted,
' to keep constant framerate.

' at least P 200 MHz in DOS mode should be nice.

' keys to use:
' Arrow keys - move around
' 4, 6       - turn left, right
' 8, 2       - look up, down
' Enter      - Toggle full quality
' Space      - jump up (fly)
' ESC        - exit program

DECLARE SUB makeland ()
DECLARE FUNCTION getcol! (r!, g!, b!)
DEFINT A-Y
DECLARE SUB traceline (x%, y%, xl)
DECLARE SUB dispframe ()
DECLARE SUB tower (x%, y%)
DECLARE SUB square (x1%, y1%, x2%, y2%, c%, h%)
DECLARE SUB displand ()
DECLARE SUB start ()
DECLARE SUB setupal ()

DIM SHARED landh(0 TO 180, 0 TO 180)
DIM SHARED landc(0 TO 180, 0 TO 180)

DIM SHARED zmyx, zmyy, zmyz
DIM SHARED myx, myy, myz
DIM SHARED zmyan, myan2
DIM SHARED ste, stem, dist
DIM SHARED tim$, frm, frmrate

frmrate = 10    ' Desired framerate.
                ' Lower framerate, better quality

start
makeland

displand
a$ = INPUT$(1)
1
LOCATE 1, 35
PRINT frml

frm = frm + 1
IF tim$ <> TIME$ THEN
tim$ = TIME$
IF frm > frmrate THEN ste = ste - 1 ELSE ste = ste + 1
IF ste < 1 THEN ste = 1
stem = ste - 1
frml = frm
frm = 0
END IF

a$ = INKEY$
IF a$ <> "" THEN
SELECT CASE a$
CASE "4"
zmyan = zmyan + .1
CASE "6"
zmyan = zmyan - .1
CASE "8"
myan2 = myan2 + 5
CASE "2"
myan2 = myan2 - 5
CASE CHR$(0) + "H"      ' foward
zmyx = SIN(zmyan) * 3 + zmyx
zmyy = COS(zmyan) * 3 + zmyy
CASE CHR$(0) + "P"      ' backward
zmyx = -SIN(zmyan) * 3 + zmyx
zmyy = -COS(zmyan) * 3 + zmyy
CASE CHR$(0) + "K"      ' left
zmyx = COS(zmyan) * 3 + zmyx
zmyy = -SIN(zmyan) * 3 + zmyy
CASE CHR$(0) + "M"      ' left
zmyx = -COS(zmyan) * 3 + zmyx
zmyy = SIN(zmyan) * 3 + zmyy
CASE " "                ' jump
zmyzs = 2
CASE CHR$(13)           ' full quality
ste = 1
CASE CHR$(27)           ' exit
SYSTEM
END SELECT
END IF

IF zmyx > 170 THEN zmyx = 170
IF zmyy > 170 THEN zmyy = 170
IF zmyx < 10 THEN zmyx = 10
IF zmyy < 10 THEN zmyy = 10

zmyz = zmyz + zmyzs
zmyzs = zmyzs - .1
IF zmyz < landh(myx, myy) + 10 THEN zmyz = landh(myx, myy) + 10: zmyzs = (zmyzs / 2) + .2

myz = zmyz
myy = zmyy
myx = zmyx
dispframe
GOTO 1

SUB dispframe

l = 0
zst = -.0031 * ste
FOR z = .5 TO -.5 STEP zst
traceline SIN(zmyan + z) * dist + myx, COS(zmyan + z) * dist + myy, l
l = l + ste
NEXT z

END SUB

SUB displand


FOR z = 0 TO 180
zs = 1
IF z > 120 THEN zs = .7
IF z > 160 THEN zs = .6
FOR zx = 0 TO 180 STEP zs
y1 = landh(zx, z) - 80
zx1 = zx - 90
z1 = 300 - z
zx2 = zx1 / z1 * 190
zy2 = y1 / z1 * 190

LINE (zx2 + 160, 40 - zy2)-(zx2 + 160, 200), landc(zx, z)
NEXT zx
NEXT z

LOCATE 1, 1
PRINT "Press any key to continue..."

END SUB

DEFSNG A-Y
FUNCTION getcol (r, g, b)
IF r < 0 THEN r = 0
IF g < 0 THEN g = 0
IF b < 0 THEN b = 0
IF r > 255 THEN r = 255
IF g > 255 THEN g = 255
IF b > 255 THEN b = 255
getcol = INT(r / 43) * 36 + INT(g / 43) * 6 + INT(b / 43)
END FUNCTION

DEFINT A-Y
SUB makeland

square 0, 0, 180, 180, 15, 0

FOR y = 0 TO 180
FOR x = 0 TO 180
x1 = (x \ 10) MOD 2
y1 = (y \ 10) MOD 2
c = (x1 + y1) MOD 2
IF c = 0 THEN
  landc(x, y) = getcol(0, 0, 250)
ELSE
  landc(x, y) = getcol(50, 50, 50)
END IF
NEXT x
NEXT y

FOR y = 10 TO 90
FOR x = 90 TO 170
v = SQR((ABS(50 - y)) ^ 2 + (ABS(130 - x)) ^ 2)
h = SQR((60 - v) * (60 + v)) - 35
IF h > 0 THEN landh(x, y) = h
NEXT x
NEXT y

tower 20, 20
tower 60, 20
tower 40, 60

FOR y = 100 TO 150
FOR x = 0 TO 50
landc(x, y) = getcol(SIN((x + y) / 2) * 125 + 125, SIN(x / 2) * 125 + 125, SIN(y / 2) * 125 + 125)
landh(x, y) = 50 - x
NEXT x
NEXT y

FOR za = 0 TO 20 STEP .1
x = SIN(za) * (1 + (za * 2)) + 100
y = COS(za) * (1 + (za * 2)) + 100
landc(x, y) = 200
landc(x + 1, y) = 200
landc(x, y + 1) = 200
landc(x + 1, y + 1) = 200
NEXT za

END SUB

SUB setupal
c = 0
FOR r = 0 TO 5
FOR g = 0 TO 5
FOR b = 0 TO 5
OUT &H3C8, c
c = c + 1
OUT &H3C9, r * 12
OUT &H3C9, g * 12
OUT &H3C9, b * 12
NEXT b
NEXT g
NEXT r
END SUB

SUB square (x1, y1, x2, y2, c, h)

FOR y = y1 TO y2
FOR x = x1 TO x2
landh(x, y) = h
landc(x, y) = c
NEXT x
NEXT y

END SUB

SUB start
SCREEN 13
PRINT "please wait..."

setupal

zmyan = 4.14
myan2 = 100
ste = 1
stem = ste - 1
dist = 190
tim$ = TIME$
zmyx = 170
zmyy = 170
zmyz = 20

END SUB

SUB tower (x, y)

FOR a = 10 TO 0 STEP -1
square x - a, y - a, x + a, y + a, getcol(100, 0, a * 20), 20 - a
NEXT a

square x - 11, y - 11, x - 9, y - 9, getcol(255, 0, 0), 20
square x + 9, y - 11, x + 11, y - 9, getcol(0, 255, 0), 20
square x - 11, y + 9, x - 9, y + 11, getcol(0, 0, 255), 20
square x + 9, y + 9, x + 11, y + 11, getcol(255, 255, 0), 20


END SUB

SUB traceline (x, y, xl%)

IF x < 0 THEN
zpr = myx / (myx - x)
x = 0
y = myy - ((myy - y) * zpr)
END IF

IF y < 0 THEN
zpr = myy / (myy - y)
y = 0
x = myx - ((myx - x) * zpr)
END IF

IF x > 180 THEN
zpr = (180 - myx) / (x - myx)
x = 180
y = myy - ((myy - y) * zpr)
END IF

IF y > 180 THEN
zpr = (180 - myy) / (y - myy)
y = 180
x = myx - ((myx - x) * zpr)
END IF

lp = SQR(ABS(myx - x) ^ 2 + ABS(myy - y) ^ 2)

imyx% = myx
imyy% = myy
imyz% = myz
xp% = x - imyx%
yp% = y - imyy%
istem% = stem
imyan2% = myan2

yo% = 200
FOR a% = 1 TO lp%
  cx% = xp% * a% / lp% + imyx%
  cy% = yp% * a% / lp% + imyy%
  yn% = imyan2% - ((landh(cx%, cy%) - imyz%) / a%) * 300
  IF yn% < yo% THEN
    LINE (xl%, yn%)-(xl% + istem%, yo% - 1), landc(cx%, cy%), BF
    yo% = yn%
  END IF
NEXT a
LINE (xl%, yo% - 1)-(xl% + istem%, 0), 0, BF

END SUB