'$DYNAMIC
DEFINT A-Z
DECLARE SUB onedee (xyang!, zang!, xyrot!, zrot!, speed%, back%)
DECLARE SUB setmodex ()
DECLARE SUB setvispage (BYVAL page)
DECLARE SUB fadeto (palbuff(), BYVAL red, BYVAL green, BYVAL blue)
DECLARE SUB fadetopal (pal(), palbuff())
DECLARE SUB setpal (pal())
DECLARE SUB clearpage (BYVAL page)
DECLARE SUB setkeys ()
DECLARE SUB setfont (f())
DECLARE SUB printstr (s$, BYVAL x, BYVAL y, BYVAL p)
DECLARE SUB textcolor (BYVAL f, BYVAL b)
DECLARE SUB setitup (fil$, buff(), tbuff(), BYVAL p)
DECLARE SUB resetdsp
DECLARE SUB playsnd (BYVAL n, BYVAL f)
DECLARE SUB closefile
DECLARE SUB putpixel (BYVAL x, BYVAL y, BYVAL c, BYVAL p)
DECLARE SUB rectangle (BYVAL x, BYVAL y, BYVAL w, BYVAL h, BYVAL c, BYVAL p)
DECLARE SUB setwait (b(), BYVAL t)
DECLARE SUB dowait ()
DECLARE FUNCTION Keyseg ()
DECLARE FUNCTION keyoff ()
DECLARE FUNCTION keyval (BYVAL a)
DECLARE FUNCTION getkey ()
TYPE Regtype
 ax AS INTEGER
 bx AS INTEGER
 cx AS INTEGER
 dx AS INTEGER
 bp AS INTEGER
 si AS INTEGER
 di AS INTEGER
 flags AS INTEGER
 ds AS INTEGER
 es AS INTEGER
END TYPE
DIM SHARED regs AS Regtype
regs.ax = &H3509: CALL interruptx(&H21, regs, regs)
off9 = regs.bx: seg9 = regs.es
DIM font(1024), master(767), noise(16384), buffer(16384), fade(1536), timing(4)
RANDOMIZE TIMER
resetdsp
setitup "noise.cbv" + CHR$(0), noise(), buffer(), 2
setmodex
GOSUB switchon
DEF SEG = VARSEG(master(0)): BLOAD "master.pal", VARPTR(master(0)): setpal master()
DEF SEG = VARSEG(font(0)): BLOAD "one.fnt", VARPTR(font(0)): setfont font()
textcolor 15, 0

onedee 0, 1.57, .01, .01, 40, 1

finis:
fadeto fade(), 0, 0, 0
GOSUB shutoff
closefile
SCREEN 13: CLS : SCREEN 0: WIDTH 80: SYSTEM

switchon:
regs.ax = &H2509: regs.ds = Keyseg: regs.dx = keyoff
CALL interruptx(&H21, regs, regs)
RETURN

shutoff:
regs.ax = &H2509: regs.ds = seg9: regs.dx = off9
CALL interruptx(&H21, regs, regs)
RETURN

REM $STATIC
SUB onedee (xyang!, zang!, xyrot!, zrot!, speed, back)
DIM menu$(4), bx(5), bp(5), bc(5), ex(30), eo(30), el(30), ep(30), ed(30), es(30), et(30), st(30), sx(30), sp(30), sd(30), time(1), it(-10 TO 190), stime(4)
life = 30
shot = 1
vt = 1: vx = 4
stime(1) = 10: stime(2) = 18: stime(3) = 5: stime(4) = 25
menu$(1) = "Save Game": menu$(2) = "Load Game": menu$(3) = "Continue": menu$(4) = "Quit Game"
vpage = 0: dpage = 1
ux = 90
delay = 0
dir = 1
nspeed = speed
freq = 40
bonus = 2
textcolor 15, 0

setkeys
WHILE life > 0
setkeys
IF keyval(1) > 0 THEN GOSUB menu
IF keyval(59) > 1 THEN GOSUB save
IF keyval(60) > 1 THEN GOSUB load
speed = nspeed
IF speed > 0 THEN setwait time(), speed
hfac! = COS(zang!)
vfac! = SIN(zang!) * SIN(xyang!)
zfac! = SIN(zang!) * COS(xyang!)
IF keyval(2) > 1 THEN xyrot! = xyrot! + .002
IF keyval(3) > 1 THEN xyrot! = xyrot! - .002
IF keyval(4) > 1 THEN zrot! = zrot! + .002
IF keyval(5) > 1 THEN zrot! = zrot! - .002
IF keyval(13) > 1 OR keyval(78) > 1 THEN nspeed = speed - 5: IF nspeed < 0 THEN nspeed = 0
IF keyval(12) > 1 OR keyval(74) > 1 THEN nspeed = speed + 5: IF nspeed > 100 THEN nspeed = 100
IF keyval(59) > 1 THEN sgame = 1: GOSUB save
IF keyval(60) > 1 THEN sgame = 1: GOSUB load
xyang! = xyang! + xyrot!
zang! = zang! + zrot!
xstart = 160 - hfac! * 90
ystart = 110 - vfac! * 90
FOR i = 1 TO 180
it(i) = 0
NEXT i

shift = 0
IF keyval(72) > 1 THEN IF vt > 0 AND ABS(vx - ux) < 2 AND vehicle = 0 THEN vehicle = 1 ELSE vehicle = 0
IF keyval(75) > 0 THEN dir = -1: IF ux > 50 THEN ux = ux - 1 ELSE shift = 1
IF keyval(77) > 0 THEN dir = 1: IF ux < 130 THEN ux = ux + 1 ELSE shift = -1
'if keyval(
IF delay > 0 THEN delay = delay - 1
IF keyval(57) > 0 AND delay < 1 THEN
tmp = 0
DO
tmp = tmp + 1
LOOP UNTIL st(tmp) = 0 OR tmp = 31
IF tmp < 31 THEN
 IF shot = 5 THEN tmp2 = INT(RND(1) * 4) + 1 ELSE IF vehicle = 1 THEN tmp2 = 4 ELSE tmp2 = shot
 sp(tmp) = 0
 st(tmp) = tmp2: delay = stime(tmp2)
 sx(tmp) = ux + dir
 sd(tmp) = dir * 2
 END IF
END IF

'enemies
FOR i = 1 TO 30
IF et(i) > 0 THEN
ep(i) = ep(i) + es(i)
tmp = ed(i) * FIX(ep(i) / 4) + shift
eo(i) = ex(i)
ex(i) = ex(i) + tmp
IF eo(i) < ex(i) THEN tmp = eo(i): tmp2 = ex(i) ELSE tmp = ex(i): tmp2 = eo(i)
ep(i) = ep(i) AND 3
IF ux + vehicle >= tmp AND ux - vehicle <= tmp2 THEN et(i) = 0: life = life - 1 + vehicle
IF ex(i) > 180 OR ex(i) < 1 OR et(i) = 0 THEN et(i) = 0 ELSE it(ex(i)) = 13
END IF
NEXT i

'shots
FOR i = 1 TO 30
SELECT CASE st(i)
'normal gun
CASE 1
 tmp = sx(i)
 sx(i) = sx(i) + sd(i) + shift
 IF tmp < sx(i) THEN tmp2 = sx(i) ELSE tmp2 = tmp: tmp = sx(i)
 FOR j = 1 TO 30
 IF et(j) > 0 THEN
  IF ex(j) < eo(j) THEN tmp3 = ex(j): tmp4 = eo(j) ELSE tmp3 = eo(j): tmp4 = ex(j)
  IF tmp <= tmp4 AND tmp2 >= tmp3 THEN st(i) = 0: it(sx(i)) = 4: el(j) = el(j) - 1: IF el(j) < 1 THEN et(j) = 0: it(ex(j)) = 4: IF INT(RND(1) * bonus) = 0 AND bx(nextb) = 0 THEN bx(nextb) = ex(j)
 END IF
 NEXT j
 IF st(i) = 0 OR sx(i) > 180 OR sx(i) < 1 THEN st(i) = 0 ELSE it(sx(i)) = 11
'laser gun
CASE 2
 tmp = sx(i)
 sx(i) = sx(i) + sd(i) + shift
 IF tmp < sx(i) THEN tmp2 = sx(i) ELSE tmp2 = tmp: tmp = sx(i)
 IF st(i) = 0 OR sx(i) > 180 OR sx(i) < 1 THEN st(i) = 0 ELSE it(sx(i)) = 9: it(sx(i) + sd(i) / 2) = 9
 FOR j = 1 TO 30
 IF et(j) > 0 THEN
  IF ex(j) < eo(j) THEN tmp3 = ex(j): tmp4 = eo(j) ELSE tmp3 = eo(j): tmp4 = ex(j)
  IF tmp <= tmp4 AND tmp2 >= tmp3 THEN it(ex(j)) = 4: el(j) = el(j) - 1: IF el(j) < 1 THEN et(j) = 0: IF INT(RND(1) * bonus) = 0 AND bx(nextb) = 0 THEN bx(nextb) = ex(j)
 END IF
 NEXT j
'machine gun
CASE 3
 tmp = sx(i)
 sx(i) = sx(i) + sd(i) + shift
 sp(i) = sp(i) + 1: IF sp(i) > 20 THEN st(i) = 0
 IF tmp < sx(i) THEN tmp2 = sx(i) ELSE tmp2 = tmp: tmp = sx(i)
 FOR j = 1 TO 30
 IF et(j) > 0 THEN
  IF ex(j) < eo(j) THEN tmp3 = ex(j): tmp4 = eo(j) ELSE tmp3 = eo(j): tmp4 = ex(j)
  IF tmp <= tmp4 AND tmp2 >= tmp3 THEN st(i) = 0: it(sx(i)) = 4: el(j) = el(j) - INT(RND(1) + .8): IF el(j) < 1 THEN et(j) = 0: it(ex(j)) = 4: IF INT(RND(1) * bonus) = 0 AND bx(nextb) = 0 THEN bx(nextb) = ex(j)
 END IF
 NEXT j
 IF st(i) = 0 OR sx(i) > 180 OR sx(i) < 1 THEN st(i) = 0 ELSE it(sx(i)) = 11
'explosive gun
CASE 4
 sp(i) = sp(i) + 1: IF sp(i) = 40 THEN st(i) = 5: sp(i) = 0
 tmp = sx(i)
 sx(i) = sx(i) + sd(i) / 2 + shift
 IF tmp < sx(i) THEN tmp2 = sx(i) ELSE tmp2 = tmp: tmp = sx(i)
 IF st(i) = 0 OR sx(i) > 180 OR sx(i) < 1 THEN st(i) = 0 ELSE it(sx(i)) = 11
 FOR j = 1 TO 30
 IF et(j) > 0 THEN
  IF ex(j) < eo(j) THEN tmp3 = ex(j): tmp4 = eo(j) ELSE tmp3 = eo(j): tmp4 = ex(j)
  IF tmp <= tmp4 AND tmp2 >= tmp3 THEN st(i) = 5: sp(i) = 0: et(j) = 0: it(ex(j)) = 4: IF INT(RND(1) * bonus) = 0 AND bx(nextb) = 0 THEN bx(nextb) = ex(j)
 END IF
 NEXT j
'explosion
CASE 5
 sp(i) = sp(i) + 1
 tmp3 = 5 - ABS(sp(i) - 5)
 sx(i) = sx(i) + shift
 tmp = sx(i) - tmp3: tmp2 = sx(i) + tmp3
 IF tmp < 0 THEN tmp = 0
 IF tmp2 > 180 THEN tmp2 = 180
 FOR j = tmp TO tmp2: it(j) = 12: NEXT j
 IF ux >= tmp AND ux <= tmp2 THEN life = life - 1
 IF vt > 0 AND vx >= tmp AND vx <= tmp2 THEN vt = 0: vehicle = 0
 FOR j = 1 TO 30
 IF et(j) > 0 THEN
  IF ex(j) < eo(j) THEN tmp3 = ex(j): tmp4 = eo(j) ELSE tmp3 = eo(j): tmp4 = ex(j)
  IF tmp <= tmp4 AND tmp2 >= tmp3 THEN et(j) = 0: it(ex(j)) = 4: IF INT(RND(1) * bonus) = 0 AND bx(nextb) = 0 THEN bx(nextb) = ex(j)
 END IF
 NEXT j
 IF sp(i) = 10 THEN st(i) = 0
END SELECT
NEXT i

'bonus items
FOR i = 1 TO 5
IF bx(i) > 0 THEN
 bp(i) = bp(i) + 1
 bc(i) = bc(i) + INT(bp(i) / 8): IF bc(i) > 14 THEN bc(i) = 0
 bp(i) = bp(i) AND 7
 bx(i) = bx(i) + shift
 IF bx(i) = ux AND vehicle = 0 THEN
 SELECT CASE bc(i)
 CASE 0 TO 2, 13, 14
  IF shot = 2 THEN shot = 1 ELSE shot = 2
 CASE 3 TO 7
  IF shot = 3 THEN shot = 1 ELSE shot = 3
 CASE 8 TO 12
  life = life + 3 - ABS(bc(i) - 10)
  IF life > 200 THEN life = 200
 END SELECT
 bx(i) = 0
 END IF
 IF bx(i) > 0 AND bx(i) < 181 THEN it(bx(i)) = bc(i) + 160
ELSE nextb = i
END IF
NEXT i

'enemy spawner
IF INT(RND(1) * chance) = 0 THEN
chance = freq
tmp = 0
DO
tmp = tmp + 1
LOOP UNTIL et(tmp) = 0 OR tmp = 30
el(tmp) = INT(RND(1) * 3) + 2
et(tmp) = 1
es(tmp) = INT(RND(1) * 3) + 2
SELECT CASE shift
CASE 1
 ex(tmp) = 1
 ed(tmp) = 1
CASE -1
 ex(tmp) = 180
 ed(tmp) = -1
CASE ELSE
 tmp2 = INT(RND(1) * 2)
 IF tmp2 = 0 THEN ex(tmp) = 1: ed(tmp) = 1
 IF tmp2 = 1 THEN ex(tmp) = 180: ed(tmp) = -1
END SELECT
ELSE
chance = chance - 1
END IF

'you and vehicle
it(ux) = 14
IF vt > 0 THEN
 IF vehicle = 1 THEN vx = ux ELSE vx = vx + shift
 IF vx < 0 OR vx > 181 THEN vt = 0
 it(vx - 1) = 2: it(vx) = 2: it(vx + 1) = 2
ELSE
 IF shift <> 0 AND INT(RND(1) * 100) = 99 THEN vt = 1: vehicle = 0: vx = 90 - 89 * shift
END IF

'draw everything
clearpage dpage
x! = 0: y! = 0
IF back = 1 THEN
 FOR i = 1 TO 180
 putpixel xstart + x!, ystart + y!, 151.5 + zfac! * (i - 90) / 90 * 7.5, dpage
 x! = x! + hfac!: y! = y! + vfac!
 NEXT i
END IF
x! = 0: y! = 0
FOR i = 1 TO 180
IF it(i) > 0 THEN putpixel xstart + x!, ystart + y!, it(i), dpage
x! = x! + hfac!: y! = y! + vfac!
NEXT i
printstr "LIFE-", 0, 0, dpage
IF life > 0 THEN rectangle 40, 0, 40 + life, 8, 33, dpage
SWAP vpage, dpage
setvispage vpage
IF speed > 0 THEN dowait
WEND
GOTO done

save:
OPEN "lineal.sav" FOR BINARY AS #1
PUT #1, 1, life
PUT #1, 3, shot
PUT #1, 5, freq
PUT #1, 7, bonus
PUT #1, 9, ux
PUT #1, 11, vehicle
PUT #1, 13, vt
PUT #1, 15, vx
FOR i = 0 TO 30
PUT #1, 17 + 22 * i, ex(i)
PUT #1, 19 + 22 * i, eo(i)
PUT #1, 21 + 22 * i, el(i)
PUT #1, 23 + 22 * i, ep(i)
PUT #1, 25 + 22 * i, ed(i)
PUT #1, 27 + 22 * i, es(i)
PUT #1, 29 + 22 * i, et(i)
PUT #1, 31 + 22 * i, st(i)
PUT #1, 33 + 22 * i, sx(i)
PUT #1, 35 + 22 * i, sp(i)
PUT #1, 37 + 22 * i, sd(i)
NEXT i
FOR i = 0 TO 5
PUT #1, 683 + i * 6, bx(i)
PUT #1, 685 + i * 6, bp(i)
PUT #1, 687 + i * 6, bc(i)
NEXT i
CLOSE #1
RETURN

menu:
ptr = 1
resolve = 0
colorx! = 0
setkeys
WHILE resolve = 0
setkeys
setwait time(), speed
clearpage dpage
IF (keyval(28) > 1) OR (keyval(57) > 1) THEN resolve = 1
IF keyval(1) > 1 THEN resolve = 1: ptr = 4
IF keyval(72) > 1 AND ptr > 1 THEN ptr = ptr - 1
IF keyval(80) > 1 AND ptr < 4 THEN ptr = ptr + 1
IF colorx! < 6.28 THEN colorx! = colorx! + .08 ELSE colorx! = 0
IF colorx! < 3.14 THEN
 FOR i = 1 TO 4
 tmp = SIN(colorx!) * ((i - 2.5) * 3)
 tmp2 = COS(colorx!) * ((i - 2.5) * 10)
 IF ptr = i THEN textcolor 87.5 + tmp, 0 ELSE textcolor 151.5 + tmp, 0
 printstr menu$(i), 160 - LEN(menu$(i)) * 4, 100 + tmp2, dpage
 NEXT i
ELSE
 FOR i = 4 TO 1 STEP -1
 tmp = SIN(colorx!) * ((i - 2.5) * 3)
 tmp2 = COS(colorx!) * ((i - 2.5) * 10)
 IF ptr = i THEN textcolor 87.5 + tmp, 0 ELSE textcolor 151.5 + tmp, 0
 printstr menu$(i), 160 - LEN(menu$(i)) * 4, 100 + tmp2, dpage
 NEXT i
END IF
SWAP vpage, dpage
setvispage vpage
dowait
WEND
IF ptr = 1 THEN GOSUB save
IF ptr = 2 THEN GOSUB load
IF ptr = 4 THEN life = 0
RETURN

load:
OPEN "lineal.sav" FOR BINARY AS #1
GET #1, 1, life
GET #1, 3, shot
GET #1, 5, freq
GET #1, 7, bonus
GET #1, 9, ux
GET #1, 11, vehicle
GET #1, 13, vt
GET #1, 15, vx
FOR i = 0 TO 30
GET #1, 17 + 22 * i, ex(i)
GET #1, 19 + 22 * i, eo(i)
GET #1, 21 + 22 * i, el(i)
GET #1, 23 + 22 * i, ep(i)
GET #1, 25 + 22 * i, ed(i)
GET #1, 27 + 22 * i, es(i)
GET #1, 29 + 22 * i, et(i)
GET #1, 31 + 22 * i, st(i)
GET #1, 33 + 22 * i, sx(i)
GET #1, 35 + 22 * i, sp(i)
GET #1, 37 + 22 * i, sd(i)
NEXT i
FOR i = 0 TO 5
GET #1, 683 + i * 6, bx(i)
GET #1, 685 + i * 6, bp(i)
GET #1, 687 + i * 6, bc(i)
NEXT i
CLOSE #1
RETURN

done:
END SUB