Игра Ним, Математическая игра. Опции

[MeatCrash]

Программа работает, но есть глюк, запись одна не там пишется. В общем, как зайдете, сами все поймете.

Program Nim;
Uses CRT;
Const
  MAXROW = 14;
  MAXCOL = 20;
Type
  ColType = array [1..MAXROW] of Integer;
Var
  exit, change: Boolean;
  nrow: Integer;
  ncol, col: ColType;
{----------------------------------------------------------------------------}
Procedure ShowField;
const
  Fish = #220;
  X0 = 4;
  X1 = 72;
  X = 20;
var
  i,j: Integer;
begin {ShowField}
  for i := 1 to nrow do
    begin
      GotoXY(X0,i + 4);
      Write(i);
      GotoXY(X1,i + 4);
      Write(col[i] : 2);
      for j := 1 to ncol[i] do
        begin
          GotoXY(X + 2 * j,i + 4);
          if j <= col[i] then Write(Fish) else Write('.')
        end
    end
end; {ShowField}
{----------------------------------------------------------------------------}
Procedure Prepare;
const
  Header0 = 'Game Nim';
  Header1 = 'Vi mozete vzyat lyuboe 4islo fishek iz lyubogo ryada.';
  Header2 = 'Viigrivaet tot, kto vozmet poslednyuyu fishku.';
  Header3 = 'Nomer ryada';
  Header4 = 'Kol-vo fishek';
var
  i: integer;
begin {Prepare}
  ClrScr;
  GotoXY((80 - Length(Header0)) div 2,1);
  Write(Header0);
  GotoXY((80 - Length(Header1)) div 2,2);
  Write(Header1);
  GotoXY((80 - Length(Header2)) div 2,3);
  WriteLn(Header2);
  Write(Header3); {Probambly Error}
  GotoXY(80 - Length(Header4),4);
  Write(Header4);
  for i := 1 to nrow do
    col[i] := ncol[i]
end; {Prepare}
{----------------------------------------------------------------------------}
Procedure GetPlayerMove;
const
  TEXT1 = 'Vvedite Vash hod v formate RYAD KOL-VO' +
  '(naprimer, 2 3 - vzyat iz 2 ryada 3 fishki)';
  TEXT2 = 'ili vvedite 0 0 dlya vihoda iz igrbl; -1 0 dlya nastroyki igrbl';
  TEXT3 = 'Vash hod:                 ';
  Y = 20;
var
  correctly: Boolean;
  x1,x2: Integer;
{----------------------------------------------------------------------------}
Procedure GetChange;
const
  t1 = 'G A M E   O P T I O N';
  t2 = '(vvod kol-va ryadov i kol-va fishek v kazdom ryadu)';
var
  correctly: Boolean;
  i: Integer;
begin {GetChange}
  ClrScr;
  GotoXY((80 - Length(t1)) div 2,1);
  Write(t1);
  GotoXY((80 - Length(t2)) div 2,2);
  Write(t2);
  repeat
    GotoXY(1,3);
    Write('vvedite kol-vo ryadov (maximum ',MAXROW,'):       ');
    GotoXY(WhereX - 6,WhereY);
    ReadLn(nrow);
    correctly := (nrow <= MAXROW) and (nrow > 1); {vozmozno oshibka}
    if not correctly then
      Write(#7)
  until correctly;
  for i := 1 to nrow do
    repeat
      GotoXY(1,i + 3);
      Write(' ryad ',i,' kol-vo fishek (maximum ',MAXCOL,'):       ');
      GotoXY(WhereX - 6,WhereY);
      ReadLn(ncol[i]);
      correctly := (ncol[i] <= MAXCOL) and (ncol[i] > 0);
      if not correctly then
        Write(#7)
    until correctly
end; {GetChange}
{----------------------------------------------------------------------------}
begin {GetPlayerMove}
  ShowField;
  GotoXY((80 - Length(TEXT1)) div 2,Y);
  WriteLn(TEXT1);
  GotoXY((80 - Length(TEXT2)) div 2,Y + 1);
  Write(TEXT2);
  repeat
    GotoXY(1,Y + 2);
    Write(TEXT3);
    GotoXY(WhereX - 16, Y + 2);
    ReadLn(x1,x2); {Vozmozno oshibka}
    exit := x1 = 0;
    change := x1 = -1;
    if not (exit or change) then
      begin
        correctly := (x1 > 0) and (x1 <= nrow) and (x2 > 0) and
        (x2 <= col[x1]);
        if correctly then
          begin
            col[x1] := col[x1] - x2;
            ShowField
          end
        else
          Write(#7)
      end
    else
      correctly := true
  until correctly;
  if change then
    GetChange
end; {GetPlayerMove}
{----------------------------------------------------------------------------}
Procedure SetOwnerMove;
{----------------------------------------------------------------------------}
Function CheckField: Integer;
var
i,j: Integer;
begin {CheckField}
  j := 0;
  for i := 1 to nrow do
    if col[i] > 0 then
      inc(j);
  CheckField := j
end; {CheckField}
{----------------------------------------------------------------------------}
Procedure CheckPlay;
var
  i: Integer;
begin {CheckPlay}
  GotoXY(1,25);
  Write('Vvedite 1, esli hotite sblgrat eshe raz, 0 - exit: ');
  ReadLn(i);
  if i = 1 then
    change := true
  else
    exit := true
end; {CheckPlay}
{----------------------------------------------------------------------------}
Procedure PlayerVictory;
const
  t1 = 'YOU WIN!!!';
var
  i: Integer;
begin {PlayerVictory}
  GotoXY((80 - Length(t1)) div 2,24);
  WriteLn(t1,#7);
  for i := 1 to nrow do
    if ncol[i] < MAXROW then
      inc(ncol[i]);
  CheckPlay
end; {PlayerVictory}
{----------------------------------------------------------------------------}
Procedure OwnVictory;
const
  t1 = 'YOU LOOSE';
var i: Integer;
begin {OwnVictory}
  i :=1;
  while col[i] = 0 do
    inc(i);
 GotoXY((80 - Length(t1)) div 2,24);
 Write(t1,i,#7);
 Delay(2000);
 col[i] := 0;
 ShowField;
 CheckPlay
end; {OwnVictory}
{----------------------------------------------------------------------------}
Procedure ChooseMove;
const
  BIT = 6;
type
   BitType = array [1..BIT] of Integer;
var
  ncbit: array [1..MAXROW] of BitType;
  i,j,k: Integer;
  nbit: BitType;
{----------------------------------------------------------------------------}
Procedure BitForm(n: Integer; var b: BitType);
var
  i: Integer;
begin {BitForm}
  for i := BIT downto 1 do
    begin
      if odd(n) then
        b[i] := 1
      else
        b[i] := 0;
      n := n shr 1
    end
end; {BitForm}
{----------------------------------------------------------------------------}
begin {ChooseMove}
  for i := 1 to nrow do
    BitForm(col[i],ncbit[i]);
  for i := 1 to BIT do
    begin
      nbit[i] := 0;
      for j := 1 to nrow do
        nbit[i] := nbit[i] xor ncbit[j,i]
    end;
  i := 1;
  while nbit[i] = 0 do
    inc(i);
  if i > BIT then
    begin
      j := 1;
      while col[j] = 0 do
        inc(j);
      k := 1
    end
  else
    begin
      j := 1;
      while ncbit[j,i] = 0 do
        inc(j);
      for i := 1 to BIT do
        if nbit[i] = 1 then
          ncbit[j,i] := ord(ncbit[j,i] = 0); {Vozmozno oshibka}
      k := 0;
      for i := 1 to BIT do
        begin
          if ncbit[j,i] = 1 then
            inc(k);
          if i < BIT then
            k := k shl 1
        end;
      k := col[j] - k
    end;
  GotoXY(1,23);
  Write('Moy hod:         ');
  GotoXY(WhereX - 8,WhereY);
  Delay(1000);
  Write(j,' ',k);
  col[j] := col[j] - k
end; {ChooseMove}
{----------------------------------------------------------------------------}
begin {SetOwnerMove}
  case CheckField of
    0: PlayerVictory;
    1: OwnVictory
  else
    ChooseMove
  end
end; {SetOwnerMove}
{----------------------------------------------------------------------------}
Begin {Main Program}
  nrow := 3;
  ncol[1] := 3;
  ncol[2] := 4;
  ncol[3] := 5;
  Repeat
    Prepare;
    repeat
      GetPlayerMove;
      If Not (exit Or change) Then
        SetOwnerMove
    until exit or change
  Until exit
End. {Main Proram}

Если нашли ошибку и знаете как исправить, скажите, пожалуйста! Все точно с учебника списал, а оно все равно глючит =( Сейчас скажу примерные номера строк, в которых она, кажется закралась. - 22 - 31 также 52 - 55, 66, 107-110. Может и в другом месте, никак пнять не могу почему строчка про введение хода пишется сразу после фишек.

Сообщение отредактировано: MeatCrash - 24.11.2012 17:53

[MeatCrash]

Нашел ошибку. Сейчас дам исправленый текст.

Program Nim;
Uses CRT;
Const
  MAXROW = 14;
  MAXCOL = 20;
Type
  ColType = array [1..MAXROW] of Integer;
Var
  exit, change: Boolean;
  nrow: Integer;
  ncol, col: ColType;
{----------------------------------------------------------------------------}
Procedure ShowField;
const
  Fish = #220;
  X0 = 4;
  X1 = 72;
  X = 20;
var
  i,j: Integer;
begin {ShowField}
  for i := 1 to nrow do
    begin
      GotoXY(X0,i + 4);
      Write(i);
      GotoXY(X1,i + 4);
      Write(col[i] : 2);
      for j := 1 to ncol[i] do
        begin
          GotoXY(X + 2 * j,i + 4);
          if j <= col[i] then Write(Fish) else Write('.')
        end
    end
end; {ShowField}
{----------------------------------------------------------------------------}
Procedure Prepare;
const
  Header0 = 'Game Nim';
  Header1 = 'Vi mozete vzyat lyuboe 4islo fishek iz lyubogo ryada.';
  Header2 = 'Viigrivaet tot, kto vozmet poslednyuyu fishku.';
  Header3 = 'Nomer ryada';
  Header4 = 'Kol-vo fishek';
var
  i: integer;
begin {Prepare}
  ClrScr;
  GotoXY((80 - Length(Header0)) div 2,1);
  Write(Header0);
  GotoXY((80 - Length(Header1)) div 2,2);
  Write(Header1);
  GotoXY((80 - Length(Header2)) div 2,3);
  WriteLn(Header2);
  Write(Header3); {Probambly Error}
  GotoXY(80 - Length(Header4),4);
  Write(Header4);
  for i := 1 to nrow do
    col[i] := ncol[i]
end; {Prepare}
{----------------------------------------------------------------------------}
Procedure GetPlayerMove;
const
  TEXT1 = 'Vvedite Vash hod v formate RYAD KOL-VO' +
  '(naprimer, 2 3 - vzyat iz 2 ryada 3 fishki)';
  TEXT2 = 'ili vvedite 0 0 dlya vihoda iz igrbl; -1 0 dlya nastroyki igrbl';
  TEXT3 = 'Vash hod:                 ';
  Y = 20;
var
  correctly: Boolean;
  x1,x2: Integer;
{----------------------------------------------------------------------------}
Procedure GetChange;
const
  t1 = 'G A M E   O P T I O N';
  t2 = '(vvod kol-va ryadov i kol-va fishek v kazdom ryadu)';
var
  correctly: Boolean;
  i: Integer;
begin {GetChange}
  ClrScr;
  GotoXY((80 - Length(t1)) div 2,1);
  Write(t1);
  GotoXY((80 - Length(t2)) div 2,2);
  Write(t2);
  repeat
    GotoXY(1,3);
    Write('vvedite kol-vo ryadov (maximum ',MAXROW,'):       ');
    GotoXY(WhereX - 6,WhereY);
    ReadLn(nrow);
    correctly := (nrow <= MAXROW) and (nrow > 1); {vozmozno oshibka}
    if not correctly then
      Write(#7)
  until correctly;
  for i := 1 to nrow do
    repeat
      GotoXY(1,i + 3);
      Write(' ryad ',i,' kol-vo fishek (maximum ',MAXCOL,'):       ');
      GotoXY(WhereX - 6,WhereY);
      ReadLn(ncol[i]);
      correctly := (ncol[i] <= MAXCOL) and (ncol[i] > 0);
      if not correctly then
        Write(#7)
    until correctly
end; {GetChange}
{----------------------------------------------------------------------------}
begin {GetPlayerMove}
  ShowField;
  GotoXY(1,Y);
  WriteLn(TEXT1);
  GotoXY((80 - Length(TEXT2)) div 2,Y + 1);
  Write(TEXT2);
  repeat
    GotoXY(1,Y + 2);
    Write(TEXT3);
    GotoXY(WhereX - 16, Y + 2);
    ReadLn(x1,x2); {Vozmozno oshibka}
    exit := x1 = 0;
    change := x1 = -1;
    if not (exit or change) then
      begin
        correctly := (x1 > 0) and (x1 <= nrow) and (x2 > 0) and
        (x2 <= col[x1]);
        if correctly then
          begin
            col[x1] := col[x1] - x2;
            ShowField
          end
        else
          Write(#7)
      end
    else
      correctly := true
  until correctly;
  if change then
    GetChange
end; {GetPlayerMove}
{----------------------------------------------------------------------------}
Procedure SetOwnerMove;
{----------------------------------------------------------------------------}
Function CheckField: Integer;
var
i,j: Integer;
begin {CheckField}
  j := 0;
  for i := 1 to nrow do
    if col[i] > 0 then
      inc(j);
  CheckField := j
end; {CheckField}
{----------------------------------------------------------------------------}
Procedure CheckPlay;
var
  i: Integer;
begin {CheckPlay}
  GotoXY(1,25);
  Write('Vvedite 1, esli hotite sblgrat eshe raz, 0 - exit: ');
  ReadLn(i);
  if i = 1 then
    change := true
  else
    exit := true
end; {CheckPlay}
{----------------------------------------------------------------------------}
Procedure PlayerVictory;
const
  t1 = 'YOU WIN!!!';
var
  i: Integer;
begin {PlayerVictory}
  GotoXY((80 - Length(t1)) div 2,24);
  WriteLn(t1,#7);
  for i := 1 to nrow do
    if ncol[i] < MAXROW then
      inc(ncol[i]);
  CheckPlay
end; {PlayerVictory}
{----------------------------------------------------------------------------}
Procedure OwnVictory;
const
  t1 = 'YOU LOOSE';
var i: Integer;
begin {OwnVictory}
  i :=1;
  while col[i] = 0 do
    inc(i);
 GotoXY((80 - Length(t1)) div 2,24);
 Write(t1,i,#7);
 Delay(2000);
 col[i] := 0;
 ShowField;
 CheckPlay
end; {OwnVictory}
{----------------------------------------------------------------------------}
Procedure ChooseMove;
const
  BIT = 6;
type
   BitType = array [1..BIT] of Integer;
var
  ncbit: array [1..MAXROW] of BitType;
  i,j,k: Integer;
  nbit: BitType;
{----------------------------------------------------------------------------}
Procedure BitForm(n: Integer; var b: BitType);
var
  i: Integer;
begin {BitForm}
  for i := BIT downto 1 do
    begin
      if odd(n) then
        b[i] := 1
      else
        b[i] := 0;
      n := n shr 1
    end
end; {BitForm}
{----------------------------------------------------------------------------}
begin {ChooseMove}
  for i := 1 to nrow do
    BitForm(col[i],ncbit[i]);
  for i := 1 to BIT do
    begin
      nbit[i] := 0;
      for j := 1 to nrow do
        nbit[i] := nbit[i] xor ncbit[j,i]
    end;
  i := 1;
  while nbit[i] = 0 do
    inc(i);
  if i > BIT then
    begin
      j := 1;
      while col[j] = 0 do
        inc(j);
      k := 1
    end
  else
    begin
      j := 1;
      while ncbit[j,i] = 0 do
        inc(j);
      for i := 1 to BIT do
        if nbit[i] = 1 then
          ncbit[j,i] := ord(ncbit[j,i] = 0); {Vozmozno oshibka}
      k := 0;
      for i := 1 to BIT do
        begin
          if ncbit[j,i] = 1 then
            inc(k);
          if i < BIT then
            k := k shl 1
        end;
      k := col[j] - k
    end;
  GotoXY(1,23);
  Write('Moy hod:         ');
  GotoXY(WhereX - 8,WhereY);
  Delay(1000);
  Write(j,' ',k);
  col[j] := col[j] - k
end; {ChooseMove}
{----------------------------------------------------------------------------}
begin {SetOwnerMove}
  case CheckField of
    0: PlayerVictory;
    1: OwnVictory
  else
    ChooseMove
  end
end; {SetOwnerMove}
{----------------------------------------------------------------------------}
Begin {Main Program}
  nrow := 3;
  ncol[1] := 3;
  ncol[2] := 4;
  ncol[3] := 5;
  Repeat
    Prepare;
    repeat
      GetPlayerMove;
      If Not (exit Or change) Then
        SetOwnerMove
    until exit or change
  Until exit
End. {Main Program}

Сообщение отредактировано: MeatCrash - 20.12.2012 16:56