program GAME ; uses Crt, Dos ;

type
Scrp = ^Scrn ;
Scrn = array [0..24, 0..79] of word { 80*25 } ;

var
Xdos, Save : Scrn ;
Regs : registers ;
Disp : Scrp ;
WhatFor : string [9] ;
TA : byte ;
Ben : char ;
Slug : word ; Time : longint ;
Clok : longint absolute 0:$046C ;

const Rate : word = 45 ;


procedure DoIt ;

type
Dir = (L, R) ;
Sseg = record sx, sy : byte ; sd : Dir ; sac : word end ;
Octo = record OcDel : word ; ox, oy : byte ; on : boolean end ;

const
Smax = 8 ; Slen = 10 ; SlowMax = 20 ;
MT = $20 ; Head = byte(^A) ; Tail = byte('-') ;
Mine = $06CE {Î} ; Miss = $0C18 ; Bomb = $0C09 ; Dart = $0419 ;
BgCo = $0700 ; SbCo = $0E00 ; SnCo = $0A00 ;
OcCo = $0900 ; Flash = Blink shl 8 ; Splat = BgCo+Flash+$0F ;
Snew : Sseg = (sx:1; sy:2; sd:R; sac:SnCo+Ord('=')) ;
Rev : array [Dir] of Dir = (R, L) ;
Tri : array [Dir] of char = (#16, #17) ;
By : array [Dir] of shortint = (-1, +1) ;
Sub : array [-1..+1] of char = ('Í', 'Ï', 'Í') ;

var
Score : longint ;
Slow, Wait : word ;
Ch : char ;
s, ss, x, xsx, y, SnNo, Xsub, Ysub, Dest, ArrX, ArrY : byte ;
j : shortint ;
Sss : array [1..Smax, 1..Slen] of Sseg ;
Sl : array [1..Smax] of byte ;
Arrow : array [2..23] of byte ;
Bombs : array [2..24] of byte ;
Darts : array [2..24] of byte ;
SubSet : set of char ;
OcPs : Octo ;
No : byte ;
Diff, KKK : longint ;


procedure PutSub ; var k : shortint ;
begin for k := -1 to 1 do Disp^[Ysub, Xsub+k] := SbCo+Ord(Sub[k]) end ;

procedure Why(S : string; D : boolean ; x, y : byte) ;
begin WhatFor := S ; PutSub ;
  if D then Disp^[y, x] := Disp^[y, x] or Flash end {Why} ;

procedure NuSnk ;
var k : byte ;
begin Inc(SnNo) ;
  for k := 1 to Slen do begin Sss[SnNo, k] := Snew ; Sss[SnNo, k].sx := k end ;
  Sss[SnNo, 1].sac := SnCo+Tail ;
  Sss[SnNo, Slen].sac := SnCo+Head ;
  Sl[SnNo] := Slen ; Wait := $FFFF end ;

procedure NuOc ;
begin with OcPs do begin if OcDel>5 then Dec(OcDel, (OcDel shr 4)+1) ;
    ox := 5 + 70*random(2) ; oy := 23 end ;
  end ;

procedure IsItAHit(var ThingY : byte ; Note, What, F1, F2, F3 : word ) ;
var s, ss, x : byte ;
begin
  for s := 1 to Smax do for ss := 1 to Sl[s] do
    with Sss[s, ss] do begin
    if (sy=ArrY) and (sx=ThingY) and (Lo(sac)<>MT) then begin
      Sound(Note) ; Inc(Score, 6) ;
      if Lo(sac)=Head then Inc(Score, 3) ;
      Dec(Sl[s]) ;
      for x := ss to Sl[s] do Sss[s, x] := Sss[s, x+1] ;
      Disp^[ArrY, ArrX] := BgCo+Ord('') ;
      Delay(40) ; NoSound end {with} ;
    end {s} ;
  if Lo(Disp^[ArrY, ArrX])=MT then Disp^[ArrY, ArrX] := What else
    begin Sound(F1) ; Delay(5) ;
    with OcPs do if (ox=ArrX) and (oy=ArrY) then begin
      Sound(F2) ; Delay(20) ; Sound(F3) ; Delay(30) ;
      Inc(Score, 10) ; NuOc end ;
    if Disp^[ArrY, ArrX]=Bomb then begin
      Sound(1500) ; Bombs[ArrY] := 0 ; Delay(50) end ;
    Disp^[ArrY, ArrX] := MT ; ThingY := 0 ;
    NoSound end {<>MT} ;
  end { IsItAHit } ;

begin
  SubSet := [Sub[-1], Sub[0], Sub[+1]] ;
  Score := 0 ; Slow := SlowMax ; SnNo := 0 ; Xsub := 40 ; Ysub := 24 ;
  for y := 2 to 23 do Arrow[y] := 0 ;
  for y := 2 to 24 do Bombs[y] := 0 ;
  for y := 2 to 24 do Darts[y] := 0 ;
  for s := 1 to Smax do Sl[s] := 0 ;
  NuSnk ; OcPs.OcDel := 81 ; NuOc ;

  for y := 2 to 23 do for x := 2 to 77 do
    if Random(35)=0 then Disp^[y, x] := BgCo+Ord('*') ;
  for y := 2 to 24 do begin
    Disp^[y,  0] := BgCo+Ord('>') ; Disp^[y,  1] := MT ;
    Disp^[y, 79] := BgCo+Ord('<') ; Disp^[y, 78] := MT end ;
  Why('?', false, 0, 0) ;

  GotoXY(40, 2) ; ClrEol ; Write(' Want ', Rate, ', Slug ', Slug) ;
  Time := Clok ; KKK := 0 ; Diff := 0 ;
  repeat
    GotoXY(2, 2) ;
    Write('Score', Score:5, '; Slow', Slow:3,
      '; SnNo ', SnNo, '/', Smax, ', Oc ', OcPs.OcDel:2) ;

    if Arrow[2]>0 then Disp^[2, Arrow[2]] := MT ;
    for ArrY := 2 to 22 do begin
      ArrX := Arrow[ArrY+1] ; Arrow[ArrY] := ArrX ;
      if ArrX>0 then begin
        Disp^[ArrY+1, ArrX] := MT ;
        if ArrY>0 then IsItAHit(Arrow[ArrY], 1000, Miss, 2500, 600, 300) ;
        end {ArrX>0} ;
      end {ArrY} ;
    Arrow[23] := 0 ;

    if Odd(No) then
      for ArrY := 25 downto 3 do begin
      if Odd(No shr 1) then begin
        ArrX := Bombs[ArrY-1] ; if ArrY<25 then Bombs[ArrY] := ArrX ;
        if ArrX>0 then begin
          if (ArrY=YSub) and (Abs(ArrX-XSub)<=1) then begin
            Why('Pop', true, ArrX, ArrY) ; EXIT end ;
          Disp^[ArrY-1, ArrX] := MT ;
          if ArrY<25 then IsItAHit(Bombs[ArrY], 500, Bomb, 1500, 300, 600) ;
          end {ArrX>0} ;
        end {¬} ;
      ArrX := Darts[ArrY-1] ; if ArrY<25 then Darts[ArrY] := ArrX ;
      if ArrX>0 then begin
        if ArrY>3 then Disp^[ArrY-1, ArrX] := MT ;
        if ArrY<25 then IsItAHit(Darts[ArrY], 500, Dart, 1500, 300, 600) ;
        end {ArrX>0} ;
      end {ArrY} ;
    Bombs[2] := 0 ; Darts[2] := 0 ;

    if Random(90)=9 then Bombs[2] := 3 + Random(75) ;

    if KeyPressed then begin
      for j := -1 to 1 do Disp^[Ysub, Xsub+j] := MT ;
      Ch := ReadKey ; if Ch=#27 then begin Why('ESC', false, 0, 0) ; EXIT end ;
      if Ch=#0 then Ch := ReadKey ;
      case Ch of
        #35 {#} : begin GotoXY(69, 2) ; Readln(Rate) ;
          KKK := 0 ; Time := Clok end ;
        #52,#75 : if Xsub>2  then Dec(Xsub) ;
        #54,#77 : if Xsub<77 then Inc(Xsub) ;
        #56,#72 : if Ysub>2  then Dec(Ysub) ;
        #50,#80 : if Ysub<24 then Inc(Ysub) ;
        #51,#81 : if Ysub<24 then begin Dec(Score, 2) ;
          if (Ysub<24) and (Lo(Disp^[Ysub+1, Xsub])<>MT) then
            begin Disp^[Ysub+1, Xsub] := Splat ;
            Why('hit', true, Xsub, Ysub+1) ; EXIT end ;
          Darts[Ysub+1] := Xsub ; Disp^[Ysub+1, Xsub] := Dart end ;
        #57,#73 : begin Dec(Score, 1) ;
          if Ysub>2 then begin
            if Lo(Disp^[Ysub-1, Xsub])<>MT then
              begin  Disp^[Ysub-1, Xsub] := Splat ;
              Why('HIT', true, Xsub, Ysub-1) ; EXIT end ;
            Arrow[Ysub-1] := Xsub ; Disp^[Ysub-1, Xsub] := Miss end ;
          end ;
        #48,#82 : begin Dec(Score, 10) ;
          if Ysub<24 then begin
            if (Lo(Disp^[Ysub+1, Xsub])<>MT) then
              begin  Disp^[Ysub+1, Xsub] := Splat ;
              Why('Hit', true, Xsub, Ysub+1) ; EXIT end ;
            Disp^[Ysub+1, Xsub] := Mine end ;
          end ;
        #53,#13 : begin Save := Disp^ ; TA := TextAttr ;
          TextAttr := $70 ; Window(16, 4, 64, 16) ; ClrScr ; Writeln ;
          Writeln('  Use the digit keys as controls (see keypad) :') ;
          Writeln('  2, 4, 6, 8 to move sub Down, Left, Right, Up;') ;
          Writeln('  9 to fire a missile; 3 to drop a depthcharge;') ;
          Writeln('  0 to lay a mine; 5 for help; use Esc to quit.') ;
          Writeln('  The corresponding cursor-pad keys do as well.') ;
          Writeln ;
          Writeln('  # then enter a number to rate it for LCD use.') ;
          Writeln ;
          Writeln('  Fatal to emit a weapon into a non-empty spot.') ;
          Writeln ;
          Write  ('  Press an Enter key to continue with the game.') ; Readln ;
          Window(1, 1, 80, 25) ; TextAttr := TA ; Disp^ := Save end ;
        end {case} ;
      for j := -1 to 1 do if Lo(Disp^[Ysub, Xsub+j])<>MT then begin
        Disp^[Ysub, Xsub+j] := Splat ;
        Why('NAV', true, Xsub+j, Ysub) ; EXIT end ;
      end {KP} ;

    PutSub ;

    for s := 1 to Smax do for ss := Sl[s] downto 1 do with Sss[s, ss] do begin
      xsx := sx ; Inc(sx, By[sd]) ;
      Dest := Lo(Disp^[sy, sx]) ;
      if (char(Dest) in SubSet) and (Lo(sac)<>MT) then
        begin Disp^[sy, sx] := Splat ;
        Why('EAT', true, sx, sy) ; EXIT end
      else begin
        Disp^[sy, xsx] := MT ;
        if Dest<>MT then begin Sound(3000) ; sx := xsx ; NoSound ;
          Inc(sy) ; sd := Rev[sd] ;
          (* if (ss=1) and (Lo(SSS[s, ss].sac)<>MT) then
            SSS[s, ss].sac := SnCo+byte(Tri[sd]) ; *)
          end ;
        if sy>24 then begin sy := 2 ; Wait := $FFFF ;
          if (Lo(sac)=Head) and (Slow>0) then begin
            if Slow=SlowMax then begin GotoXY(40, 2) ; ClrEol end ;
            Dec(Slow) end ;
          end ;
        Disp^[sy, sx] := sac end ;
      end {with} ;

    with OcPs do begin Disp^[oy, ox] := MT ;
      if on then begin j := Random(OcDel) ;
        if j<4 then begin
          if j<2 then begin
            if (ox>xsub) and (Lo(Disp^[oy, ox-1])=MT) then Dec(ox) ;
            if (ox<xsub) and (Lo(Disp^[oy, ox+1])=MT) then Inc(ox) end ;
          if Odd(j) then begin
            if (oy>ysub) and (Lo(Disp^[oy-1, ox])=MT) then Dec(oy) ;
            if (oy<ysub) and (Lo(Disp^[oy+1, ox])=MT) then Inc(oy) end ;
          if ( (oy=ysub) and ( (ox=xsub+2) or (ox=xsub-2) ) )
            or ( (oy<=ysub+1) and (oy>=ysub-1) and (ox<xsub+2) and (ox>xsub-2) )
            then begin Disp^[oy, ox] := Splat ;
            Why('Oct', true, ox, oy) ; EXIT end ;
          end ;
        Disp^[oy, ox] := OcCo+Ord('+') ;
        end else begin Disp^[oy, ox] := OcCo+Ord('#') end ;
      on := not on end ;

    Delay(Slow*Slug) ; Wait := Wait shr 1 ; Inc(No) ;
    if (Wait=0) and (Random(400)=0) and (SnNo<Smax) then NuSnk ;

    if Slow=SlowMax then begin Inc(KKK) ;
      if (KKK and $3F)=0 then begin Sound(2222) ;
        Diff := Clok-Time ; Time := Clok ;
        Slug := Round(Slug*Rate/Diff) ; if Slug=0 then Slug := 1 ;
        GotoXY(40, 2) ; ClrEol ;
        Write(' Want ', Rate, ', got ', Diff, '; => Slug ', Slug) ;
        Delay(10) ; NoSound end ;
      end {Slow=SlowMax} ;
    until false ;
  end {DoIt} ;


BEGIN ;
if LastMode=Mono then Disp := {mono} Ptr($B000, 0)
  else Disp := {colo} Ptr($B800, 0) ;
Regs.AX := $0F00 ; Intr($10, Regs) {Get video parameters, BH:=page} ;
Regs.AX := $0300 ; Intr($10, Regs) {Get cursor} ;
Xdos := Disp^ ; TA := TextAttr ;
Slug := 1 ;

repeat
  while KeyPressed do Ben := ReadKey ;
  TextAttr := { $03 } Cyan ; ClrScr ;
  Write(' Game - ESC to quit [mode ', LastMode, ', page ', Regs.BH, ']') ;
  GotoXY(40, 1) ; Write(' Keys: 5=?, Numbers 0234689 as controls') ;
  DoIt ;
  GotoXY(40, 2) ; ClrEol ; Write(' Reason: ', WhatFor) ;
  NoSound ; Sound(444) ; Delay(1000) ; NoSound ;
  GotoXY(53, 2) ; Write('ANY to run') ;
  Delay(3000) until ReadKey=#27 ;

while KeyPressed do Ben := ReadKey ;
TextAttr := TA ; Disp^ := Xdos ;
Regs.AH := $02 ; Intr($10, Regs) {Set cursor Pos} ;
END.