Pascal/Turbo Pascal - juego de Rompecabeza Numérico en pascal

{Espero esto sirva parte 1 d3 2}

 program juegonumeros;

 uses

   crt, dos;

     const

         m = 5;

         n : integer = 3;

         px : integer = 9;

         py : integer = 3;

     type

     table = record

        jugador : string[30];

        nivel : string[15];

        numero : integer;

        tiempo : string[8];

        movi : integer;

        tablero : array[1..m,1..m] of integer;

        end;

        string8 = string[8];

    const

       tab : table = (jugador : ' ';nivel : ' ';numero : 0;

                      tiempo : ' ';movi : 0;

                      tablero :((0,0,0,0,0),(0,0,0,0,0),

                      (0,0,0,0,0),(0,0,0,0,0),(0,0,0,0,0)));

    function relocontador(anh, anm, ans : word; var ho, mi, se : word) : string8;

    var

      h, m, s, cs : word;

      reloc : string8;

      hora,minu,segu : string[2];

     begin

         gettime(h,m,s,cs);

         if (anh > 0) or (anm > 0) or (ans > 0) then

         begin

           fillchar(reloc,sizeof(reloc),' ');

           str((h - anh),hora);

           str((m - anm),minu);

           str((s - ans),segu);

           reloc := hora + ':' + minu + ':' + segu;

           relocontador := copy(reloc,1,length(reloc));

         end

      else

         begin

            ho := h;

            mi := m;

            se := s;

           fillchar(reloc,sizeof(reloc),' ');

           str(h,hora);

           str(m,minu);

           str(s,segu);

           reloc := hora + ':' + minu + ':' + segu;

           relocontador := copy(reloc,1,length(reloc));

         end;

     end;

    procedure tablero4(x1, y1 : integer;tama : integer);

    var

      t, h : integer;

    begin

    h := 1;

        textcolor(11);

        if tama = 3 then

        begin

           gotoxy(x1 - 2,y1 + (tama * tama) - 1);write('Cordenadas X >< Y');

           gotoxy(x1 - 3,y1 - 1);write('X = 1 2 3');

           gotoxy(x1,y1);write(chr(218),chr(196),chr(194),chr(196),

           chr(194),chr(196),chr(191));

           gotoxy(x1,y1 + 1);write(chr(179),' ',chr(179),' ',chr(179),' ',

           chr(179));

           gotoxy(x1,y1 + 2);write(chr(195),chr(196),chr(197),

           chr(196),chr(197),chr(196),chr(180));

           gotoxy(x1,y1 + 3);write(chr(179),' ',chr(179),' ',chr(179),' ',

           chr(179));

           gotoxy(x1,y1 + 4);write(chr(195),chr(196),chr(197),

           chr(196),chr(197),chr(196),chr(180));

           gotoxy(x1,y1 + 5);write(chr(179),' ',chr(179),' ',chr(179),' ',

           chr(179));

           gotoxy(x1,y1 + 6);write(chr(192),chr(196),chr(193),chr(196),

           chr(193),chr(196),chr(217));

           gotoxy(x1 + (tama * 2) + 1,y1 + 1);write('1');

           gotoxy(x1 + (tama * 2) + 1,y1 + 3);write('2 = Y');

           gotoxy(x1 + (tama * 2) + 1,y1 + 5);write('3');

        end;

        if tama = 4 then

        begin

           gotoxy(x1 - 2,y1 + (tama * tama) - 6);write('Cordenadas X >< Y');

           gotoxy(x1 - 2,y1 - 1);write('X = 1  2  3  4');

           gotoxy(x1,y1);write(chr(218),chr(196),chr(196),chr(194),chr(196),chr(196),chr(194),

           chr(196),chr(196),chr(194),chr(196),chr(196),chr(191));

           gotoxy(x1,y1 + 1);write(chr(179),'  ',chr(179),'  ',chr(179),'  ',

           chr(179),'  ',chr(179));

           gotoxy(x1,y1 + 2);write(chr(195),chr(196),chr(196),chr(197),

           chr(196),chr(196),chr(197),chr(196),chr(196),chr(197),chr(196),chr(196),chr(180));

           gotoxy(x1,y1 + 3);write(chr(179),'  ',chr(179),'  ',chr(179),'  ',

           chr(179),'  ',chr(179));

           gotoxy(x1,y1 + 4);write(chr(195),chr(196),chr(196),chr(197),

           chr(196),chr(196),chr(197),chr(196),chr(196),chr(197),chr(196),chr(196),chr(180));

           gotoxy(x1,y1 + 5);write(chr(179),'  ',chr(179),'  ',chr(179),'  ',

           chr(179),'  ',chr(179));

           gotoxy(x1,y1 + 6);write(chr(195),chr(196),chr(196),chr(197),

           chr(196),chr(196),chr(197),chr(196),chr(196),chr(197),chr(196),chr(196),chr(180));

           gotoxy(x1,y1 + 7);write(chr(179),'  ',chr(179),'  ',chr(179),'  ',

           chr(179),'  ',chr(179));

           gotoxy(x1,y1 + 8);write(chr(192),chr(196),chr(196),chr(193),chr(196),chr(196),

           chr(193),chr(196),chr(196),chr(193),chr(196),chr(196),chr(217));

           gotoxy(x1 + (tama * 3) + 1,y1 + 1);write('1');

           gotoxy(x1 + (tama * 3) + 1,y1 + 3);write('2');

           gotoxy(x1 + (tama * 3) + 1,y1 + 4);write('  = Y');

           gotoxy(x1 + (tama * 3) + 1,y1 + 5);write('3');

           gotoxy(x1 + (tama * 3) + 1,y1 + 7);write('4');

        end;

        if tama = 5 then

        begin

           gotoxy(x1 - 2,y1 + (tama * tama) - 13);write('Cordenadas X >< Y');

           gotoxy(x1 - 2,y1 - 1);write('X = 1  2  3  4  5');

           gotoxy(x1,y1);write(chr(218),chr(196),chr(196),chr(194),chr(196),chr(196),chr(194),

           chr(196),chr(196),chr(194),chr(196),chr(196),chr(194),chr(196),chr(196),chr(191));

           gotoxy(x1,y1 + 1);write(chr(179),'  ',chr(179),'  ',chr(179),'  ',

           chr(179),'  ',chr(179),'  ',chr(179));

           gotoxy(x1,y1 + 2);write(chr(195),chr(196),chr(196),chr(197),

           chr(196),chr(196),chr(197),chr(196),chr(196),chr(197),chr(196),chr(196),chr(197),chr(196),chr(196),chr(180));

           gotoxy(x1,y1 + 3);write(chr(179),'  ',chr(179),'  ',chr(179),'  ',

           chr(179),'  ',chr(179),'  ',chr(179));

           gotoxy(x1,y1 + 4);write(chr(195),chr(196),chr(196),chr(197),

           chr(196),chr(196),chr(197),chr(196),chr(196),chr(197),chr(196),chr(196),chr(197),chr(196),chr(196),chr(180));

           gotoxy(x1,y1 + 5);write(chr(179),'  ',chr(179),'  ',chr(179),'  ',

           chr(179),'  ',chr(179),'  ',chr(179));

           gotoxy(x1,y1 + 6);write(chr(195),chr(196),chr(196),chr(197),

           chr(196),chr(196),chr(197),chr(196),chr(196),chr(197),chr(196),chr(196),chr(197),chr(196),chr(196),chr(180));

           gotoxy(x1,y1 + 7);write(chr(179),'  ',chr(179),'  ',chr(179),'  ',

           chr(179),'  ',chr(179),'  ',chr(179));

           gotoxy(x1,y1 + 8);write(chr(195),chr(196),chr(196),chr(197),

           chr(196),chr(196),chr(197),chr(196),chr(196),chr(197),chr(196),

           chr(196),chr(197),chr(196),chr(196),chr(180));

           gotoxy(x1,y1 + 9);write(chr(179),'  ',chr(179),'  ',chr(179),'  ',

           chr(179),'  ',chr(179),'  ',chr(179));

           gotoxy(x1,y1 + 10);write(chr(192),chr(196),chr(196),chr(193),chr(196),

           chr(196),chr(193),chr(196),chr(196),chr(193),chr(196),chr(196),chr(193),chr(196),chr(196),chr(217));

           gotoxy(x1 + (tama * 3) + 1,y1 + 1);write('1');

           gotoxy(x1 + (tama * 3) + 1,y1 + 3);write('2');

           gotoxy(x1 + (tama * 3) + 1,y1 + 5);write('3  = Y');

           gotoxy(x1 + (tama * 3) + 1,y1 + 7);write('4');

           gotoxy(x1 + (tama * 3) + 1,y1 + 9);write('5');

        end;

        textcolor(15);

    end;

    function posicioncorrecta(xx, yy : integer) : boolean;

    var

       posic : boolean;

    begin

       posic := false;

       if posic = false then

       begin

       if xx = n then

       begin

        if tab.tablero[xx - 1,yy] = 0 then

         posic := true;

       end

    else

       begin

          if xx = 1 then

            if tab.tablero[xx + 1,yy] = 0 then

            posic := true;

       end;

     end;

       if posic = false then

       begin

         if yy = 1 then

         begin

          if tab.tablero[xx,yy + 1] = 0 then

          posic := true;

         end

      else

          begin

             if yy = n then

               if tab.tablero[xx,yy - 1] = 0 then

               posic := true;

          end;

       end;

       if (xx > 1) and (xx < n) then

       begin

         if tab.tablero[xx - 1,yy] = 0 then

         posic := true;

         if tab.tablero[xx + 1,yy] = 0 then

         posic := true;

       end;

      if (yy > 1) and (yy < n) then

      begin

         if tab.tablero[xx,yy - 1] = 0 then

         posic := true;

        if tab.tablero[xx,yy + 1] = 0 then

        posic := true;

      end;

        posicioncorrecta := posic;

    end;

    procedure generanumeros(cual : integer);

    var

      p, h, t, nm, nume : integer;

      losnum : array[1..(5 * 5)] of integer;

      fa, sal : boolean;

     begin

        sal := false;

        nm := 1;

        fillchar(losnum,sizeof(losnum),0);

      repeat

         nume := random((cual * cual) - 1) + 1;

         fa := true;

         for t := 1 to nm do

         if losnum[t] = nume then

         fa := false;

         if fa = true then

         begin

         losnum[nm] := nume;

         nm := nm + 1;

         if nm > (cual * cual) - 1 then

         sal := true;

         end;

      until sal = true;

      p := 1;

      nume := random(cual * cual) + 1;

      repeat

      losnum[(cual * cual)] := losnum[(cual * cual) - p];

      p := p + 1;

      until p = nume;

      losnum[(cual * cual) - (p - 1)] := 0;

      p := 1;

      for t := 1 to cual do

        for h := 1 to cual do

        begin

        tab.tablero[h,t] := losnum[p];

        p := p + 1;

        end;

     end;

    procedure presentajuego(nn : integer);

    var

      mu, yu, h, t : integer;

     begin

        tablero4(10,4,nn);

        textcolor(15);

        generanumeros(nn);

        h := 1;

        t := 1;

        case nn of

     3 : mu := 2;

     4, 5 : mu := 3;

       end;

       if nn > 3 then

       px := px - 1;

       yu := 2;

        repeat

        if nn = 3 then

        begin

        gotoxy(px + (h * mu),py + (t * yu));write(' ');

        end

     else

        begin

        gotoxy(px + (h * mu),py + (t * yu));write('  ');

        end;

        gotoxy(px + (h * mu),py + (t * yu));write(tab.tablero[h,t]);

        h := h + 1;

        if h > nn then

        begin

        t := t + 1;

        h := 1;

        end;

        until t > nn;

     end;

   procedure presentajuegadas(nn : integer);

    var

      mu, yu, h, t : integer;

     begin

        h := 1;

        t := 1;

        case nn of

     3 : mu := 2;

     4, 5 : mu := 3;

       end;

       if nn > 3 then

       px := px;

       yu := 2;

       textcolor(15);

        repeat

        if nn = 3 then

        begin

        gotoxy(px + (h * mu),py + (t * yu));write(' ');

        end

     else

        begin

        gotoxy(px + (h * mu),py + (t * yu));write('  ');

        end;

        gotoxy(px + (h * mu),py + (t * yu));write(tab.tablero[h,t]);

        h := h + 1;

        if h > nn then

        begin

        t := t + 1;

        h := 1;

        end;

        until t > nn;

     end;

{Parte 2 de 2}

  function cordn(cual : integer) : integer;

   var

     tt : char;

     gg : integer;

     tecla : char;

   begin

      tt := chr(cual + 48);

     repeat

         tecla := readkey;

     until tecla in['1'..tt];

     gg := ord(tecla) - 48;

      cordn := gg;

   end;

   function comprovarjugadaok(jug, gg : integer) : boolean;

   var

     jugad : array[1..25] of integer;

     cc, xj, yj : integer;

    begin

       comprovarjugadaok := true;

       cc := 1;

     for yj := 1 to gg do

       for xj := 1 to gg do

       begin

          jugad[cc] := tab.tablero[xj,yj];

          cc := cc + 1;

       end;

       for cc := 1 to (gg * gg) do

       if jugad[cc] <> cc - 1 then

       comprovarjugadaok := false;

    end;

   procedure jugamos(cual, jug : integer;var est : boolean);

   var

     miv, cam, tx, ty, mx, my : integer;

     tec : char;

     salir, si : boolean;

     fh, fm, fs, ih, im, is : word;

   begin

      salir := false;

      presentajuego(cual);

      textcolor(15);

      est := true;

      fh := 0;

      fm := 0;

      fs := 0;

      ih := 0;

      im := 0;

      is := 0;

      miv := 1;

      gotoxy(40,3);write('Inicio Jugador ',jug,' : ',relocontador(fh,fm,fs,ih,im,is));

      si := false;

      repeat

      if comprovarjugadaok(jug,n) = false then

      begin

     repeat

      gotoxy(10,20);clreol;

      gotoxy(10,21);clreol;

      gotoxy(10,20);write('Cordenada X A Mover :    ');

      tx := cordn(cual);

      gotoxy(32,20);write(tx);

      gotoxy(10,21);write('Cordenada Y A Mover :    ');

      ty := cordn(cual);

      gotoxy(32,21);write(ty);

      si := posicioncorrecta(tx,ty);

      if si = false then

      begin

         gotoxy(10,20);clreol;

         textcolor(4);

         gotoxy(10,20);write('entrada Incorrecta Entre De Nuevo');

         delay(1990);

         textcolor(15);

         gotoxy(10,20);clreol;

      end;

      until si = true;

      if tab.tablero[tx,ty] <> 0 then

      begin

      cam := tab.tablero[tx,ty];

      tab.tablero[tx,ty] := 0;

      mx := tx;

      my := ty;

      si := true;

      end;

      gotoxy(10,20);clreol;

      gotoxy(10,21);clreol;

      gotoxy(10,20);write('Cordenada X A Colocar :    ');

      tx := cordn(cual);

      gotoxy(34,20);write(tx);

      gotoxy(10,21);write('Cordenada Y A Colocar :    ');

      ty := cordn(cual);

      gotoxy(34,21);write(ty);

      if (tab.tablero[tx,ty] = 0) and (si = true) then

      begin

         tab.tablero[tx,ty] := cam;

      end

   else

      begin

         gotoxy(10,20);write('Error De Entradas');

      end;

     presentajuegadas(cual);

     gotoxy(10,20);clreol;

     gotoxy(10,20);write('Pulse [S] = Segir O [N] = Final');

     repeat

     tec := upcase(readkey);

     until tec in['S','N'];

     if tec = 'S' then

     miv := miv + 1;

     gotoxy(10,20);clreol;

    end

  else

     begin

        clrscr;

        writeln('   Partida Consegida Pulse Una Tecla');

        readkey;

        salir := true;

     end;

     until (tec = 'N') or (salir = true);

     if tec = 'N' then

     est := false;

     tab.tiempo := relocontador(ih,im,is,fh,fm,fs);

     gotoxy(40,20);write('Tiempo Invertido : ',tab.tiempo);

     tab.movi := miv;

     readkey;

   end;

   procedure inicio(njug : integer;var cc : boolean);

   var

      niv : integer;

      tt : char;

      cir : boolean;

   begin

      clrscr;

      textcolor(15);

      write('   Entre Nombre Jugador N. ',njug,' : ');

      readln(tab.jugador);

      write('   Entre Nivel [1 = Principiante] [2 = Medio] [3 = Avanzado] : ');

      repeat

         tt := readkey;

         niv := ord(tt) - 48;

      until niv in[1,2,3];

    case niv of

  1 : begin n := 3; tab.nivel := 'Principiante'; end;

  2 : begin n := 4; tab.nivel := 'Medio'; end;

  3 : begin n := 5; tab.nivel := 'Avanzado'; end;

    end;

      tab.numero := njug;

      clrscr;

      jugamos(n,njug,cir);

      cc := cir;

   end;

   procedure actualizanivel(jug : integer;var cc : boolean);

   var

      tt : char;

      niv : integer;

      cir : boolean;

   begin

      clrscr;

      textcolor(15);

      writeln('   Elejir Nivel Nuevo ');

      writeln;

      write('   Entre Nivel [1,2,3] : ');

      repeat

         tt := readkey;

         niv := ord(tt) - 48;

      until niv in[1,2,3];

    case niv of

  1 : begin n := 3; tab.nivel := 'Principiante'; end;

  2 : begin n := 4; tab.nivel := 'Medio'; end;

  3 : begin n := 5; tab.nivel := 'Avanzado'; end;

    end;

     clrscr;

     jugamos(n,jug,cir);

     cc := cir;

   end;

   procedure menu;

   var

     pul : char;

     juegan : array[1..6] of table;

     vv, cont : integer;

     ci, term : boolean;

     begin

        term := false;

        cont := 1;

        repeat

            clrscr;

            textcolor(11);

            writeln('  **** Menu Juego ****');

            textcolor(15);

            writeln;

            writeln('    [1] = Inicio Juego');

            writeln('    [2] = Nivel');

            writeln('    [3] = Cantidad Movimientos');

            writeln('    [4] = Fin');

            writeln;

            textcolor(14);

            writeln('    Elija Opcion');

            textcolor(15);

         repeat

             pul := readkey;

        until pul in['1','2','3','4'];

        clrscr;

      case pul of

  '1' : inicio(cont,ci);

  '2' : actualizanivel(cont,ci);

  '3' : begin

          clrscr;

          if cont > 1 then

          begin

          for vv := 1 to cont do

          begin

             writeln(juegan[vv].jugador,'  ',juegan[vv].nivel,

             '   ',juegan[vv].movi);

           end;

          end

        else

          begin

             writeln('   No Datos Para Presentar');

          end;

             writeln;

             writeln('  Pulse Una Tecla');

             readkey;

             clrscr;

        end;

  '4' : term := true;

     end;

        if (term = false) and ((pul = '1') or (pul = '2')) then

        begin

        juegan[cont] := tab;

        if ci <> false then

        begin

        cont := cont + 1;

        if cont > 6 then

        cont := 6;

        end;

       end;

        until term = true;

    end;

   begin

      clrscr;

      n := 3;

      randomize;

      menu;

 end.