uses
  CRT;

const
  Delay = 1;
  MSpeed = 0.4;
  MCount = 4;
  LabDiffculty = 1500;
  PauseAfterLost = False;

  Dx: array [0 .. 4] of integer = (1, -1, 0, 0, 0);
  Dy: array [0 .. 4] of integer = (0, 0, 1, -1, 0);

  Colors : array [0 .. 3] of byte = (6, 7, 8, 15);

type
  TSymbol = record
    C: char;
    A: byte;
  end;

  TBuffer = array [0 .. 49, 0 .. 79] of TSymbol;

  TItem = record
    Group, Count, Value: integer;
  end;

  TMonster = record
    X, Y: integer;
    Color: byte;
    TargetX, TargetY: integer;
    GoAway: byte;
  end;

  TField = record
    Items: array [1 .. 49, 0 .. 78] of TItem;
    Monsters: array [0 .. MCount - 1] of TMonster;
  end;

var
  Screen: TBuffer absolute $B000: $8000;
  Time: longint absolute $0040: $006C;
  T: longint;
  Buffer: ^TBuffer;
  F: TField;
  Mx, My: integer;
  MButtons: byte;
  GT: longint;
  MT: extended;
  K, SK: char;
  Points: integer;

procedure GetMXY; assembler;
asm mov ax, $03; int $33; mov Mx, cx; mov My, dx; mov MButtons, bl end;

procedure Show;
var
  i, j, k: integer;
  r: longint;
label Cont;
begin
  r := randseed;
  randseed := 123;
  for i := 0 to MCount - 1 do with F.Monsters[i] do with Screen[Y, X] do begin
    if (i = 0) and (SK = #0) then with Screen[TargetY, TargetX] do begin
      C := #$A;
      A := 14;
    end;
    A := Color;
    C := #1;
  end;
  for j := 1 to 49 do
    for i := 0 to 78 do with F.Items[j, i] do begin
      if (i = Mx) and (j = My) then goto Cont;
      for k := 0 to MCount - 1 do with F.Monsters[k] do begin
        if (i = X) and (j = Y) then goto Cont;
        if (i = TargetX) and (j = TargetY) and (k = 0) then goto Cont;
      end;
      Screen[j, i].A := Colors[Group mod SizeOf(Colors)];
      case Value of
        1: Screen[j, i].C := #$B2;
        2: Screen[j, i].C := #$B0;
        else begin
	  case Count of
	    0: Screen[j, i].C := ' ';
            1: Screen[j, i].C := #$FA;
          end;
	  Screen[j, i].A := 6;
        end;
      end;
      continue;
      Cont:
      if Value = 1 then k := random(2);
    end;
  randseed := r;
end;

procedure Generate(N: integer);
var
  i, j, k, l, x1, y1, x2, y2, x3, y3, og, ng: integer;
  nc: word;
  NewTree: boolean;
  d: byte;
  g, dg: array [0 .. 7] of integer;
const
  rdx: array [0 .. 9] of integer = (0, 1, 1, 1, 0, -1, -1, -1, 0, 1);
  rdy: array [0 .. 9] of integer = (-1, -1, 0, 1, 1, 1, 0, -1, -1, -1);
begin
  for j := 1 to 49 do
    for i := 0 to 78 do with F.Items[j, i] do begin
      if (i = 0) or (i = 78) or (j = 1) or (j = 49) then begin
        Group := 0;
        Value := 2;
      end else begin
        Group := i shr 1 + j shl 6;
        Value := 0;
      end;
      Count := 1;
    end;

  for k := 0 to N-1 do begin
    if random(2) = 0 then begin
      x1 := random(77) and not 1;
      y1 := random(45) and not 1 + 3;
      x2 := x1 + 1;
      y2 := y1;
      x3 := x1 + 2;
      y3 := y1;
      d := 2;
    end else begin
      x1 := random(75) and not 1 + 2;
      y1 := random(47) and not 1 + 1;
      x2 := x1;
      y2 := y1 + 1;
      x3 := x1;
      y3 := y1 + 2;
      d := 0;
    end;
    with F do begin
      ng := Items[y1, x1].Group;
      og := Items[y3, x3].Group;
      if ((ng = Items[y3+dy[d] shl 1, x3+dx[d] shl 1].Group)
      or (ng = Items[y3-dy[d] shl 1, x3-dx[d] shl 1].Group)
      or (og = Items[y1+dy[d] shl 1, x1+dx[d] shl 1].Group)
      or (og = Items[y1-dy[d] shl 1, x1-dx[d] shl 1].Group)
      or ((og = Items[y3+dy[d] shl 1, x3+dx[d] shl 1].Group)
      and (ng = Items[y1+dy[d] shl 1, x1+dx[d] shl 1].Group))
      or ((og = Items[y3-dy[d] shl 1, x3-dx[d] shl 1].Group)
      and (ng = Items[y1-dy[d] shl 1, x1-dx[d] shl 1].Group)))
      and (random(1) = 0)
      then og := ng;
    end;
    if og = 0 then begin
      nc := og; og := ng; ng := nc;
    end;
    nc := F.Items[y1, x1].Count + F.Items[y3, x3].Count + 1;
    if (og <> ng)
    then begin
      F.Items[y1, x1].Value := 1;
      F.Items[y2, x2].Value := 1;
      F.Items[y2, x2].Group := ng;
      F.Items[y3, x3].Value := 1;
      NewTree := (x1 = 0) or (y1 = 1) or (x3 = 78) or (y3 = 49);
      for j := 1 to 49 do
        for i := 0 to 78 do with F.Items[j, i] do begin
          if Group = og then begin
	    Group := ng;
          end;
          if (ng <> 0) and (Group = ng) then Count := nc;
        end;
    end;      {

    x1 := random(77) + 1;
    y1 := random(47) + 2;
    if (x1=1) and (y1=2) then Continue;
    if (x1=77) and (y1=48) then Continue;
    for i := 0 to 7 do with F.Items[y1+rdy[i], x1+rdx[i]] do begin
      if Value = 0 then g[i] := -1
      else g[i] := Group;
    end;
    j := 0;
    for i := 0 to 7 do begin
      if (i = 0) or (g[i] <> g[i - 1]) then begin
        dg[j] := g[i];
        inc(j);
      end;
    end;
    if g[7] = g[0] then dec(j);
    NewTree := True;
    for i := 0 to j - 1 do
      for l := 0 to i - 1 do begin
        if (dg[i] = dg[l])
        and (dg[i] <> -1)
        and (dg[l] <> -1) then NewTree := False;
      end;

    if NewTree then begin
      F.Items[y1, x1].Value := 1;
      for j := 1 to 49 do
        for i := 0 to 78 do with F.Items[j, i] do begin
          for l := 0 to 7 do if Group = g[l] then
	    Group := F.Items[y1, x1].Group;
        end;
      Show;
    end;     }
  end;
  for j := 1 to 49 do
    for i := 0 to 78 do with F.Items[j, i] do begin
      if Value = 0 then Count := 1;
    end;
  with F do begin
    with Monsters[0] do begin
      X := 1;
      Y := 2;
      Color := 14;
      TargetX := X;
      TargetY := Y;
    end;
    for i := 1 to MCount - 1 do with Monsters[i] do begin
      X := 77;
      Y := 48;
      Color := 9;
    end;
  end;
end;

function FastestDir(x1, y1, x2, y2: integer; A: byte): byte;
var
  j, i, k, T: integer;
  x, y: integer;
  d: array [0 .. 3] of byte;

  B, E: word;
  Turns: array [0 .. $0FFF] of integer;

procedure Push(i: integer);
begin
  Inc(E);
  E := E and $0FFF;
  Turns[E] := i;
end;

procedure Pop(var i: integer);
begin
  Inc(B);
  B := B and $0FFF;
  i := Turns[B];
end;

begin              {
  if A = 1 then begin
    x2 := 77;
    y2 := 48;
  end;             }
  for i := 0 to 3 do d[i] := i;
  for i := 3 downto 1 do begin
    j := random(i+1);
    k := d[i]; d[i] := d[j]; d[j] := k;
  end;
  for T := 0 to 3 do begin
    for j := 1 to 49 do
      for i := 0 to 78 do
        with F.Items[j, i] do
          if (Value <> 1) and (Value <> 2) then Value := 0;
    if (T < 3) or (A = 1) then for i := 1 to MCount - 1 do with F do with Monsters[i] do begin
      Items[Y, X].Value := 3;
      if (T < 2) and (A = 1) then for j := 0 to 3 do
        if not (Items[Y+dy[j], X+dx[j]].Value in [1, 2]) then
          Items[Y+dy[j], X+dx[j]].Value := 3;
    end;
    F.Items[y2, x2].Value := 3;
    F.Items[y1, x1].Value := -1;
    E := 0;
    B := 0;
    Push(x2);
    Push(y2);
    while B <> E do begin
      Pop(x);
      Pop(y);
      for i := 0 to 3 do with F.Items[y+dy[d[i]], x+dx[d[i]]] do if Value <= 0 then begin
        if Value = -1 then begin
          FastestDir := d[i] xor 1;
          Exit;
        end;
        Value := 3;
        Push(x+dx[d[i]]);
        Push(y+dy[d[i]]);
      end;
    end;

    if A = 1 then begin    {if m0 cant find way to target}

      for j := 1 to 49 do       {init field}
        for i := 0 to 78 do
          with F.Items[j, i] do
            if (Value <> 1) and (Value <> 2) then Value := 3;
      for i := 1 to MCount - 1 do with F do with Monsters[i] do begin
        Items[Y, X].Value := 0;
        for j := 0 to 3 do
          if not (Items[Y+dy[j], X+dx[j]].Value in [1, 2]) then
            Items[Y+dy[j], X+dx[j]].Value := 3;
      end;

      E := 0;                   {find zone without m}
      B := 0;
      Push(x1);
      Push(y1);
      while B <> E do begin
        Pop(x);
        Pop(y);
        for i := 0 to 3 do with F.Items[y+dy[d[i]], x+dx[d[i]]] do if Value = 3 then begin
          Value := 0;
          Push(x+dx[d[i]]);
          Push(y+dy[d[i]]);
        end;
      end;
                                 {find point}
      E := 0;
      B := 0;
      for i := 1 to MCount - 1 do with F do with Monsters[i] do begin
        Push(x);
        Push(y);
      end;
      while B <> E do begin
        Pop(x);
        Pop(y);
        for i := 0 to 3 do with F.Items[y+dy[d[i]], x+dx[d[i]]] do if Value <= 0 then begin
          Value := 3;
          Push(x+dx[d[i]]);
          Push(y+dy[d[i]]);
        end;
      end;
      x2 := x;
      y2 := y;
    end;
  end;
  FastestDir := 4;
end;

procedure Move(var M: TMonster);
var
  d: byte;
begin
  with M do begin
    if (X = TargetX) and (Y = TargetY) then begin
      GoAway := 0;
    end else begin
      d := FastestDir(X, Y, TargetX, TargetY, byte(@M = @F.Monsters[0]));
      Inc(x, dx[d]);
      Inc(y, dy[d]);
    end;
  end;
end;

procedure Play;
var
  Lost: boolean;
  i, j: integer;
  rx, ry: integer;
  d: byte;
  OSK: char;
begin
  Lost := False;
  GT := 0;
  Points := 0;
  OSK := #0;
  SK := #0;
  while KeyPressed do ReadKey;
  repeat
    GetMXY; Mx := Mx shr 3; My := My shr 3;

    if KeyPressed then begin
      K := ReadKey;
      if K = #0 then begin
        SK := ReadKey
      end else SK := #0;
    end;

    if K = #27 then Halt;

    if odd(MButtons) then begin
      K := #0;
      SK := #0;
      OSK := #0;
    end else with F.Monsters[0] do begin
      case SK of
        #72: d := 3;
        #75: d := 1;
        #77: d := 0;
        #80: d := 2;
        else d := 4;
      end;
      if (d in [0 .. 3])
      and not (F.Items[Y+dy[d], X+dx[d]].Value in [1, 2]) then OSK := SK
      else case OSK of
        #72: d := 3;
        #75: d := 1;
        #77: d := 0;
        #80: d := 2;
        else d := 4;
      end;
      if d in [0 .. 3] then begin
        Mx := X + dx[d];
        My := Y + dy[d];
        MButtons := 1;
      end;
    end;

    with F do with Monsters[0] do if (SK = #0) then begin
      if (not odd(MButtons)
      and (Items[TargetY, TargetX].Count = 0))

      or ((X = TargetX)
      and (Y = TargetY)) then begin
        Mx := random(79);
        My := random(49)+1;
        MButtons := 1;
      end;
    end;

    if odd(MButtons) and (Mx < 79) and (My > 0) and not (F.Items[My, Mx].Value in [1, 2]) then begin
      F.Monsters[0].TargetX := Mx;
      F.Monsters[0].TargetY := My;
    end;

    with F do with Monsters[0] do begin
      Inc(Points, Items[Y, X].Count);
      Items[Y, X].Count := 0;
    end;

    Move(F.Monsters[0]);
    for i := 1 to MCount - 1 do with F.Monsters[i] do if GoAway = 0 then begin
      TargetX := F.Monsters[0].X;
      TargetY := F.Monsters[0].Y;
    end else Dec(GoAway);

    i := random(128);

    Mt := Mt + MSpeed;
    while Mt > 0 do begin
      Mt := Mt - 1;
      for i := 1 to MCount - 1 do Move(F.Monsters[i]);
    end;

    for i := 1 to MCount - 1 do
      if (F.Monsters[i].X = F.Monsters[0].X)
        and (F.Monsters[i].Y = F.Monsters[0].Y) then Lost := True;

    for i := 0 to 79 do Screen[0, i].A := 0;
    for j := 0 to 49 do Screen[j, 79].A := 0;
    Screen[My, Mx].C := '+';
    Screen[My, Mx].A := 11;
    TextAttr := 15;
    GotoXY(20, 1);
    Write(round(GT * Delay * ($10000/$1234DC)), '          ');
    GotoXY(60, 1);
    Write(Points);
    Show;
    for i := 0 to Delay - 1 do begin
      while T = Time do;
      T := Time;
    end;
    Inc(GT);
  until Lost;
end;

begin
  Randomize;
  asm mov ax, $1112; mov bx, 0; int $10; end;
  repeat
    Generate(LabDiffculty);
    Play;
    if PauseAfterLost then ReadLN;
  until False;
end.