2015. január 3., szombat

Pascal bitvektoros halmaz ábrázolás példája. Magyar kártya-halmaz típusa.

Unit Halmaz;
(*
   Bitvektoros halmaz br zol s p‚ld ja.
   Magyar k rtya-halmaz tĄpusa.
   Asszoci lt mveletek:      (K‚szs‚g)
   -------------- THalmaz(TKartya) ---------------
   * TeljesPakli                  +
   * UresPakli                    +
   * TeljesPakliE                 +
   * UresPakliE                   +
   * Kozetesz                     +
   * Elvesz                       +
   * BenneVanE                    +
   * Egyesit                      +
   * Kozosek                      +
   * LegjobbLap                   +
   * LegrosszabbLap               +
   * VeletlenLap                  +
   . . . . . .
   * BePakli                      +
   * KiPakli                      +
   * HibasEPakli                  +
   ------------------- TKartya  -------------------
   * Kartya                       +
   * KartyaSzin                   +
   * KartyaFigura                 +
   . . . . . .
   * BeKartya                     +
   * KiKartya                     +
*)
  Interface
    Type
      TFigura = (VII,VIII,IX,X,Also,Felso,Kiraly,Asz);
      TSzin   = (Makk,Piros,Tok,Zold); {N‚vsor-szerinti "er”sorrendben"}
      THalmaz = Record
                  lapok: Array [TSzin,TFigura] of Boolean;
                  siker: Boolean;
                End;
      TKartya = Record szin:TSzin; figura:TFigura End;
    Const
      MaxKartyaDb = (Ord(Zold)+1)*(Ord(Asz));
      SFigura : Array [TFigura] of String[6]=('VII','VIII','IX','X',
                                              'Also','Felso','Kiraly',
                                              'Asz');
      SSzin   : Array [TSzin] of String[5]=('Makk','Piros','Tok','Zold');

    Function KodbolSzin(Const kod:Byte):TSzin;
    {Ef: kod ELEME [0..SZAMOSSAG'TSzin)
     Uf: SORSZAM(KodbolSzin(kod))}
    Function KodbolFigura(Const kod:Byte):TFigura;
    {Ef: kod ELEME [0..SZAMOSSAG'TFigura)
     Uf: SORSZAM(KodbolFigura(kod))}

    Procedure TeljesPakli(Var p:THalmaz);
    {Ef: -
     Uf: MINDEN s:TSzin, MINDEN f:TFigura: p.lapok[s,f] ES
         p.siker}
    Function TeljesPakliE(Const p:THalmaz):Boolean;
    {Ef: -
     Uf: TeljesPakliE(p) <=> MINDEN s:TSzin, MINDEN f:TFigura:
                                                          p.lapok[s,f]}
    Procedure UresPakli(Var p:THalmaz);
    {Ef: -
     Uf: MINDEN s:TSzin, MINDEN f:TFigura: NEM p.lapok[s,f] ES
         p.siker}
    Function UresPakliE(Var p:THalmaz):Boolean;
    {Ef: -
     Uf: UresPakliE(p) <=> MINDEN s:TSzin, MINDEN f:TFigura:
                                                       NEM p.lapok[s,f]}
    Procedure Kozetesz(Var p:THalmaz; Const k:TKartya);
    {Ef: -
     Uf: k=(s,f) ES p.lapok[s,f]}
    Procedure Elvesz(Var p:THalmaz; Const k:TKartya);
    {Ef: k=(s,f) ES p.lapok[s,f]
     Uf: k=(s,f) ES NEM p.lapok[s,f]}
    Function  BenneVanE(Var p:THalmaz; Const k:TKartya):Boolean;
    {Ef: -
     Uf: BenneVanE(p,k) <=> k=(s,f) ES p.lapok[s,f] }
    Procedure Egyesit(Const p1,p2:THalmaz; Var p:THalmaz);
    {Ef: -
     Uf: ...}
    Procedure Kozosek(Const p1,p2:THalmaz; Var p:THalmaz);
    {Ef: -
     Uf: ...}
    Procedure LegjobbLap(Var p:THalmaz; Var k:TKartya);
    {Ef: NEM UresPakliE(p)
     Uf: k=(s,f) ES MINDEN kk:TKartya: kk=(ss,ff) ES
                                       BenneVanE(ss,ff) ES
                                       JobbE(ss,ff),(s,f))}
    Procedure LegrosszabbLap(Var p:THalmaz; Var k:TKartya);
    {Ef: NEM UresPakliE(p)
     Uf: ...}
    Procedure VeletlenLap(Var p:THalmaz; Var k:TKartya);
    {Ef: NEM UresPakliE(p)
     Uf: BenneVan(p,k)}
    Procedure BePakli(Var p:THalmaz);
    {Ef: -
     Uf: ...}
    Procedure KiPakli(Const p:THalmaz);
    {Ef: -
     Uf: ...}
    Function HibasEPakli(Var p:THalmaz):Boolean;
    {Ef: -
     Uf: HibasEPakli=not(p.siker) ES p'.siker }

    Procedure Kartya(Var k:TKartya; Const s:TSzin; Const f:TFigura);
    {Ef: -
     Uf: k=(s,f)}
    Function KartyaSzin(Const k:TKartya):TSzin;
    {Ef: -
     Uf: KartyaSzin(k)=s <=> k=(s,f)}
    Function KartyaFigura(Const k:TKartya):TFigura;
    {Ef: -
     Uf: KartyaFigura(k)=f <=> k=(s,f)}
    Procedure BeKartya(Var k:TKartya);
    {Ef: -
     Uf: ...}
    Procedure KiKartya(Const k:TKartya);
    {Ef: -
     Uf: ...}

  Implementation

    Uses Crt; {az AltRutin.inc kĄv nja meg}
    {$i AltRutin.inc}

    {------------------------ SzĄn ‚s Figura: ------------------------}

    Function KodbolSzin(Const kod:Byte):TSzin;
    {Ef: kod ELEME [0..SZAMOSSAG'TSzin)
     Uf: SORSZAM(KodbolSzin(kod))}
      Var
        s:TSzin;
    Begin {az Ef-t nem ellen”rizzk}
      s:=Makk;
      While Ord(s)<kod do s:=succ(s);
      KodbolSzin:=s
    End{KodBolSzin};

    Function KodbolFigura(Const kod:Byte):TFigura;
    {Ef: kod ELEME [0..SZAMOSSAG'TFigura)
     Uf: SORSZAM(KodbolFigura(kod))}
      Var
        f:TFigura;
    Begin {az Ef-t nem ellen”rizzk}
      f:=VII;
      While Ord(f)<kod do f:=succ(f);
      KodbolFigura:=f
    End{KodBolFigura};

    {---------------------------- Halmaz: ----------------------------}

    Procedure TeljesPakli(Var p:THalmaz);
    {Ef: -
     Uf: MINDEN s:TSzin, MINDEN f:TFigura: p.lapok[s,f]}
      Var
        s:TSzin; f:TFigura;
    Begin
      For s:=Makk to Zold do
      Begin
        For f:=VII to Asz do
        Begin
          p.lapok[s,f]:=True
        End;
      End;
      p.siker:=True
    End;{TeljesPakli}

    Function TeljesPakliE(Const p:THalmaz):Boolean;
    {Ef: -
     Uf: TeljesPakliE(p) <=> MINDEN s:TSzin, MINDEN f:TFigura:
                                                          p.lapok[s,f]}
      Var
        s:TSzin; f:TFigura; db:Byte;
    Begin
     {
      db:=0;
      For s:=Makk to Zold do
      Begin
        For f:=VII to Asz do
        Begin
          If not(p.lapok[s,f]) then Inc(db)
        End;
      End;
      TeljesPakliE:=(db=0)
      }
      s:=Makk; f:=VII;
      while (p.lapok[s,f]) and not((s=Zold) and (f=Asz)) do
       begin
        if f=Asz
         then
          begin
           s:=succ(s);
           f:=VII;
          end
         else f:=succ(f);
       end;
      TeljesPakliE:=p.lapok[s,f];

    End;{TeljesPakliE}

    Procedure UresPakli(Var p:THalmaz);
    {Ef: -
     Uf: MINDEN s:TSzin, MINDEN f:TFigura: NEM p.lapok[s,f]}
      Var
        s:TSzin; f:TFigura;
    Begin
      For s:=Makk to Zold do
      Begin
        For f:=VII to Asz do
        Begin
          p.lapok[s,f]:=False
        End;
      End;
      p.siker:=True
    End;{UresPakli}

    Function UresPakliE(Var p:THalmaz):Boolean;
    {Ef: -
     Uf: UresPakliE(p) <=> MINDEN s:TSzin, MINDEN f:TFigura:
                                                     NEM p.lapok[s,f]}
      Var
        s:TSzin; f:TFigura; db:Byte;
    Begin
      db:=0;
      For s:=Makk to Zold do
      Begin
        For f:=VII to Asz do
        Begin
          If p.lapok[s,f] then Inc(db)
        End;
      End;
      UresPakliE:=db=0
    End;{UresPakliE}

    Procedure Kozetesz(Var p:THalmaz; Const k:TKartya);
    {Ef: -
     Uf: k=(s,f) ES p.lapok[s,f]}
    Begin
      p.lapok[k.szin,k.figura]:=True
    End;{Kozetesz}

    Procedure Elvesz(Var p:THalmaz; Const k:TKartya);
    {Ef: k=(s,f) ES p.lapok[s,f]
     Uf: k=(s,f) ES NEM p.lapok[s,f]}
    Begin
      If not p.lapok[k.szin,k.figura] then {nem teljesl az Ef}
      Begin
        p.siker:=False
      End
        Else
      Begin
        p.lapok[k.szin,k.figura]:=False
      End;
    End;{Elvesz}

    Function  BenneVanE(Var p:THalmaz; Const k:TKartya):Boolean;
    {Ef: -
     Uf: BenneVanE(p,k) <=> k=(s,f) ES p.lapok[s,f] }
    Begin
      BenneVanE:=p.lapok[k.szin,k.figura]
    End;{BenneVanE}

    Procedure Egyesit(Const p1,p2:THalmaz; Var p:THalmaz);
    {Ef: -
     Uf: ...}
     Var
        s:TSzin; f:TFigura; db:Byte;

    Begin
      for s:=Makk to Zold do
       for f:=VII to Asz do p.lapok[s,f]:=p1.lapok[s,f] or p2.lapok[s,f];

    End;{Egyesit}

    Procedure Kozosek(Const p1,p2:THalmaz; Var p:THalmaz);
    {Ef: -
     Uf: ...}
    Var
        s:TSzin; f:TFigura; db:Byte;

    Begin
      for s:=Makk to Zold do
       for f:=VII to Asz do p.lapok[s,f]:=p1.lapok[s,f] and p2.lapok[s,f];
    End;{Kozosek}

    Procedure LegjobbLap(Var p:THalmaz; Var k:TKartya);
    {Makk VII, MAKK VIII, ..., Zold Asz}
    {Ef: NEM UresPakliE(p)
     Uf: k=(s,f) ES MINDEN kk:TKartya: kk=(ss,ff) ES
                                       BenneVanE(ss,ff) ES
                                       JobbE(ss,ff),(s,f))}
      Var
        s:TSzin; f:TFigura;
    Begin
      If UresPakliE(p) then {nem teljesl az Ef}
      Begin
        p.siker:=False
      End
        Else
      Begin
        s:=Makk; f:=VII;
        While ((s<Zold) or ((s=Zold) and (f<Asz))) and
              not p.lapok[s,f] do
        Begin
          If f<Asz then f:=succ(f)
                   else Begin s:=succ(s); f:=VII end;
        End;
        k.szin:=s; k.figura:=f;
      End;
    End;{LegjobbLap}

    Procedure LegrosszabbLap(Var p:THalmaz; Var k:TKartya);
    {Zold Asz, ... , Makk VIII, MAKK VII}
    {Ef: NEM UresPakliE(p)
     Uf: ...}
      Var
        s:TSzin; f:TFigura;
    Begin
      If UresPakliE(p) then {nem teljesl az Ef}
      Begin
        p.siker:=False
      End
        Else
      Begin
        s:=Zold; f:=Asz;
        While ((s>Makk) or ((s=Makk) and (f>VII))) and
              not p.lapok[s,f] do
        Begin
          If f>VII then f:=pred(f)
                   else Begin s:=pred(s); f:=Asz end;
        End;
        k.szin:=s; k.figura:=f;
      End;
    End;{LegrosszabbLap}

    Procedure VeletlenLap(Var p:THalmaz; Var k:TKartya);
    {Ef: NEM UresPakliE(p)
     Uf: BenneVan(p,k)}
      Var
        s:TSzin; f:TFigura;
    Begin
      If UresPakliE(p) then {nem teljesl az Ef}
      Begin
        p.siker:=False
      End
        Else
      Begin
        Repeat
          s:=KodbolSzin(Random(4)); f:=KodbolFigura(Random(8));
        Until p.lapok[s,f];
        k.szin:=s; k.figura:=f
      End;
    End;{VeletlenLap}

    Procedure BePakli(Var p:THalmaz);
    {Ef: ...
     Uf: ...}
    Var V: Char; K: TKartya;
    Begin
     UresPakli(p);
     Repeat
      Writeln('K‚rem adjon meg egy k rty t (szĄn,figura)');
      BeKartya(k);
      If not (BenneVanE(p,k)) then Kozetesz(p,k);
      Writeln('Add meg m‚g k rty t? (i/n)');
      Readln(V);
     Until V='n'
    End;{BePakli}

    Procedure KiPakli(Const p:THalmaz);
    {Ef: -
     Uf: ...}
      Var
        s:TSzin; f:TFigura;
    Begin
      For s:=Makk to Zold do
      Begin
        Write(SSzin[s]:6,':');
        For f:=VII to Asz do
        Begin
          If p.lapok[s,f] then Write(SFigura[f],' ')
        End;
        Writeln;
      End;
    End;{KiPakli}

    Function HibasEPakli(Var p:THalmaz):Boolean;
    {Ef: -
     Uf: HibasEPakli=not(p.siker) ES p'.siker }
    Begin
      HibasEPakli:=not(p.siker);
      p.siker:=True
    End;{HibasEPakli}

    {---------------------------- K rtya: ----------------------------}

    Procedure Kartya(Var k:TKartya; Const s:TSzin; Const f:TFigura);
    {Ef: -
     Uf: k=(s,f)}
    Begin
      k.szin:=s; k.figura:=f
    End;{Kartya}

    Function KartyaSzin(Const k:TKartya):TSzin;
    {Ef: -
     Uf: KartyaSzin(k)=s <=> k=(s,f)}
    Begin
      KartyaSzin:=k.szin
    End;{KartyaSzin}

    Function KartyaFigura(Const k:TKartya):TFigura;
    {Ef: -
     Uf: KartyaFigura(k)=f <=> k=(s,f)}
    Begin
      KartyaFigura:=k.figura
    End;{KartyaFigura}

    Procedure BeKartya(Var k:TKartya);
    {Ef: ... SZIN + ',' FIGURA alakban
     Uf: ...}
      Var
        sk,ss,sf:String;
        s:TSzin; f:TFigura;
        hol:Integer;
    Begin {az Ef-et nem ellen”rizzk}
      Readln(sk); sk:=StringUpCase(sk);
      hol:=Pos(',',sk); ss:=Copy(sk,1,hol-1); sf:=Copy(sk,hol+1,Length(sk));
      {Szin-k˘dol s:}
      s:=Makk;
      While (s<Zold) and (StringUpCase(SSzin[s])<>ss) do s:=succ(s);
      k.szin:=s;
      {Figura-k˘dol s:}
      f:=VII;
      While (f<Asz) and (StringUpCase(SFigura[f])<>sf) do f:=succ(f);
      k.figura:=f;
    End;{BeKartya}

    Procedure KiKartya(Const k:TKartya);
    {Ef: -
     Uf: ...}
    Begin
      Writeln(SSzin[k.szin],' ',SFigura[k.figura]);
    End;{KiKartya}

Begin
End.

Nincsenek megjegyzések:

Megjegyzés küldése