Помогите с кодом Pascal

Дней с нами
3.528
Розыгрыши
0
Сообщения
489
Репутация
36
Реакции
316
Telegram
IlikeNokia
Доброй ночи, граждане программисты!
В общем играл в настолку Особняки Безумия и там была очень интересная (для меня) головоломка.
Дано определенное количество символов и известна длина ответа.
При вводе предполагаемого ответа тебе выдает сколько символов стоят на своих местах и сколько есть в ответе, но не на своих местах.
А так как в Особняках нет такой миниигры чтоб в любой момент открыть и отгадывать сколько душе влезет решил я это дело запилить в Паскале, т.к. это единственный язык который вообще знаю (со школы).
Почти ведь получилось, сломав голову собрать то что и нужно, но по итогу программа ломается в момент когда вводишь ей число допустим (4444), а правильный допустим (4434). Вместо того что бы сказать что 3 правильных, она пишет что 3 правильных и 1 не на месте. В целом зону ошибки я вижу, но не понимаю как исправить.

Помогите, пожалуйста, доработать сие творение :)

Ну и кстати если кто вдруг знает готовые игры где уже реализована моя задумка, то был бы очень рад в них поиграть)
1615926503493.png
var
a: array [1..10] of integer;
k:array[1..10] of longint;
qq,ds,ss,ks,c,d,n,i,f,z,j,l,m,y,q,digit :integer;

begin
ks:=0;
writeln('Выберите количество символов 1-9');
readln(d);
Writeln('Выберите сложность 1-10');
readln(n);
for i:=1 to n do
a:=random(d)+1;
writeln('Попробуй разгадать!');
while f<>n do begin
f:=0;
q:=n+1;
readln(z);
if z=4 then writeln(a);
while (z>0) do
begin
digit:=z mod 10;
q:=q-1;
k[q]:=digit;
z:=z div 10;
end;
for i:=1 to n do begin
if k=a then begin
write('@');
f:=f+1;
end;
end;
for qq:=1 to n do begin
ds:=0;
for ss:=1 to n do begin
if (k[qq]=a[ss]) then begin ds:=ds+1; end;
end;
if ds=0 then ks:=ks+1;
end;
ks:=n-ks-f;
writeln(ks);
writeln('');
end;
writeln('Правильно!');
end.
P.S. Я не программист, так что простите, если вид кода вызывает у вас отвращение.
P.S.S. Одну часть кода честно стырил, остальное сам.
---------Двойное сообщение соединено: ---------
Господа форумчане!
Вчера к утру таки дописал программку, да так, что смело могу назвать её версией 0.9 с готовыми планами для релиза, а так же последующими обновлениями. Но так как на доделывание времени не будет в ближайшее время - представляю Вам готовый вариант данной головоломки. Приятной игры!
var
a: array [1..10] of integer;
k:array[1..10] of longint;
mass:array[1..10] of longint;
pass:array[1..10] of longint;
zzz,zuu,z,zx,qq,ds,ss,ks,c,d,n,i,f,j,l,m,y,q,digit :integer;
zu,zz,zc,answer:string;
Code : Integer;
s: string;
begin
ks:=0;
writeln('Выберите количество символов 1-9');
readln(d);
Writeln('Выберите сложность 1-10');
readln(n);
for i:=1 to n do
a:=random(d)+1;
writeln('Попробуй разгадать!');


while f<>n do begin
f:=0;
for i:=1 to n do begin
pass:=0;
mass:=0;
end;
q:=n+1;
zz:=('');
zu:=('');
readln(zc);
zc:=UpperCase(zc);
if zc='ОТВЕТ' then writeln(a);
val(zc,z,Code);
for i:=1 to n do begin
zz:=zz+'1';
zu:=zu+'9';
end;
val(zu,zuu,Code);
val(zz,zzz,Code);
if (z<zzz) or (z>zuu) then begin
writeln('Некорректная комбинация. Код может состоять только из цифр 1-',d,' и в нём ровно ',n,' знаков');
z:=0;
end
else begin
while (z>0) do
begin
digit:=z mod 10;
q:=q-1;
k[q]:=digit;
z:=z div 10;
end;


for i:=1 to n do begin
if k=a then begin
write('@');
f:=f+1;
end
else begin
pass:=k;
mass:=a;
end;
end;

ds:=0;

for qq:=1 to n do begin
zx:=0;
repeat
zx:=zx+1;
if (mass[qq]=pass[zx])and (mass[qq]>0) and (pass[zx]>0) then begin ds:=ds+1; mass[qq]:=0; pass[zx]:=0; end;
until (zx=n) or (mass[qq]<0) ;
end;
if ds>0 then begin
for i:=1 to ds do
write('#');
end;
writeln('');
if f=n then begin
writeln('Правильно!');
writeln('Ещё Раунд?');
readln(answer);
answer:=UpperCase(answer);
if answer=('ДА') then begin
f:=0;
ks:=0;
writeln('Выберите количество символов 1-9');
readln(d);
Writeln('Выберите сложность 1-10');
readln(n);
for i:=1 to n do
a:=random(d)+1;
writeln('Попробуй разгадать!');
end;
end;
end;
end;
end.
---------Двойное сообщение соединено: ---------
Для удобства запуска без установки Паскаля или других танцев с бубном вот EXE-шник
 
Последнее редактирование: