DECLARE SUB dispimg ()
DECLARE SUB updateland ()
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
DIM SHARED pi
DIM SHARED white

sky = getcol(100, 100, 255)
pi = 3.141592

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

start
makeland

'displand
'a$ = INPUT$(1)
myan2 = 2
OPEN "cat.i01" FOR INPUT AS #1
INPUT #1, pictxw
INPUT #1, pictyw
INPUT #1, pictx
INPUT #1, picty


1
x1 = RND * 160
y1 = RND * 160
x2 = x1 + RND * 10 + 1
y2 = y1 + RND * 10 + 1

IF (frm > 50) AND (frm < 250) THEN square x1, y1, x2, y2, RND * 200, RND * 10
IF (frm > 250) AND (picty < 177) THEN
 
  FOR ff = 1 TO 180 * 2
    INPUT #1, c
    landc(pictx, picty) = c
    landh(pictx, picty) = 0
    pictx = pictx + 1
    IF pictx >= pictxw THEN pictx = 0: picty = picty + 1
    IF picty >= pictyw THEN picty = 0
  NEXT ff
END IF

IF frm = 430 THEN dispimg
LOCATE 1, 30
'PRINT frm

updateland
dispframe
GOTO 1
CLOSE #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 dispimg

CLOSE #1


OPEN "cat.i01" FOR INPUT AS #1
INPUT #1, pictxw
INPUT #1, pictyw

FOR y = 0 TO pictyw - 1
FOR x = 0 TO pictxw - 1
INPUT #1, c
PSET (x + 50, 150 - y), c
NEXT x
NEXT y

CLOSE #1


FOR a = 1 TO 50
  SOUND 0, 1
NEXT a
CHAIN "KHKDEMO2.BAS"

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(250, 250, 250)
ELSE
  landc(x, y) = getcol(250, 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, 150


FOR za = 0 TO 20 STEP .1
x = SIN(za) * (1 + (za * 2)) + 100
y = COS(za) * (1 + (za * 2)) + 100
landc(x, y) = getcol(20, RND * 200, 20)
landc(x + 1, y) = getcol(20, RND * 200, 20)
landc(x, y + 1) = getcol(20, RND * 200, 20)
landc(x + 1, y + 1) = getcol(20, RND * 200, 20)
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)

xp = x - myx
yp = y - myy

yo = 200

FOR a = 1 TO lp
  cx = xp * a / lp + myx
  cy = yp * a / lp + myy
  yn = myan2 - ((landh(cx, cy) - myz) * 300) / a
  IF yn < yo THEN LINE (xl, yn)-(xl + stem, yo - 1), landc(cx, cy), BF: yo = yn
NEXT a
LINE (xl, yo - 1)-(xl + stem, 0), sky, BF

END SUB

SUB updateland

frm = frm + 1
ste = 4
stem = ste - 1


zmyan = frm / 15 + pi
'myan2 = myan2 + 5
'zmyx = SIN(zmyan) * 3 + zmyx
'zmyy = COS(zmyan) * 3 + zmyy
'zmyzs = 2

zmyx = 90 - SIN(zmyan) * 91
zmyy = 90 - COS(zmyan) * 91

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 = SIN(zmyan / 2) * 4 + 4
zmyz = SIN(zmyan / 2) * 50 + 50
myan2 = -SIN(zmyan / 2) * 120 + 121
myan2 = -(SIN(zmyan / 2) * 10 + 10)
IF zmyz < landh(myx, myy) + 10 THEN zmyz = landh(myx, myy) + 10: zmyzs = (zmyzs / 2) + .2

myz = zmyz
myy = zmyy
myx = zmyx

END SUB