Записи, помогите сократить задачу Опции

[БелАчкА]

Сама задача простая: бьет ли карта 1 карту 2 с учетом козырной масти. Но! препод помешана на менюшках, требует, чтобы все было максимально удобно для пользователя и всевозможные случаи были учтены...естественно, достоинства карт и масти должны вводится с клавиатуры на русском...если, что не так, то необходимо оповестить пользователя...и тд.
Задачу я написала, вроде работает...но как-то мне не нравится...очень много и коряво...
Помогите, пожалуйста, подсократить, исправить ее, сделать более рациональным решение...

program zapis;

{$APPTYPE CONSOLE}

uses
SysUtils,
windows;

type
suit=(spades, clubs, diamonds, hearts);
size=(six, seven, eight, nine, ten, jack, queen, king, ace);
card= record
m:suit;
d:size
end;
var u:char;
a,b1,b2,c1,c2,yes:boolean;
K1,K2:card; KM:suit;
m1,m2,d1,d2:string;

procedure input_data(var K1,K2:card; var KM:suit; var m1,m2,d1,d2:string; var a,b1,b2,c1,c2:boolean);
var kz:string;
begin
writeln ('Введите козырную масть');
readln(kz);
writeln('Введите первую карту');
write('масть: '); readln(m1);
write('достоинство: '); readln(d1);
writeln('Введите вторую карту');
write('масть: '); readln(m2);
write('достоинство: '); readln(d2);

a:=true;
b1:=true;
b2:=true;
c1:=true;
c2:=true;

if (kz='пики') then KM:=spades
else if (kz='трефы') then KM:=clubs
else if (kz='бубны') then KM:=diamonds
else if (kz='червы') or (kz='черви') then KM:=hearts
else begin a:=false;
writeln('Неправильно введена козырная масть!')
end;

if (m1='пики') then K1.m:=spades
else if (m1='трефы') then K1.m:=clubs
else if (m1='бубны') then K1.m:=diamonds
else if (m1='червы') or (m1='черви') then K1.m:=hearts
else begin b1:=false;
writeln('Неправильно введена масть первой карты!')
end;

if (m2='пики') then K2.m:=spades
else if (m2='трефы') then K2.m:=clubs
else if (m2='бубны') then K2.m:=diamonds
else if (m2='червы') or (m2='черви') then K2.m:=hearts
else begin b2:=false;
writeln('Неправильно введена масть второй карты!')
end;

if (d1='шесть')or(d1='шестерка')or(d1='6') then K1.d:=six
else if (d1='семь')or(d1='семерка')or(d1='7') then K1.d:=seven
else if (d1='восемь')or(d1='восьмерка')or(d1='8') then K1.d:=eight
else if (d1='девять')or(d1='девятка')or(d1='9') then K1.d:=nine
else if (d1='десять')or(d1='десятка')or(d1='10') then K1.d:=ten
else if (d1='валет') then K1.d:=jack
else if (d1='дама') then K1.d:=queen
else if (d1='король') then K1.d:=king
else if (d1='туз') then K1.d:=ace
else begin c1:=false;
writeln('Неправильно введено достоинство первой карты!')
end;

if (d2='шесть')or(d2='шестерка')or(d2='6') then K2.d:=six
else if (d2='семь')or(d2='семерка')or(d2='7') then K2.d:=seven
else if (d2='восемь')or(d2='восьмерка')or(d2='8') then K2.d:=eight
else if (d2='девять')or(d2='девятка')or(d2='9') then K2.d:=nine
else if (d2='десять')or(d2='десятка')or(d2='10') then K2.d:=ten
else if (d2='валет') then K2.d:=jack
else if (d2='дама') then K2.d:=queen
else if (d2='король') then K2.d:=king
else if (d2='туз') then K2.d:=ace
else begin c2:=false;
writeln('Неправильно введено достоинство второй карты!')
end
end;

function cover(K1,K2:card;KM:suit; var yes:boolean):boolean;

begin
if K1.m=K2.m then yes:=K1.d>K2.d
else yes:=K1.m=KM
end;




begin
setconsolecp(1251);
setconsoleoutputcp(1251);
repeat
input_data(K1,K2,KM,m1,m2,d1,d2,a,b1,b2,c1,c2);
if (a=true) and (b1=true) and (b2=true) and (c1=true) and (c2=true) then
begin
cover (K1,K2,KM,yes);
if yes then writeln (d1,' ',m1,' бьет ',d2,' ',m2)
else writeln (d1,' ',m1,' не бьет ',d2,' ',m2)
end;
writeln('Вы хотите выйти?(Д/Н)');
readln(u)
until (u='Д') or (u='д')
end.

[compiler]

<<и коряво...>>
а взять в теги не пробывала

[БелАчкА]

Не судите строго... я здесь в первый раз...еще не со всем разобралась...

Исправляюсь...

program zapis;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  windows;

type
     suit=(spades, clubs, diamonds, hearts);
     size=(six, seven, eight, nine, ten, jack, queen, king, ace);
     card= record
                m:suit;
                d:size
            end;
var u:char;
    a,b1,b2,c1,c2,yes:boolean;
    K1,K2:card; KM:suit;
    m1,m2,d1,d2:string;

procedure input_data(var K1,K2:card; var KM:suit; var m1,m2,d1,d2:string; var a,b1,b2,c1,c2:boolean);
var kz:string;
    begin
        writeln ('Введите козырную масть');
        readln(kz);
        writeln('Введите первую карту');
        write('масть: '); readln(m1);
        write('достоинство: '); readln(d1);
        writeln('Введите вторую карту');
        write('масть: '); readln(m2);
        write('достоинство: '); readln(d2);

        a:=true;
        b1:=true;
        b2:=true;
        c1:=true;
        c2:=true;

        if (kz='пики') then KM:=spades
          else if (kz='трефы') then KM:=clubs
             else if (kz='бубны') then KM:=diamonds
                else if (kz='червы') or (kz='черви') then KM:=hearts
                   else begin a:=false;
                              writeln('Неправильно введена козырная масть!')
                        end;

        if (m1='пики') then K1.m:=spades
          else if (m1='трефы') then K1.m:=clubs
             else if (m1='бубны') then K1.m:=diamonds
                else if (m1='червы') or (m1='черви') then K1.m:=hearts
                   else begin b1:=false;
                              writeln('Неправильно введена масть первой карты!')
                        end;

         if (m2='пики') then K2.m:=spades
          else if (m2='трефы') then K2.m:=clubs
             else if (m2='бубны') then K2.m:=diamonds
                else if (m2='червы') or (m2='черви') then K2.m:=hearts
                   else  begin b2:=false;
                               writeln('Неправильно введена масть второй карты!')
                         end;

         if (d1='шесть')or(d1='шестерка')or(d1='6') then K1.d:=six
          else if (d1='семь')or(d1='семерка')or(d1='7') then K1.d:=seven
             else if (d1='восемь')or(d1='восьмерка')or(d1='8') then K1.d:=eight
                else if (d1='девять')or(d1='девятка')or(d1='9') then K1.d:=nine
                   else if (d1='десять')or(d1='десятка')or(d1='10') then K1.d:=ten
                      else if (d1='валет') then K1.d:=jack
                         else if (d1='дама') then K1.d:=queen
                            else if (d1='король') then K1.d:=king
                               else if (d1='туз') then K1.d:=ace
                   else  begin c1:=false;
                               writeln('Неправильно введено достоинство первой карты!')
                         end;

          if (d2='шесть')or(d2='шестерка')or(d2='6') then K2.d:=six
          else if (d2='семь')or(d2='семерка')or(d2='7') then K2.d:=seven
             else if (d2='восемь')or(d2='восьмерка')or(d2='8') then K2.d:=eight
                else if (d2='девять')or(d2='девятка')or(d2='9') then K2.d:=nine
                   else if (d2='десять')or(d2='десятка')or(d2='10') then K2.d:=ten
                      else if (d2='валет') then K2.d:=jack
                         else if (d2='дама') then K2.d:=queen
                            else if (d2='король') then K2.d:=king
                               else if (d2='туз') then K2.d:=ace
                   else  begin c2:=false;
                               writeln('Неправильно введено достоинство второй карты!')
                         end
    end;

function cover(K1,K2:card;KM:suit; var yes:boolean):boolean;

    begin
        if K1.m=K2.m then yes:=K1.d>K2.d
                     else yes:=K1.m=KM
    end;




begin
  setconsolecp(1251);
  setconsoleoutputcp(1251);
  repeat
  input_data(K1,K2,KM,m1,m2,d1,d2,a,b1,b2,c1,c2);
  if (a=true) and (b1=true) and (b2=true) and (c1=true) and (c2=true) then
   begin
    cover (K1,K2,KM,yes);
    if yes then writeln (d1,' ',m1,' бьет ',d2,' ',m2)
                 else writeln (d1,' ',m1,' не бьет ',d2,' ',m2)
   end;
  writeln('Вы хотите выйти?(Д/Н)');
  readln(u)
  until (u='Д') or (u='д')
end.

[Caranthir]

попробуй использовать опетаор Case
Case <выражение> of
<список мток 1>:<оператор 1>;
<список мток 2>:<оператор 2>;
....
<список мток N>:<оператор N>;
else
<оператор>
end;

[TarasBer]

Ну например:

 if (kz='пики') then KM:=spades
          else if (kz='трефы') then KM:=clubs
             else if (kz='бубны') then KM:=diamonds
                else if (kz='червы') or (kz='черви') then KM:=hearts
                   else begin a:=false;
                              writeln('Неправильно введена козырная масть!')
                        end;

Можно заменить на

const
  SuitNames: array [0 .. 4] of string = ('пики', 'трефы', 'бубны', 'червы','черви');
  NameToSuit: array [0 .. 4] of suit = (spades, clubs, diamonds, hearts, hearts);
var
  ...
  i: integer;
begin
 ...
  a := False;
  for i := 0 to 4 do
    if kz = SuitNames[i] then begin
      KM := NameToSuit[i];
      a := True;
      Break;
    end;
  if not a then
    writeln('Неправильно введена козырная масть!')
  ...

И так в каждом пункте.
Идея, в общем, такая.
Caranthir, case на строки действует?

Сообщение отредактировано: TarasBer - 18.03.2007 19:27

[Алена]

БелАчкА, прежде всего - идея такая:

procedure input_data(var K1,K2:card; var KM:suit; var m1,m2,d1,d2:string; var a,b1,b2,c1,c2:boolean);

  { вложенные константы и функции }
  const
    match_suit: array[suit] of string = (
      '(пики)', '(трефы)', '(бубны)', '(червы)(черви)'
    );
    match_size: array[size] of string = (
      '(шесть)(шестерка)(6)', '(семь)(семерка)(7)', '(восемь)(восьмерка)(8)',
      '(девять)(девятка)(9)', '(десять)(десятка)(10)', '(валет)', '(дама)', '(король)', '(туз)'
    );
  function get_suit(s: string; var res_suit: suit): boolean;
  var i: suit;
  begin
    get_suit := false;
    for i := low(suit) to high(suit) do
      if pos('(' + s + ')', match_suit[i]) > 0 then begin
        get_suit := true; res_suit := i; break;
      end;
  end;
  function get_size(s: string; var res_size: size): boolean;
  var i: size;
  begin
    get_size := false;
    for i := low(size) to high(size) do
      if pos('(' + s + ')', match_size[i]) > 0 then begin
        get_size := true; res_size := i; break;
      end;
  end;

var kz:string;
    begin
        writeln ('Введите козырную масть'); readln(kz);
        writeln('Введите первую карту');
        write('масть: '); readln(m1);
        write('достоинство: '); readln(d1);
        writeln('Введите вторую карту');
        write('масть: '); readln(m2);
        write('достоинство: '); readln(d2);

        a := get_suit(kz, km);
        if not a then writeln('Неправильно введена козырная масть!');

        b1 := get_suit(m1, K1.m);
        if not b1 then writeln('Неправильно введена масть первой карты!');
        b2 := get_suit(m2, K2.m);
        if not b2 then writeln('Неправильно введена масть второй карты!');

        c1 := get_size(d1, K1.d);
        if not c1 then writeln('Неправильно введено достоинство первой карты!');
        c2 := get_size(d2, K2.d);
        if not c2 then writeln('Неправильно введено достоинство второй карты!');
    end;

В остальной программе тоже можно пошаманить.

[БелАчкА]

Алена, TarasBer, большое спасибо за помощь!!!
правда, вложенные константы и функции мы еще не проходили...

[Алена]

правда, вложенные константы и функции мы еще не проходили...

В чем проблема? Cделай глобальные... Смотри, что получилось:

program zapis;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  windows;

type
     suit=(spades, clubs, diamonds, hearts);
     size=(six, seven, eight, nine, ten, jack, queen, king, ace);
     card= record
                m:suit;
                d:size
            end;
var u:char;
    K1,K2:card; KM:suit;
    m1,m2,d1,d2:string;

  const
    match_suit: array[suit] of string = (
      '(пики)', '(трефы)', '(бубны)', '(червы)(черви)'
    );
    match_size: array[size] of string = (
      '(шесть)(шестерка)(6)', '(семь)(семерка)(7)', '(восемь)(восьмерка)(8)',
      '(девять)(девятка)(9)', '(десять)(десятка)(10)', '(валет)', '(дама)', '(король)', '(туз)'
    );

  function get_suit(s: string; var res_suit: suit;
           const msg: string): boolean;
  var i: suit;
      b: boolean;
  begin
    b := false;
    for i := low(suit) to high(suit) do
      if pos('(' + s + ')', match_suit[i]) > 0 then begin
        b := true; res_suit := i; break;
      end;

    if not b then writeln(msg);
    get_suit := b;
  end;
  function get_size(s: string; var res_size: size;
            const msg: string): boolean;
  var i: size;
      b: boolean;
  begin
    b := false;
    for i := low(size) to high(size) do
      if pos('(' + s + ')', match_size[i]) > 0 then begin
        b := true; res_size := i; break;
      end;

    if not b then writeln(msg);
    get_size := b;
  end;

function input_data(var K1,K2:card; var KM:suit; var m1,m2,d1,d2:string):boolean;
var kz:string;
    begin
        writeln ('Введите козырную масть'); readln(kz);
        writeln('Введите первую карту');
        write('масть: '); readln(m1);
        write('достоинство: '); readln(d1);
        writeln('Введите вторую карту');
        write('масть: '); readln(m2);
        write('достоинство: '); readln(d2);

        {$b+}
        input_data :=
          get_suit(kz, km, 'Неправильно введена козырная масть!')      and
          get_suit(m1, K1.m, 'Неправильно введена масть первой карты!')  and
          get_suit(m2, K2.m, 'Неправильно введена масть второй карты!') and
          get_size(d1, K1.d, 'Неправильно введено достоинство первой карты!')  and
          get_size(d2, K2.d, 'Неправильно введено достоинство второй карты!');
        {$b-}
    end;

function cover(K1,K2:card;KM:suit): boolean;
    begin
        if K1.m=K2.m then cover := (K1.d > K2.d)
                     else cover := (K1.m = KM)
    end;

const
    text: array[boolean] of string = (' не бьет ', ' бьет ');
var
    is_cover: boolean;

begin
  setconsolecp(1251);
  setconsoleoutputcp(1251);

  repeat

    if input_data(K1,K2,KM,m1,m2,d1,d2) then begin
        is_cover := cover(K1, K2, KM);
        writeln (d1,' ',m1,text[is_cover],d2,' ',m2)
    end;
    writeln('Вы хотите выйти?(Д/Н)');
    readln(u)

  until (u='Д') or (u='д')
end.

(если убрать директивы {$b+} и {$b-}, то программа будет выдавать только первую совершённую при наборе ошибку, если не убирать - то будут показаны все ошибки)

[TarasBer]

Алёна, а ваша программа случайно не воспримет 'червы)(черви' как правильную масть?

[Алена]

    ...
    b := false;
    if pos(')(', s) = 0 then { <-- Должно убрать этот недочет, если не внесет новых багов }
      for i := low(suit) to high(suit) do
        if pos('(' + s + ')', match_suit[i]) > 0 then begin
          b := true; res_suit := i; break;
        end;
    ...

(Чисто теоретически, не тестировала)
Во второй функции - аналогично.

Спасибо за замечание...