Версия для печати темы
Нажмите сюда для просмотра этой темы в обычном формате
Форум «Всё о Паскале» _ Задачи _ Записи
Автор: БелАчкА 18.03.2007 22:23
Сама задача простая: бьет ли карта 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 18.03.2007 22:27
<<и коряво...>>
а взять в теги не пробывала
Автор: БелАчкА 18.03.2007 22:52
Не судите строго... 
я здесь в первый раз...еще не со всем разобралась...
Исправляюсь...
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 18.03.2007 23:18
попробуй использовать опетаор Case
Case <выражение> of
<список мток 1>:<оператор 1>;
<список мток 2>:<оператор 2>;
....
<список мток N>:<оператор N>;
else
<оператор>
end;
Автор: TarasBer 18.03.2007 23:25
Ну например:
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 на строки действует?
Автор: Алена 19.03.2007 14:29
БелАчкА, прежде всего - идея такая:
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;
Автор: БелАчкА 19.03.2007 19:25
Алена, TarasBer, большое спасибо за помощь!!! 
правда, вложенные константы и функции мы еще не проходили...
Автор: Алена 19.03.2007 20:00
program zapis;(если убрать директивы {$b+} и {$b-}, то программа будет выдавать только первую совершённую при наборе ошибку, если не убирать - то будут показаны все ошибки)
{$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.
Автор: TarasBer 20.03.2007 3:19
Алёна, а ваша программа случайно не воспримет 'червы)(черви' как правильную масть?
Автор: Алена 20.03.2007 3:46
...(Чисто теоретически, не тестировала)
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;
...
Во второй функции - аналогично.
Спасибо за замечание...