Pascal/Turbo Pascal - SOLITARIO EN PASCAL

PROGRAM SOLITARIO (Input,Output);

Uses CRT;

Type

  T_Palo = (Oros,Copas,Bastos,Espadas);

  T_Numero = 0..12;

  Carta = RECORD

            Numero:T_Numero;

            Palo:T_Palo;

            Flag:Boolean

          END;

  T_Reserva = Array [1..36] of Carta;

  T_Monton = Array [1..4,1..10] of Carta;

  T_Baraja = Array [1..40] of Carta;

Var

  MReserva:T_Reserva;

  MT,MF: T_Monton;

  Baraja:T_Baraja;

  c1,c2,c3,c4,co,cc,cb,ce,cr,cba,sit:Integer;

  Terminar : Boolean;

  Opcion,caracter:Char;

PROCEDURE Limpiar_pantalla;

(*Procedimiento para limpiar la pantalla*)

VAR

 Cont:Integer;

BEGIN

  FOR Cont:= 1 TO 24 DO

    Writeln;

END;

PROCEDURE Eliminar_Mtf(VAR M:T_Monton;Fila:Integer);

(* Elimina la primera posición de una de las filas de la tabla *)

(* bidimensional que actua como montón de trabajo ó de formación *)

VAR

  Cont:Integer;

BEGIN

  FOR Cont:=1 TO 9 DO

    M[Fila,Cont] := M[Fila,Cont+1];

  M[1,10].Numero := 0

END;

PROCEDURE Eliminar_baraja (VAR B1:T_Baraja);

(* Elimina una carta de la Baraja, poniendo la carta Nº 40 a cero. *)

VAR

  Cont:Integer;

BEGIN

  FOR Cont:= 1 TO 39 DO

    B1[Cont] := B1[Cont+1];

  B1[40].Numero := 0;

  B1[40].Flag := false;

END;

PROCEDURE Inicializar_Baraja(VAR B2:T_Baraja);

(* Coloca todas las cartas a valor Numero=0 y Flag=False *)

VAR

  Cont:Integer;

BEGIN

  FOR Cont := 1 TO 40 DO

  BEGIN

    B2[Cont].Numero := 0;

    B2[Cont].Flag := false

  END;

END;

PROCEDURE Barajar (VAR Bar:T_Baraja;VAR Matriz:T_Monton);

(* Barajar la barja y colocar cada una de las cuatro primeras *)

(* cartas de la baraja en cada montón de trabajo. *)

VAR

  I,J,Cont:Integer;

  Contador:T_Palo;

  Num:1..40;

BEGIN

   Randomize;

   Gotoxy(1,1);

   Inicializar_baraja(Bar);

   Cont := 0;

   FOR Contador := Oros TO Espadas DO

   BEGIN

     I:= 1;

     REPEAT

       Num := Random(41);

       IF (Bar[Num].Flag = False) AND (Num<>0)

       THEN BEGIN

              Bar[Num].Numero := 1;

              Bar[Num].Palo := Contador;

              Bar[Num].Flag := True;

              Cont := Cont +1;

              I:=I+1;

            END;

     UNTIL I=8;

     J:=10;

     REPEAT

       Num:= Random(41);

       IF(Bar[Num].Flag = False) AND (Num<>0)

       THEN BEGIN

              Bar[Num].Numero := J;

              Bar[Num].Palo := Contador;

              Bar[Num].Flag := True;

              Cont := Cont+1;

              J:=J+1

            END;

     UNTIL J= 13;

   END;

(* Colocacion de las 4 primeras cartas de la baraja en cada montón de trabajo *)

FOR Cont := 1 TO 4 DO

BEGIN

  Matriz[Cont,1].Numero := Bar[Cont].Numero;

  Matriz[Cont,1].Palo := Bar[Cont].Palo

END;

FOR Cont:=1 TO 4 DO

  Eliminar_baraja(Bar);

END; (*BARAJAR*)

PROCEDURE Mtrabajo (VAR ct_m,ctador: Integer: M1:T_Monton);

(* Escritura tanto de los montones de formación como de trabajo *)

BEGIN

  Write(M1[ct_m,ctador].Numero)

  CASE M1[ct_m,ctador].Palo OF

    Oros: Writeln('Oros');

    Copas: Writeln('Copas');

    Bastos:Writeln('Bastos');

    Espadas:Writeln('Espadas');

  END;

END;

PROCEDURE Mformacion(VAR cont_m,contador:Integer; M2:T_Monton);

(*Escritura tanto de los montones de formación como de trabajo *)

BEGIN

  Write(M2[cont_m,contador].Numero);

  CASE M2[cont_m,contador].Palo OF

    Oros: Writeln('Oros');

    Copas: Writeln('Copas');

    Bastos: Writeln('Bastos');

    Espadas: Writeln('Espadas');

  END;

END;

PROCEDURE Situacion (Mtrab,Mform:T_Monton;Mfreserva:T_Reserva;Mfbaraja:T_Baraja;VAR cuenta:Integer);

(* A partir del cual imprimiremos en OUTPUT la representación gráfica de la cartas que se encuentran *)

(* en cada montón, al igual que le menu de opciones que se encontrará al final dela ejecución de dicho *)

(* Procedimiento. *)

VAR

  I,J,K,L,M,N,NY,O,P,Q,R,m1,m2,m3,m4:Integer;

  Cont,cont1,cont2,cont3,cont4,cont5,cont6,cont7,cont8,cont9:Integer;

BEGIN

  Gotoxy(1,1);

  Textcolor(Blue);

  Writeln('Situacion',cuenta);

  Writeln;

  Textcolor(Red);

  GotoXY(8,3); Write('Monton 1');

  GotoXY(27,3); Write('Monton 2');

  GotoXY(45,3); Write('Monton 3');

  GotoXY(63,3); Write('Monton 4');

  K:= 5;L:=5;M:= 5;N:= 5;

  FOR Cont:=3 DOWNTO 1 DO

    IF Mtrab[m1,Cont].Numero<>0

    THEN BEGIN

           Gotoxy(8,K);

           Mtrabajo(m1,Cont,Mtrab);

           K := K+1;

         END;

  FOR Cont:=3 DOWNTO 1 DO

    IF Mtrab[m2,Cont].Numero<>0

    THEN BEGIN

           Gotoxy(27,L);

           Mtrabajo(m2,Cont,Mtrab);

           L := L+1;

         END;

  FOR Cont:=3 DOWNTO 1 DO

    IF Mtrab[m3,Cont].Numero<>0

    THEN BEGIN

           Gotoxy(45,K);

           Mtrabajo(m3,Cont,Mtrab);

           M := M+1;

         END;

  FOR Cont:=3 DOWNTO 1 DO

    IF Mtrab[m4,Cont].Numero<>0

    THEN BEGIN

           Gotoxy(63,N);

           Mtrabajo(m4,Cont,Mtrab);

           N := N+1;

         END;

Textcolor(Yellow);

Gotoxy(8,9); Write('Oros');

Gotoxy(27,9); Write('Copas');

Gotoxy(45,9); Write('Espadas');

Gotoxy(63,9); Write('Bastos');

NY := 11;0:= 11;P:=11;Q:= 11;

FOR Cont:= 3 DOWNTO 1 DO

  IF Mform[m1,Cont].Numero<>0

  THEN BEGIN

         Gotoxy(8,NY);

         Mformacion(m1,Cont,Mform);

         NY := NY+1;

       END;

FOR Cont:= 3 DOWNTO 1 DO

  IF Mform[m2,Cont].Numero<>0

  THEN BEGIN

         Gotoxy(27,O);

         Mformacion(m2,Cont,Mform);

         O := O+1;

       END;

FOR Cont:= 3 DOWNTO 1 DO

  IF Mform[m3,Cont].Numero<>0

  THEN BEGIN

         Gotoxy(45,P);

         Mformacion(m3,Cont,Mform);

         P := P+1;

       END;

FOR Cont:= 3 DOWNTO 1 DO

  IF Mform[m4,Cont].Numero<>0

  THEN BEGIN

         Gotoxy(63,Q);

         Mformacion(m4,Cont,Mform);

         Q := Q+1;

       END;

Textcolor(Black);

Gotoxy(8,15); Writeln('Reserva');

R := 17;

FOR Cont:= 3 DOWNTO 1 DO

  IF Mfreserva[Cont].Numero <> 0

  THEN BEGIN

         Gotoxy(8,R);

         Write (Mfreserva[Cont].Numero);

         CASE Mfreserva[Cont].Palo OF

            Oros: Writeln('Oros');

            Copas: Writeln('Copas');

            Bastos:Writeln('Bastos');

            Espadas:Writeln('Espadas');

         END;

         R:= R+1;

  END;

END; (* Situacion *)

PROCEDURE Sacar_carta (VAR mb:T_Baraja; Var mr:T_Reserva)

(* Sacamos una carta de la baraja y la introducimos en el montón de *)

(* reserva, incrementando respectivamnete los contadores del montón de *)

(* baraja y reserva. *)

VAR

  Cont:Integer;

BEGIN

  mr[1].Numero := mb[1].Numero;

  mr[1].Palo := mb[1].Palo;

  Eliminar_baraja[mb];

  IF mr[1].Numero <> 0

  THEN BEGIN

         FOR Cont := 1 TO 9 DO

           mr[10].Numero :=  0;

       END

       ELSE

          Write('Ya no existen más cartas para sacar');

END;

PROCEDURE Reorganizar

VAR

  monton,p_monton:Char;

BEGIN

  Writeln('Pasar carta del montón 1,2,3,4,'O'ROS,'C'OPAS,'B'ASTOS,'E'SPADAS,'R'ESERVA:');

  Read(monton);

  Writeln('al montón '1','2','3','4','O'ROS,'C'OPAS,'B'ASTOS,'E'SPADAS,'R'ESERVA');

  Read(p_monton);

END;

BEGIN (* SOLITARIO *)

  Limpiar_pantalla;

  Textbackground(White);

  Terminar:=False;

  Barajar(Baraja,MT);

  sit:=1;

  WHILE NOT Terminar DO

  BEGIN

    Limpiar_pantalla;

    Situacion(MT,MF,MReserva,Baraja,sit);

    Gotoxy(1,21);

    Write(''S'acar carta,'R'eorganizar ó 'F'inalizar?'=;

    Read(Opcion);

    CASE Opcion OF

       'S','s':Sacar_carta(Baraja,MReserva);

       'R','r':Reorganizar;

       'F','f':Terminar:=True;

    END;

  END;

END.

PROCEDURE Reorganizar

VAR

monton,p_monton:Char;

BEGIN

Writeln('Pasar carta del montón 1,2,3,4,'O'ROS,'C'OPAS,'B'ASTOS,'E'SPADAS,'R'ESERVA:');

Read(monton);

Writeln('al montón '1','2','3','4','O'ROS,'C'OPAS,'B'ASTOS,'E'SPADAS,'R'ESERVA');

Read(p_monton);

END;

{Esto por si solo no organiza nada solo toma datos }

PROCEDURE Reorganizar;

BEGIN

   Limpiar_pantalla;

   Textbackground(White);

   Terminar:=False;

   Barajar(Baraja,MT);

   fillchar(MReserva,sizeof(MReserva),0);

   sit:=1;

   delay(299);

   clrscr;

END;

{Ejecuta esto y mira las cartas que sean cargado}

PROGRAM SOLITARIO (Input,Output);

Uses CRT;

Type

T_Palo = (Oros,Copas,Bastos,Espadas);

T_Numero = 0..12;

Carta = RECORD

Numero:T_Numero;

Palo:T_Palo;

Flag:Boolean

END;

T_Reserva = Array [1..36] of Carta;

T_Monton = Array [1..4,1..10] of Carta;

T_Baraja = Array [1..40] of Carta;

Var

MReserva:T_Reserva;

MT,MF: T_Monton;

Baraja:T_Baraja;

coo,nn, c1,c2,c3,c4,co,cc,cb,ce,cr,cba,sit:Integer;

Terminar : Boolean;

Opcion,caracter:Char;

pal : string[7];

PROCEDURE Limpiar_pantalla;

(*Procedimiento para limpiar la pantalla*)

VAR

Cont:Integer;

BEGIN

FOR Cont:= 1 TO 24 DO

Writeln;

END;

PROCEDURE Eliminar_Mtf(VAR M:T_Monton;Fila:Integer);

(* Elimina la primera posición de una de las filas de la tabla *)

(* bidimensional que actua como montón de trabajo ó de formación *)

VAR

Cont:Integer;

BEGIN

FOR Cont:=1 TO 9 DO

M[Fila,Cont] := M[Fila,Cont+1];

M[1,10].Numero := 0

END;

PROCEDURE Eliminar_baraja (VAR B1:T_Baraja);

(* Elimina una carta de la Baraja, poniendo la carta Nº 40 a cero. *)

VAR

Cont:Integer;

BEGIN

FOR Cont:= 1 TO 39 DO

B1[Cont] := B1[Cont+1];

B1[40].Numero := 0;

B1[40].Flag := false;

END;

PROCEDURE Inicializar_Baraja(VAR B2:T_Baraja);

(* Coloca todas las cartas a valor Numero=0 y Flag=False *)

VAR

Cont:Integer;

BEGIN

FOR Cont := 1 TO 40 DO

BEGIN

B2[Cont].Numero := 0;

B2[Cont].Flag := false

END;

END;

PROCEDURE Barajar (VAR Bar:T_Baraja;VAR Matriz:T_Monton);

(* Barajar la barja y colocar cada una de las cuatro primeras *)

(* cartas de la baraja en cada montón de trabajo. *)

VAR

I,J,Cont:Integer;

Contador:T_Palo;

Num:1..40;

BEGIN

Randomize;

Gotoxy(1,1);

Inicializar_baraja(Bar);

Cont := 0;

FOR Contador := Oros TO Espadas DO

BEGIN

I:= 1;

REPEAT

Num := Random(41);

IF (Bar[Num].Flag = False) AND (Num<>0)

THEN BEGIN

Bar[Num].Numero := 1;

Bar[Num].Palo := Contador;

Bar[Num].Flag := True;

Cont := Cont +1;

I:=I+1;

END;

UNTIL I=8;

J:=10;

REPEAT

Num:= Random(41);

IF(Bar[Num].Flag = False) AND (Num<>0)

THEN BEGIN

Bar[Num].Numero := J;

Bar[Num].Palo := Contador;

Bar[Num].Flag := True;

Cont := Cont+1;

J:=J+1

END;

UNTIL J= 13;

END;

(* Colocacion de las 4 primeras cartas de la baraja en cada montón de trabajo *)

FOR Cont := 1 TO 4 DO

BEGIN

Matriz[Cont,1].Numero := Bar[Cont].Numero;

Matriz[Cont,1].Palo := Bar[Cont].Palo

END;

FOR Cont:=1 TO 4 DO

Eliminar_baraja(Bar);

END; (*BARAJAR*)

PROCEDURE Mtrabajo (VAR ct_m,ctador: Integer; M1:T_Monton);

(* Escritura tanto de los montones de formación como de trabajo *)

BEGIN

Write(M1[ct_m,ctador].Numero);

CASE M1[ct_m,ctador].Palo OF

Oros: Writeln('Oros');

Copas: Writeln('Copas');

Bastos:Writeln('Bastos');

Espadas:Writeln('Espadas');

END;

END;

PROCEDURE Mformacion(VAR cont_m,contador:Integer; M2:T_Monton);

(*Escritura tanto de los montones de formación como de trabajo *)

BEGIN

Write(M2[cont_m,contador].Numero);

CASE M2[cont_m,contador].Palo OF

Oros: Writeln('Oros');

Copas: Writeln('Copas');

Bastos: Writeln('Bastos');

Espadas: Writeln('Espadas');

END;

END;

PROCEDURE Situacion (Mtrab,Mform:T_Monton;Mfreserva:T_Reserva;Mfbaraja:T_Baraja;VAR cuenta:Integer);

(* A partir del cual imprimiremos en OUTPUT la representación gráfica de la cartas que se encuentran *)

(* en cada montón, al igual que le menu de opciones que se encontrará al final dela ejecución de dicho *)

(* Procedimiento. *)

VAR

I,J,K,L,M,N,NY,O,P,Q,R,m1,m2,m3,m4:Integer;

Cont,cont1,cont2,cont3,cont4,cont5,cont6,cont7,cont8,cont9:Integer;

BEGIN

Gotoxy(1,1);

Textcolor(Blue);

Writeln('Situacion',cuenta);

Writeln;

Textcolor(Red);

GotoXY(8,3); Write('Monton 1');

GotoXY(27,3); Write('Monton 2');

GotoXY(45,3); Write('Monton 3');

GotoXY(63,3); Write('Monton 4');

K:= 5;L:=5;M:= 5;N:= 5;

FOR Cont:=3 DOWNTO 1 DO

IF Mtrab[m1,Cont].Numero<>0

THEN BEGIN

Gotoxy(8,K);

Mtrabajo(m1,Cont,Mtrab);

K := K+1;

END;

FOR Cont:=3 DOWNTO 1 DO

IF Mtrab[m2,Cont].Numero<>0

THEN BEGIN

Gotoxy(27,L);

Mtrabajo(m2,Cont,Mtrab);

L := L+1;

END;

FOR Cont:=3 DOWNTO 1 DO

IF Mtrab[m3,Cont].Numero<>0

THEN BEGIN

Gotoxy(45,K);

Mtrabajo(m3,Cont,Mtrab);

M := M+1;

END;

FOR Cont:=3 DOWNTO 1 DO

IF Mtrab[m4,Cont].Numero<>0

THEN BEGIN

Gotoxy(63,N);

Mtrabajo(m4,Cont,Mtrab);

N := N+1;

END;

Textcolor(Yellow);

Gotoxy(8,9); Write('Oros');

Gotoxy(27,9); Write('Copas');

Gotoxy(45,9); Write('Espadas');

Gotoxy(63,9); Write('Bastos');

NY := 11;o:= 11;P:=11;Q:= 11;

FOR Cont:= 3 DOWNTO 1 DO

IF Mform[m1,Cont].Numero<>0

THEN BEGIN

Gotoxy(8,NY);

Mformacion(m1,Cont,Mform);

NY := NY+1;

END;

FOR Cont:= 3 DOWNTO 1 DO

IF Mform[m2,Cont].Numero<>0

THEN BEGIN

Gotoxy(27,O);

Mformacion(m2,Cont,Mform);

O := O+1;

END;

FOR Cont:= 3 DOWNTO 1 DO

IF Mform[m3,Cont].Numero<>0

THEN BEGIN

Gotoxy(45,P);

Mformacion(m3,Cont,Mform);

P := P+1;

END;

FOR Cont:= 3 DOWNTO 1 DO

IF Mform[m4,Cont].Numero<>0

THEN BEGIN

Gotoxy(63,Q);

Mformacion(m4,Cont,Mform);

Q := Q+1;

END;

Textcolor(Black);

Gotoxy(8,15); Writeln('Reserva');

R := 17;

FOR Cont:= 3 DOWNTO 1 DO

IF Mfreserva[Cont].Numero <> 0

THEN BEGIN

Gotoxy(8,R);

Write (Mfreserva[Cont].Numero);

CASE Mfreserva[Cont].Palo OF

Oros: Writeln('Oros');

Copas: Writeln('Copas');

Bastos:Writeln('Bastos');

Espadas:Writeln('Espadas');

END;

R:= R+1;

END;

END; (* Situacion *)

PROCEDURE Sacar_carta (VAR mb:T_Baraja; Var mr:T_Reserva);

(* Sacamos una carta de la baraja y la introducimos en el montón de *)

(* reserva, incrementando respectivamnete los contadores del montón de *)

(* baraja y reserva. *)

VAR

Cont:Integer;

BEGIN

mr[1].Numero := mb[1].Numero;

mr[1].Palo := mb[1].Palo;

Eliminar_baraja(mb);

IF mr[1].Numero <> 0

THEN BEGIN

FOR Cont := 1 TO 9 DO

mr[10].Numero := 0;

END

ELSE

Write('Ya no existen más cartas para sacar');

END;

PROCEDURE Reorganizar;

VAR

monton,p_monton:Char;

BEGIN

Writeln('Pasar carta del montón 1,2,3,4,O ROS, C OPAS, B ASTOS, E SPADAS, R ESERVA:');

Read(monton);

Writeln('al montón 1   2   3   4   O ROS  C OPAS  B ASTOS  E SPADAS  R ESERVA');

Read(p_monton);

END;

BEGIN (* SOLITARIO *)

TextMode(C80 + Font8x8);

Limpiar_pantalla;

Terminar:=False;

Barajar(Baraja,MT);

sit:=1;

clrscr;

Textbackground(0);

for nn := 4 downto 1 do

 begin

   case nn of

 4 : pal := 'Espadas';

 3 : pal := 'Bastos';

 2 : pal := 'Copas';

 1 : pal := 'Oros';

   end;

   for coo := 1 to 10 do

   begin

      writeln('  ',baraja[coo].numero,'   ',pal,'   ',baraja[coo].flag);

   end;

  end;

 readkey;

 Textbackground(White);

 clrscr;

WHILE NOT Terminar DO

BEGIN

Limpiar_pantalla;

Situacion(MT,MF,MReserva,Baraja,sit);

Gotoxy(1,21);

Write(' S acar carta  R eorganizar  F inalizar');

Read(Opcion);

CASE Opcion OF

'S','s':Sacar_carta(Baraja,MReserva);

'R','r':Reorganizar;

'F','f':Terminar:=True;

END;

END;

END.

{Mira esto creo te ayudara }

program solitario;

 uses

    crt;

  const

      elpalo : array[1..4] of string[7] = ('Oros','Espadas','Copas','Vastos');

  type

     carta = record

              palo : string[7];

              nume : integer;

           end;

     labaraja = array[1..4,1..10] of carta;

     eljuego = array[1..4,1..10] of carta;

     elmonton = array[1..40] of carta;

   var

   monton : elmonton;

   baraja : labaraja;

   juego : eljuego;

   reset : elmonton;

   m1, m2, m3, m4, res, cont, h, t, m : integer;

   tecla : char;

   azti : boolean;

   procedure limpiado_inicio;

   begin

      fillchar(monton,sizeof(monton),0);

      fillchar(baraja,sizeof(baraja),0);

      fillchar(juego,sizeof(juego),0);

      fillchar(reset,sizeof(reset),0);

   end;

   procedure crea_cartas(var cc : labaraja);

   var

     esta : boolean;

   begin

      for cont := 1 to 4 do

      begin

         h := 1;

         repeat

             t := random(40) + 1;

             case t of

           1..10 : t := t;

          11..20 : t := t - 10;

          21..30 : t := t - 20;

          31..40 : t := t - 30;

              end;

          case t of

        8 : t := 10;

        9 : t := 11;

       10 : t := 12;

           end;

             esta := false;

             for m := h - 1 downto 1 do

             begin

             if cc[cont,m].nume = t then

             begin

             esta := true;

             break;

             end;

             end;

             if esta = false then

             begin

                if t <= 7 then

                cc[cont,h].nume := t;

                if t > 7 then

                begin

                  case t of

                10 : cc[cont,h].nume := 10;

                11 : cc[cont,h].nume := 11;

                12 : cc[cont,h].nume := 12;

                  end;

                end;

                cc[cont,h].palo := elpalo[cont];

                h := h + 1;

                t := 0;

             end;

         until h > 10;

      end;

   end;

    procedure ordena(var nn : labaraja);

    var

      k, y, x : integer;

      auxi : carta;

    begin

       for y := 1 to 4 do

       begin

           for k := 1 to 10 do

            for x := k + 1 to  10 do

            if nn[y,x].nume < nn[y,k].nume then

            begin

               auxi := nn[y,x];

               nn[y,x] := nn[y,k];

               nn[y,k] := auxi;

            end;

       end;

    end;

   procedure  barajear;

   var

     m1, n2, p, v1, r2 : integer;

    begin

        p := 1;

        m1 := 1;

        n2 := 5;

    repeat

        v1 := m1;

        r2 := n2;

      repeat

          monton[p] := baraja[v1,r2];

          p := p + 1;

          r2 := r2 - 1;

          v1 := v1 + 1;

      until v1 > 4;

      m1 := m1 + 1;

      n2 := n2 + 1;

      if n2 > 10 then

      n2 := 1;

      if m1 > 4 then

      m1 := 1;

    until p > 40;

    end;

  procedure ponestado_juego(h : eljuego; dd : integer);

  var

    z, v, n : integer;

  begin

     for z := 1 to 4 do

     begin

    case z of

 1 : n := 10;

 2 : n := 24;

 3 : n := 38;

 4 : n := 52;

   end;

       for v := 1 to 10 do

       begin

       if (h[z,v].nume > 0) and (h[z,v].palo > '') then

       begin

          gotoxy(n,7 + v);clreol;

          gotoxy(n,7 + v);write(h[z,v].nume,' ',h[z,v].palo);

       end

    else

       begin

          gotoxy(n,7 + v);write('----------');

       end;

     end;

   end;

      if (reset[dd].nume > 0) and (reset[dd].palo > '') then

      begin

      gotoxy(66,7 + dd);clreol;

      gotoxy(66,7 + dd);write(reset[dd].nume,'   ',reset[dd].palo);

      end

    else

       begin

        gotoxy(66,7);write('__________');

      end;

  end;

   procedure presenta_pantalla;

   begin

      clrscr;

      gotoxy(12,2);write('****** El Juego Del Solitario ******');

      gotoxy(12,3);write('ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');

      gotoxy(11,5);write('Mt. 1         Mt. 2         Mt. 3         Mt. 4   ');

      gotoxy(11,6);write('Oros          Copas         Bastos        Espadas ');

      gotoxy(68,6);write('Reserva');

      ponestado_juego(juego,res);

   end;

  procedure pon_cartas_inicio;

  begin

     gotoxy(10,8);write('            ');

     gotoxy(10,8);write(monton[1].nume,'  ',monton[1].palo);

     juego[1,1] := monton[1];

     gotoxy(24,8);write('            ');

     gotoxy(24,8);write(monton[2].nume,'  ',monton[2].palo);

     juego[2,1] := monton[2];

     gotoxy(38,8);write('            ');

     gotoxy(38,8);write(monton[3].nume,'  ',monton[3].palo);

     juego[3,1] := monton[3];

     gotoxy(52,8);write('            ');

     gotoxy(52,8);write(monton[4].nume,'  ',monton[4].palo);

     juego[4,1] := monton[4];

     m1 := 1;

     m2 := 1;

     m3 := 1;

     m4 := 1;

  end;

  procedure reorganiza;

  var

    mt1, mt2 : char;

    dato1 : eljuego;

  begin

     gotoxy(2,28);write('Sacar Del Monton [1, 2, 3, 4, R] = ',

                            'Oros, Copas, Bastos, Espadas, Reserva');

     gotoxy(75,28);readln(mt1);

     gotoxy(2,29);write('Al Monton [1, 2, 3, 4, R] = ',

                            'Oros, Copas, Bastos, Espadas, Reserva');

     gotoxy(68,29);readln(mt2);

     fillchar(dato1[1,1],sizeof(dato1[1,1]),0);

     case mt1 of

  '1' : begin

          if m1 > 0 then

          begin

          dato1[1,1] := juego[1,m1];

          fillchar(juego[1,m1],sizeof(juego[1,m1]),0);

          m1 := m1 - 1;

          if m1 < 0 then

          m1 := 0;

          end;

        end;

  '2' : begin

          if m2 > 0 then

          begin

          dato1[1,1] := juego[2,m2];

          fillchar(juego[2,m2],sizeof(juego[2,m2]),0);

          m2 := m2 - 1;

          if m2 < 0 then

          m2 := 0;

          end;

        end;

  '3' : begin

          if m3 > 0 then

          begin

          dato1[1,1] := juego[3,m3];

          fillchar(juego[3,m3],sizeof(juego[3,m3]),0);

          m3 := m3 - 1;

          if m3 < 0 then

          m3 := 0;

          end;

        end;

  '4' : begin

          if m4 > 0 then

          begin

          dato1[1,1] := juego[4,m4];

          fillchar(juego[4,m4],sizeof(juego[4,m4]),0);

          m4 := m4 - 1;

          if m4 < 0 then

          m4 := 0;

          end;

        end;

  'R','r' : begin

             if res > 0 then

             begin

             dato1[1,1] := reset[res - 1];

             fillchar(reset[res - 1],sizeof(reset[res - 1]),0);

             res := res - 1;

             if res < 0 then

             res := 0;

            end;

        end;

    end;

     case mt2 of

  '1' : begin

          if m1 < 10 then

          begin

             m1 := m1 + 1;

             juego[1,m1] := dato1[1,1];

          end;

        end;

  '2' : begin

          if m2 < 10 then

          begin

            m2 := m2 + 1;

            juego[2,m2] := dato1[1,1];

          end;

        end;

  '3' : begin

          if m3 < 10 then

          begin

             m3 := m3 + 1;

             juego[3,m3] := dato1[1,1];

          end;

        end;

  '4' : begin

          if m4 < 10 then

          begin

             m4 := m4 + 1;

             juego[4,m4] := dato1[1,1];

          end;

        end;

  'R','r' : begin

              if res < 40 then

              begin

                res := res + 1;

                reset[res] := dato1[1,1];

              end;

            end;

     end;

     gotoxy(2,28);clreol;

     gotoxy(2,29);clreol;

     ponestado_juego(juego,res);

  end;

  procedure saca_carta;

  begin

     if azti = true then

     begin

       reset[res] := monton[cont - 1];

       azti := false;

     end;

     gotoxy(10,18);clreol;

     gotoxy(10,18);write(monton[cont].nume,'   ',monton[cont].palo);

     cont := cont + 1;

  end;

  procedure menu;

  var

     salir : boolean;

   begin

      clrscr;

      m1 := 0;

      m2 := 0;

      m3 := 0;

      m4 := 0;

      limpiado_inicio;

      crea_cartas(baraja);

      ordena(baraja);

      barajear;

      presenta_pantalla;

      pon_cartas_inicio;

      salir := false;

      azti := false;

      res := 1;

      cont := 5;

    repeat

        textcolor(10);

        gotoxy(28,19);write('Menu Solitario');

        gotoxy(14,21);write('[S]=sacar carta   [R]=reorganizar   [F]=finalizar');

        gotoxy(28,23);write('Elija Opcion');

        textcolor(7);

        repeat

        tecla := upcase(readkey);

        until tecla in['S','R','F'];

     case tecla of

  'S' : begin

          saca_carta;

          azti := true;

          ponestado_juego(juego,res);

          res := res + 1;

        end;

  'R' : reorganiza;

  'F' : salir := true;

    end;

    until salir = true;

      end;

   begin

      menu;

   end.