Реализация и генерация игры "Судоку"

program xxx;
 
uses
  crt;{for readkey, clrscr and other}
 
const
  LEFT  = 23; 
  UP    = 4;  {of the main window for the game of the main window for the game}
  SPACE = ' '; 
  COL1 = 10; {color box}
  COL2 = 15; {font color}
  COLBG = 0; 
 
 
 
var
  s: array[1..9, 1..9, 0..9] of byte;
  x, y: integer;
  ch: char;
 
 
procedure writexy(x, y: integer; s: string);{determining the coordinates for a given text}
begin
  gotoxy(x, y);
  write(s);
end;
 
 
{ view plain of sudoku }
procedure ViewSudoku;
begin
  textcolor(COL1);
  writexy( LEFT, UP,       '+---+---+---+---+---+---+---+---+---+' );
  writexy( LEFT, UP + 1,   '|   |   |   I   |   |   I   |   |   |' );
  writexy( LEFT, UP + 2,   '+---+---+---+---+---+---+---+---+---+' );
  writexy( LEFT, UP + 3,   '|   |   |   I   |   |   I   |   |   |' );
  writexy( LEFT, UP + 4,   '+---+---+---+---+---+---+---+---+---+' );
  writexy( LEFT, UP + 5,   '|   |   |   I   |   |   I   |   |   |' );
  writexy( LEFT, UP + 6,   '+===+===+===+===+===+===+===+===+===+' );
  writexy( LEFT, UP + 7,   '|   |   |   I   |   |   I   |   |   |' );
  writexy( LEFT, UP + 8,   '+---+---+---+---+---+---+---+---+---+' );
  writexy( LEFT, UP + 9,   '|   |   |   I   |   |   I   |   |   |' );
  writexy( LEFT, UP + 10,  '+---+---+---+---+---+---+---+---+---+' );
  writexy( LEFT, UP + 11,  '|   |   |   I   |   |   I   |   |   |' );
  writexy( LEFT, UP + 12,  '+===+===+===+===+===+===+===+===+===+' );
  writexy( LEFT, UP + 13,  '|   |   |   I   |   |   I   |   |   |' );
  writexy( LEFT, UP + 14,  '+---+---+---+---+---+---+---+---+---+' );
  writexy( LEFT, UP + 15,  '|   |   |   I   |   |   I   |   |   |' );
  writexy( LEFT, UP + 16,  '+---+---+---+---+---+---+---+---+---+' );
  writexy( LEFT, UP + 17,  '|   |   |   I   |   |   I   |   |   |' );
  writexy( LEFT, UP + 18,  '+---+---+---+---+---+---+---+---+---+' );
  textcolor(COL2);
end;
 
{displaying information about the game and the author}
procedure ViewHelp;
begin
  writexy(34, 2, 'DKR programming');
  writexy(6, 5, 'x =   y = ');
  writexy(6, 7, 'Choice=');
  writexy(22, 24, 'F1-Help F2-Clear Arrows-Move ESC-Finish');
  writexy(3, 16, 'Developed program:');
  writexy(3, 18, 'Kovalenko Andrey');
end;
 
 
{ view help of sudoku }
procedure Help;
begin
end;
 
 
{ move to position and write number }
{ write possible number for this }
procedure Kurzor(x, y, c: integer);
var
  xr, yr: integer;
  i: integer;
begin
  gotoxy(16, 5); {показывает координаты данной  ячейки} 
  write(x);
  gotoxy(10, 5); 
  write(y);
  
  { view choice }
  gotoxy(2, 8);
  for i := 1 to 9 do
    if( s[x, y, i] = 0 ) then
      write(SPACE)
    else
      write(i, ' ');
  
  { calc real position }
  xr := LEFT + x * 4 - 2;
  yr := UP + y * 2 - 1;
  
  gotoxy(xr, yr);
  textbackground(c);
  
  if( s[x, y, 0] = 0 ) then
    write( SPACE )
  else
    write(s[x, y, 0]);
  
  gotoxy(xr, yr);
end;
 
 
{ clear area }
procedure Clear;
var
  xc, yc, i: integer;
begin
  for xc := 1 to 9 do
    for yc := 1 to 9 do
    begin
      for i := 0 to 9 do
        s[xc, yc, i] := i;
      
      Kurzor(xc, yc, COLBG);
    end;
end;
 
 
{main}
begin
  TextBackGround(COLBG);
  
  ViewSudoku;
  ViewHelp;
  
  x := 1; 
  y := 1;
  
  repeat
    { move kurzor }
    Kurzor(x, y, COLBG);
    
    { get char from keyb }
    ch := readkey;
    
    if( ch = #0 ) then
      ch := readkey;
    
    { F1, F2 keys }
    if( ch = #59 ) then Help;
    if( ch = #60 ) then Clear;
    
    
    { insert number }
    if( ch in ['0'..'9']) then
    begin
      s[x, y, 0] := ord(ch) - ord('0');
      Kurzor(x, y, COLBG);
      x := x + 1;
    end;
    
    {space as zero }
    if( ch = ' ' ) then ch := '0';
    
    if( ch = #75 ) then x := x - 1;
    if( ch = #77 ) then x := x + 1;
    if( ch = #72 ) then y := y - 1;
    if( ch = #80 ) then y := y + 1;
    
    { home - end }
    if( ch = #71 ) then x := 1;
    if( ch = #79 ) then x := 9;
    
    { pageup - pagedown }
    if( ch = #73 ) then y := 1;
    if( ch = #81 ) then y := 9;
    
    { check position }
    if( x < 1 ) then x := 9;
    if( x > 9 ) then begin
      x := 1;
      y := y + 1; 
    end;
    if( y < 1 ) then y := 9;
    if( y > 9 ) then y := 1;
    
    
  until (ch = #27); { ESC }
  
end.

unit menu;
 
interface
 
    procedure Meinmenu; {меню выбора действией}
    procedure Copyright; {выводит на экран владельца игры}
    procedure Control; {выводит на экран помощь об игре}
 
implementation
 
uses
  crt, xXx, graph;
 
type
  files = file of char;
  files1 = file of string;
 
var
  f: files; {файл в котором хранится информации о владельце и правила игры}
  {g: files1; {}
 
procedure Meinmenu;
begin
  clrscr;
  textcolor(15);
  gotoxy(30, 11); 
  write('(1) -->> Play with me.');
  gotoxy(30, 13);
  write('(2) -->> Copyright.');
  gotoxy(30, 15);
  write('(3) -->> Control.');
  gotoxy(30, 17);
  write('(4) -->> Exit.');
end;
 
procedure Copyright;
var
  b: char;
begin
  clrscr;
  textcolor(15);
  assign(f, 'Copy.txt');
  reset(f);
  while not eof(f) do 
  begin
    read(f, b);
    write(b);
  end;
end;
 
procedure Control;
var
  b: char;
begin
  clrscr;
  textcolor(15);
  assign(f, 'Control.txt');
  reset(f);
  while not eof(f) do 
  begin
    read(f, b);
    write(b);
  end;
end;
end.

program xXx;
 
uses
  crt, graph, menu;
 
type
  mas = array [1..4, 1..4] of char;
 
var
  a1, a2, a3 : byte;
  c, c1, c2 : char;
    k1, cr, cc, cw, z :              integer;
    i, i1, i2, i3 :                  integer;
    j, n, x, y, xz, yz :             integer;
    x1, x2, x3, x4, y1, y2, y3, y4 : integer;
  driver, Mode : integer;
  pxel, font, multx, divx, multy, divy : word;
  s : string;
  b, d, f : byte;
  a : mas; {собственно наш массив}
 
procedure win; {процедура определения выграли вы или нет}
               {выводит об этом результат}
               {и показывает количество сделаных ходов за игру}
begin
{условия для проеврки не совпадают ли буквы по горизонтали и вертикали}
  if (a[1, 1] <> a[2, 1]) and (a[1, 1] <> a[3, 1]) and (a[1, 1] <> a[4, 1]) and
     (a[2, 1] <> a[3, 1]) and (a[2, 1] <> a[4, 1]) and (a[3, 1] <> a[4, 1]) and
     
     (a[1, 2] <> a[2, 2]) and (a[1, 2] <> a[3, 2]) and (a[1, 2] <> a[4, 2]) and
     (a[2, 2] <> a[3, 2]) and (a[2, 2] <> a[4, 2]) and (a[3, 2] <> a[4, 2]) and
 
     (a[1, 3] <> a[2, 3]) and (a[1, 3] <> a[3, 3]) and (a[1, 3] <> a[4, 3]) and
     (a[2, 3] <> a[3, 3]) and (a[2, 3] <> a[4, 3]) and (a[3, 3] <> a[4, 3]) and
 
     (a[1, 4] <> a[2, 4]) and (a[1, 4] <> a[3, 4]) and (a[1, 4] <> a[4, 4]) and
     (a[2, 4] <> a[3, 4]) and (a[2, 4] <> a[4, 4]) and (a[3, 4] <> a[4, 4]) and
 
     (a[i, 1] <> a[1, 2]) and (a[1, 1] <> a[1, 3]) and (a[1, 1] <> a[1, 4]) and
     (a[i, 2] <> a[1, 3]) and (a[1, 2] <> a[1, 4]) and (a[1, 3] <> a[1, 4]) and
 
     (a[i, 1] <> a[2, 2]) and (a[2, 1] <> a[2, 3]) and (a[2, 1] <> a[2, 4]) and
     (a[i, 2] <> a[2, 3]) and (a[2, 2] <> a[2, 4]) and (a[2, 3] <> a[2, 4]) and
 
     (a[i, 1] <> a[3, 2]) and (a[3, 1] <> a[3, 3]) and (a[3, 1] <> a[3, 4]) and
     (a[i, 2] <> a[3, 3]) and (a[3, 2] <> a[3, 4]) and (a[3, 3] <> a[3, 4]) and
 
     (a[i, 1] <> a[4, 2]) and (a[4, 1] <> a[4, 3]) and (a[4, 1] <> a[4, 4]) and
     (a[i, 2] <> a[4, 3]) and (a[4, 2] <> a[4, 4]) and (a[4, 3] <> a[4, 4]) then
  begin 
    begin {подключение графики}
      Driver := VGA;
      Mode := VGAHI;
      initgraph(driver, mode, '');
    end;
    graphdefaults;
    outtextxy(300, 200, ' Приветствую Вас. ');
    outtextxy(295, 210, ' !!!Вы победили!!! ');
    outtextxy(270, 220, ' Ваш счет -->> ');
    outtextxy(385, 220, c2);
    outtextxy(392, 220, c1);
    outtextxy(402, 220, c);
    outtextxy(90, 350, ' (1) -->> Играть');
    outtextxy(90, 360, ' (4) -->> Выход');
    i1 := 0;
    i2 := 0;
    i3 := 0;
  end;
end;
 
procedure start; 
const
  n = 620;
var
  i, x, x1: integer;
begin
  k1 := k1 + 1;
  begin
    Driver := VGA;
    Mode := VGAHI;
    initgraph(driver, mode, '');
  end;
  outtextxy(270, 430, 'Loading game...');
  for i := 1 to n do
  begin
    delay(5);
    setfillstyle(3, 2);
    bar(i + 10, 400, 10, 420);
  end;
end;
 
procedure records;
var
  k: integer;
begin
  setcolor(15);
  settextstyle(0, 0, 1);
  outtextxy(420, 50, 'moves -->> ');
  outtextxy(575, 50, '0');
  i1 := i1 + 1;
  a1 := 48 + i1;
  c := chr(a1);
  setfillstyle(1, 0);
  bar(575, 50, 585, 60);
  setcolor(15);
  outtextxy(575, 50, c);
  if a1 = 58 then begin
    setfillstyle(1, 0);
    bar(575, 50, 585, 60);
    setcolor(15);
    outtextxy(575, 50, '0');
    i1 := 0;
    i2 := i2 + 1;
    a2 := 48 + i2;
    c1 := chr(a2);
    setfillstyle(1, 0);
    bar(566, 50, 573, 60);
    setcolor(15);
    outtextxy(566, 50, c1);
    if a2 = 58 then begin
      setfillstyle(1, 0);
      bar(566, 50, 573, 60);
      setcolor(15);
      outtextxy(566, 50, '0');
      i2 := 0;
      i3 := i3 + 1;
      a3 := 48 + i3;
      c2 := chr(a3);
      setfillstyle(1, 0);
      bar(557, 50, 565, 60);
      setcolor(15);
 
      outtextxy(557, 50, c2);
    end;
  end;
end;
 
procedure koordinatu(c: integer);
var
  x1, x2, y1, y2, k, t: integer;
  m: char;
begin
  case c of
    1:
      begin
        if x > 180 then x := 0;
        if y > 180 then y := 0;
        if x < 0 then x := 180;
        if y < 0 then y := 180;
        begin
          line(60 + x, 60 + y, 60 + x, 120 + y);
          line(60 + x, 60 + y, 120 + x, 60 + y);
          line(120 + x, 60 + y, 120 + x, 120 + y);
          line(60 + x, 120 + y, 120 + x, 120 + y);
        end;
      end;
    2:
      begin
        setfillstyle(1, 0);
        if x = 0 then
        begin
          x1 := 1;
        end;
        if x = 60 then
        begin
          x1 := 2;
        end;
        if x = 120 then
        begin
          x1 := 3;
        end;
        if x = 180 then
        begin
          x1 := 4;
        end;
        if y = 0 then
        begin
          y1 := 1;
          bar(61, 61, 119, 119); bar(299, 61, 241, 119);
          bar(179, 61, 121, 119); bar(239, 61, 181, 119);
        end;
        if y = 60 then
        begin
          y1 := 2;
          bar(61, 121, 119, 179); bar(299, 121, 241, 179);
          bar(179, 121, 121, 179); bar(239, 121, 181, 179);
        end;
        if y = 120 then
        begin
          y1 := 3;
          bar(61, 181, 119, 239); bar(299, 181, 241, 239);
          bar(179, 181, 121, 239); bar(239, 181, 181, 239);
        end;
        if y = 180 then
        begin
          y1 := 4;
          bar(61, 241, 119, 299); bar(299, 241, 241, 299);
          bar(179, 241, 121, 299); bar(239, 241, 181, 299);
        end;
        setcolor(2);
        m := a[y1, 1];
        a[y1, 1] := a[y1, 2];
        a[y1, 2] := a[y1, 3];
        a[y1, 3] := a[y1, 4];
        a[y1, 4] := m;
        for k := 1 to 4 do
          for t := 1 to 4 do
          begin
            setcolor(cw);
                  if t = 1 then xz := 85;
                  if t = 2 then xz := 145;
                  if t = 3 then xz := 205;
                  if t = 4 then xz := 265;
 
                  if k = 1 then yz := 85;
                  if k = 2 then yz := 155;
                  if k = 3 then yz := 215;
                  if k = 4 then yz := 275;
            outtextxy(xz, yz, a[k, t]);
            win;
          end;
      end;
    3:
      begin
        setfillstyle(1, 0);
        if x = 0 then
        begin
          x1 := 1;
          bar(61, 61, 119, 119); bar(61, 241, 119, 299);
          bar(61, 121, 119, 179); bar(61, 181, 119, 239);
        end;
        if x = 60 then
        begin
          x1 := 2;
          bar(121, 61, 179, 119); bar(121, 241, 179, 299);
          bar(121, 121, 179, 179); bar(121, 181, 179, 239);
        end;
        if x = 120 then
        begin
          x1 := 3;
          bar(181, 61, 239, 119); bar(181, 241, 239, 299);
          bar(181, 121, 239, 179); bar(181, 181, 239, 239);
        end;
        if x = 180 then
        begin
          x1 := 4;
          bar(241, 61, 299, 119); bar(241, 241, 299, 299);
          bar(241, 121, 299, 179); bar(241, 181, 299, 239);
        end;
        if y = 0 then
        begin
          y1 := 1;
        end;
        if y = 60 then
        begin
          y1 := 2;
        end;
        if y = 120 then
        begin
          y1 := 3;
        end;
        if y = 180 then
        begin
          y1 := 4;
        end;
        setcolor(2);
        m := a[1, x1];
        a[1, x1] := a[2, x1];
        a[2, x1] := a[3, x1];
        a[3, x1] := a[4, x1];
        a[4, x1] := m;
        for k := 1 to 4 do
          for t := 1 to 4 do
          begin
            setcolor(cw);
               if t = 1 then xz := 85;
               if t = 2 then xz := 145;
               if t = 3 then xz := 205;
               if t = 4 then xz := 265;
 
               if k = 1 then yz := 85;
               if k = 2 then yz := 155;
               if k = 3 then yz := 215;
               if k = 4 then yz := 275;
            outtextxy(xz, yz, a[k, t]);
            win;
          end;
      end;
    4:
      begin
        setfillstyle(1, 0);
        if x = 0 then
        begin
          x1 := 1;
        end;
        if x = 60 then
        begin
          x1 := 2;
        end;
        if x = 120 then
        begin
          x1 := 3;
        end;
        if x = 180 then
        begin
          x1 := 4;
        end;
        if y = 0 then
        begin
          y1 := 1;
          bar(61, 61, 119, 119); bar(299, 61, 241, 119);
          bar(179, 61, 121, 119); bar(239, 61, 181, 119);
        end;
        if y = 60 then
        begin
          y1 := 2;
          bar(61, 121, 119, 179); bar(299, 121, 241, 179);
          bar(179, 121, 121, 179); bar(239, 121, 181, 179);
        end;
        if y = 120 then
        begin
          y1 := 3;
          bar(61, 181, 119, 239); bar(299, 181, 241, 239);
          bar(179, 181, 121, 239); bar(239, 181, 181, 239);
        end;
        if y = 180 then
        begin
          y1 := 4;
          bar(61, 241, 119, 299); bar(299, 241, 241, 299);
          bar(179, 241, 121, 299); bar(239, 241, 181, 299);
        end;
        setcolor(2);
        m := a[y1, 4];
        a[y1, 4] := a[y1, 3];
        a[y1, 3] := a[y1, 2];
        a[y1, 2] := a[y1, 1];
        a[y1, 1] := m;
        for k := 1 to 4 do
          for t := 1 to 4 do
          begin
 
            setcolor(cw);
                  if t = 1 then xz := 85;
                  if t = 2 then xz := 145;
                  if t = 3 then xz := 205;
                  if t = 4 then xz := 265;
 
                  if k = 1 then yz := 85;
                  if k = 2 then yz := 155;
                  if k = 3 then yz := 215;
                  if k = 4 then yz := 275;
            outtextxy(xz, yz, a[k, t]);
            win;
          end;
      end;
    5:
      begin
        setfillstyle(1, 0);
        if x = 0 then
        begin
          x1 := 1;
          bar(61, 61, 119, 119); bar(61, 241, 119, 299);
          bar(61, 121, 119, 179); bar(61, 181, 119, 239);
        end;
        if x = 60 then
        begin
          x1 := 2;
          bar(121, 61, 179, 119); bar(121, 241, 179, 299);
          bar(121, 121, 179, 179); bar(121, 181, 179, 239);
        end;
        if x = 120 then
        begin
          x1 := 3;
          bar(181, 61, 239, 119); bar(181, 241, 239, 299);
          bar(181, 121, 239, 179); bar(181, 181, 239, 239);
        end;
        if x = 180 then
        begin
          x1 := 4;
          bar(241, 61, 299, 119); bar(241, 241, 299, 299);
          bar(241, 121, 299, 179); bar(241, 181, 299, 239);
        end;
        if y = 0 then
        begin
          y1 := 1;
        end;
        if y = 60 then
        begin
          y1 := 2;
        end;
        if y = 120 then
        begin
          y1 := 3;
        end;
        if y = 180 then
        begin
          y1 := 4;
        end;
        setcolor(2);
        m := a[4, x1];
        a[4, x1] := a[3, x1];
        a[3, x1] := a[2, x1];
        a[2, x1] := a[1, x1];
        a[1, x1] := m;
        for k := 1 to 4 do
          for t := 1 to 4 do
          begin
            setcolor(cw);
                  if t = 1 then xz := 85;
                  if t = 2 then xz := 145;
                  if t = 3 then xz := 205;
                  if t = 4 then xz := 265;
 
                  if k = 1 then yz := 85;
                  if k = 2 then yz := 155;
                  if k = 3 then yz := 215;
                  if k = 4 then yz := 275;
            outtextxy(xz, yz, a[k, t]);
            win;
          end;
      end;
  end;
end;
 
procedure vuvid;
var
  i, j, xz, yz, k, t, l: integer;
  m: char;
  c: char;
begin
  begin
    Driver := VGA;
    Mode := VGAHI;
    initgraph(driver, mode, '');
  end;
  begin
    x := 0;
    y := 0;
    setcolor(cc);
    line(60, 60, 300, 60);
    line(60, 120, 300, 120);
    line(60, 180, 300, 180);
    line(60, 240, 300, 240);
    line(60, 300, 300, 300);
 
    line(60, 60, 60, 300);
    line(120, 60, 120, 300);
    line(180, 60, 180, 300);
    line(240, 60, 240, 300);
    line(300, 60, 300, 300);
 
    settextstyle(1, 0, 7);
    setcolor(cr);
    line(60, 60, 60, 120);
    line(60, 60, 120, 60);
    line(120, 60, 120, 120);
    line(60, 120, 120, 120);
  end;
  randomize;
  for i := 1 to 4 do
  begin
    a[i, 1] := 'a';
    a[i, 2] := 'b';
    a[i, 3] := 'c';
    a[i, 4] := 'd';
  end;
  for l := 1 to 100 do
  begin
    i := random(4) + 1;
    j := random(4) + 1;
    k := random(4) + 1;
    t := random(4) + 1;
    m := a[i, j];
    a[i, j] := a[k, t];
    a[k, t] := m;
  end;
  for k := 1 to 4 do
    for t := 1 to 4 do
    begin
      setcolor(cw);
      if t = 1 then xz := 85;
      if t = 2 then xz := 145;
      if t = 3 then xz := 205;
      if t = 4 then xz := 265;
 
      if k = 1 then yz := 85;
      if k = 2 then yz := 155;
      if k = 3 then yz := 215;
      if k = 4 then yz := 275;
      outtextxy(xz, yz, a[k, t]);
    end;
end;
 
begin
  clrscr;
  cr := 5;
  cc := 15;
  cw := 2;
  repeat ;
    case readkey of
      #77:
        begin
          settextstyle(1, 0, 7);
          setcolor(cc);
          koordinatu(1);
          x := x + 60;
          setcolor(cr);
          koordinatu(1);
        end;
      #80:
        begin
          settextstyle(1, 0, 7);
          setcolor(cc);
          koordinatu(1);
          y := y + 60;
          setcolor(cr);
          koordinatu(1);
        end;
      #72:
        begin
          settextstyle(1, 0, 7);
          setcolor(cc);
          koordinatu(1);
          y := y - 60;
          setcolor(cr);
          koordinatu(1);
        end;
      #75:
        begin
          settextstyle(1, 0, 7);
          setcolor(cc);
          koordinatu(1);
          x := x - 60;
          setcolor(cr);
          koordinatu(1);
        end;
      'a':
        begin
          inc(x1);
          records;
          settextstyle(1, 0, 7);
          koordinatu(2);
        end;
      'w':
        begin
          inc(y1);
          records;
          settextstyle(1, 0, 7);
          koordinatu(3);
        end;
      'd':
        begin
          inc(x1);
          records;
          settextstyle(1, 0, 7);
          koordinatu(4);
        end;
      's':
        begin
          inc(y1);
          records;
          settextstyle(1, 0, 7);
          koordinatu(5);
        end;
      '2': Copyright;
      '3': Control;
      '4': exit;
      #13:
        begin
          closegraph;
          meinmenu;
        end;
      '1':
        begin
          start;
          vuvid;
          setcolor(15);
          settextstyle(0, 0, 1);
          outtextxy(420, 50, 'moves -->> ');
          outtextxy(575, 50, '0');
        end;
    end;
  until n = 4;
end.