Читайте также:
|
uses Crt, Graph;
const
N = 50; {размерность матрицы - шаблона кроссворда}
menu:array[1..3] of string[15]=('Данные','Тест','Выход'); {верхняя строка меню}
menuup:array[1..2]of string[15]=('Из файла','Диалог'); {меню Данные}
type
masWord = record {структура элемента массива слов}
number:integer; {номер слова}
word: string[25]; {слово}
pr: boolean {признак занятости слова}
end;
masKWord = record {структура элемента массива кроссворда}
ch: char; {символ}
numberWord: integer {номер слова, из которого взят символ}
end;
mas = array[1..N, 1..N] of masKWord; {заполненный кроссворд}
ListWord = record {список слов массива}
InI, InJ: integer; {координаты начала слова}
Dlina: integer; {длина}
Horizont: boolean; {ориентация слова (по горизонтали или по вертикали)}
end;
ref = ^z; {список использованных слов}
z = record {структура элемента списка использованных слов}
next: ref;
NumberWord: integer;
end;
var
f: text; {входной файл}
words: array[1..100] of masWord; {массив слов}
kword: array[1..N, 1..N] of integer; {шаблон кроссворда}
krword: mas; {кроссворд}
List: array [1..N*N] of ListWord; {список слов кроссворда}
k, kolWord: integer; {количество слов}
top: ref; {список использованных слов}
{процедура инициализации верхней строки меню}
Procedure InitMenu;
var
i: integer;
begin
window(1,1,80,25); {заливка экрана}
TextBackGround(Blue);
ClrScr;
gotoxy(1,1);
TextBackGround(LightGray); {верхняя строка серого цвета}
ClrEol;
TextColor(Black);
For i:=1 to 3 do {вывод трех пунктов меню}
begin
gotoxy((i-1)*30+2,1);
write(menu[i]);
end;
end;
{чтение данных из файла}
function InitFile:boolean;
var
s:string; {строка}
i, j: integer; {переменные для заполнения массива шаблона}
ch:char; {для чтения из файла}
p: boolean;{признак корректности файла}
procedure InitError; {вывод сообщения об ошибке}
begin
window(25,12,55,14); {формирование окна}
TextBackGround(Red); {вывод сообщения об ошибке символами красного цвета}
ClrScr;
write('Структура файла некорректна!');
repeat until keypressed;
InitMenu; {инициализация верхней строки меню}
end;
procedure WriteError; {вывод сообщения об ошибке}
begin
window(25,12,55,14); {формирование окна}
TextBackGround(Red); {вывод сообщения об ошибке символами красного цвета}
ClrScr;
write('Файл не найден! Повторите ввод имени файла!');
repeat until keypressed;
InitMenu; {инициализация верхней строки меню}
end;
begin
repeat
window(30,10,50,12); {ввод имени файла в окно}
TextBackGround(LightGray);
ClrScr;
gotoxy(1,1);
p:=true;
write('Введите имя фала');
gotoxy(1,2);
readln(s); {чтение строки - имени файла}
{$I-}
Assign(f,s); {открыть файл для чтения}
Reset(f);
if IOResult<>0 {если возникла ошибка при открытии файла}
then
begin
p:=false; {если возникла ошибка при открытии}
WriteError; {вывод сообщения}
end;
{$I+}
until p;
{$I-}
readln(f,k); {чтение из файла размерности шаблона кроссворда}
if (k<1) or (k>50) then p:=false; {проверка корректности размера массива шаблона}
if p then
begin
for i:=1 to k do {чтение из файла шаблона кроссворда}
for j:=1 to k do
begin
read(f,ch);
if ch='_' then
kword[i,j]:=0
else if ch='#' then
kword[i,j]:=1
else p:=false;
if j=k then readln(f);
end;
i:=1;
while not eof(f) do {чтение из файла слов для формирования кроссворда}
begin
readln(f,words[i].word);
words[i].Number:=i;
words[i].pr:=false;
inc(i)
end;
KolWord:=i-1;
{$I+}
end;
if (IOResult<>0) or not p then
begin
InitError;
InitFile:=false
end
else InitFile:=true; {проверка корректности входного файла}
end;
{ввод шаблона кроссворда и слов для формирования кроссворда в режиме диалога}
Procedure InitDialog;
var
i: integer;
begin
{заглушка}
end;
{вывод выпадающего меню}
Function InitMenuUp:boolean;
var
i, iold: integer;
p: boolean;
c: char;
begin
window(1,3,16,5); {вывод окна выпадающего меню}
TextBackGround(LightGray);
ClrScr;
TextColor(Black);
For i:=1 to 2 do {вывод пунктов меню}
begin
gotoxy(2,i);
write(menuUp[i]);
end;
i:=1;
iold:=1;
p:=false;
repeat {организация движения маркера по пунктам}
TextBackGround(LightGray);
gotoxy(2,iold);
write(menuUp[iold]);
TextBackGround(Green);
gotoxy(2,i);
write(menuUp[i]);
c:=readkey;
while c=#0 do c:=readkey;
case c of
#80: begin iold:=i; if i<2 then inc(i) else i:=1 end; {перемещение маркера вниз}
#72: begin iold:=i; if i>1 then dec(i) else i:=2 end; {перемещение маркера вверх}
#13: begin iold:=i; {выбор пункта}
p:=true; {начальные данные введены}
case i of
1: if not InitFile then begin p:=false; c:=#27 end; {если в результате
чтения данных из файла произошел сбой, то начальные данные не
введены}
2:InitDialog; {ввод данных в режиме диалога}
end;
end;
end;
until p or (c=#27); {возврат к верхней строке меню, если данные введены или Esc}
window(1,1,80,25);
InitmenuUp:=p; {функция возвращает true, если начальные данные введены, false в противном случае}
InitMenu; {инициализация верхней строки меню}
end;
{добавление в стек номеров использованных слов}
procedure pop(var top:ref; a:integer);
var
q:ref;
begin
new(q);
q^.next:=top;
top:=q;
top^.NumberWord:=a;
end;
{извлечение из стека номеров использованных слов}
function push(var top:ref):integer;
var
q:ref;
begin
if top<>nil then
begin
push:=top^.NumberWord;
q:=top;
top:=top^.next;
dispose(q);
end;
end;
{проверка возможности создания кроссворда на основе заданного шаблона с использование заданного набора слов}
Procedure Test;
type
r = record {количество слов заданной длины}
kolKrWord, kolWord: integer; {количество слов в кроссворде и в списке}
end;
var
i, j, len,num:integer;{вспомогательные переменные}
w: boolean; {признак ошибки}
dlw: array[1..N] of r; {массив количества слов (номер элемента - длина слова)}
{вывод сообщения о невозможности составить кроссворд}
Procedure PrintError;
begin
window(25,12,55,15); {вывод сообщения в окно}
TextBackGround(Red);
ClrScr;
writeln('По заданному множеству слов и');
writeln('матрице кроссворда не возможно');
writeln('составить кроссворд!');
repeat until keypressed; {ожидание нажатия клавиши}
InitMenu; {инициализация верхней строки меню}
end;
{вывод кроссворда}
Procedure PrintRez;
var i,j: integer; {вспомогательные переменные}
begin
TextBackGround(Blue);{установка цвета фона}
TextColor(Yellow);
clrscr;
Gotoxy(27,1);
writeln('Вариант кроссворда');
for i:=1 to k do {вывод кроссворда}
for j:=1 to k do
if j<>k then
if krword[i,j].ch<>'#' then
write(krword[i,j].ch)
else write('#')
else if krword[i,j].ch<>'#' then
writeln(krword[i,j].ch)
else writeln('#');
gotoxy(1,25); {вывод подсказки}
TextBackGround(LightGray);
ClrEol;
TextColor(Black);
write('Для выхода в главное меню нажмите Esc');
repeat until keypressed; {ожидание нажатия клавиши}
end;
{проверка, можно ли вписать слова в шаблон}
function testword:boolean;
var i,j,l,z:integer;
p:boolean;
{выбор из списка слов слова подходящей длины и не занятого, функция возвращает номер слова в списке}
function newword(i:integer;l:integer):integer; {i - с какого по счету слова в списке начинать поиск, l - длина искомого слова}
var
j:integer;
p: boolean;
begin
j:=i; {от какого номера начинать поиск}
p:=true;{слово не найдено}
while (j<=kolword) and p do {пока не прошли весь список и не нашли слово}
if (length(words[j].word)=l) and not words[j].pr then{если длина слова поджходит }
p:=false {слово найдено}
else inc(j); {иначе ищем дальше}
if p then newword:=0 {если прошли по всему списку и не нашли, функция возвращает 0}
else newword:=j; {иначе номер найденного слова}
end;
begin
i:=1;{подбор слова} j:=0;
while (i<=num) and(i>0) do {подбор для всех слов шаблона}
begin
j:=newword(1+j,List[i].dlina);{ищем слово подходящей длины, j используется как смещение }
if j<>0 then {если в списке слов такое нашлось}
begin
pop(top,j);{помещаем его номер в стек}
p:=true; {читаем, что слово можно вписать в кроссворд}
words[j].pr:=true; {помечаем, что слово занято}
if (krword[List[i].InI,List[i].InJ].NumberWord=0) or {если нет пересечения с уже вписанным словом данного символа}
(krword[List[i].InI,List[i].InJ].ch=words[j].word[1]) then {или пересечение есть, но символы совпадают}
begin
krword[List[i].InI,List[i].InJ].ch:=words[j].word[1]; {вписываем символ в клетку кроссворда}
if krword[List[i].InI,List[i].InJ].NumberWord=0 then {если пересечения нет}
krword[List[i].InI,List[i].InJ].NumberWord:=j; {помечаем номер слова, из которого взят символ}
l:=1; {номер вписанного символа слова}
while (list[i].dlina>l) and p do {пока не все символы слова вписаны и не произошла ошибка}
begin
if List[i].Horizont then {если слово необходимо вписать по горизонтали}
if (krword[List[i].InI,List[i].InJ+l].NumberWord=0)or {если клетка кроссворда свободна}
(krword[List[i].InI,List[i].InJ+l].ch=words[j].word[1+l]) then {или занята, но символы совпадают}
begin {вписываем символ и вписываем, если необходимо, номер слова}
krword[List[i].InI,List[i].InJ+l].ch:=words[j].word[1+l];
if krword[List[i].InI,List[i].InJ+l].NumberWord=0 then
krword[List[i].InI,List[i].InJ+l].NumberWord:=j;
end
else p:=false {если клетка занята, и символы не совпадают, произошла ошибка}
else {если необходимо вписать слово по вертикали}
if (krword[List[i].InI+l,List[i].InJ].NumberWord=0)or
(krword[List[i].InI+l,List[i].InJ].ch=words[j].word[1+l]) then
begin
krword[List[i].InI+l,List[i].InJ].ch:=words[j].word[1+l];
if krword[List[i].InI+l,List[i].InJ].NumberWord=0 then
krword[List[i].InI+l,List[i].InJ].NumberWord:=j
end
else p:=false; {произошла ошибка при вписывании слова}
inc(l); {переход к следующему символу слова}
end
end
else p:=false; {первый символ слова невозможно вписать в кроссворд}
if p then begin inc(i); j:=0 end; {если слово успешно вписано
в кроссворд, переходим к следующему пустому слову кроссворда}
if not p then {если попытка вписать слово не удалась}
begin
j:=push(top); {извлекаем номер слова из стека}
words[j].pr:=false; {помечаем слово как свободное}
for l:=1 to k do {в кроссворде помечаем клетки занятые символами слова как свободные}
for z:=1 to k do
if krword[l,z].numberWord=j then
krword[l,z].numberWord:=0;
l:=0; {нет вписанных символов слова}
end
end
else {если не нашли слова подходящей длины}
begin
j:=push(top); {извлекаем из стека номер последнего успешно вписанного слова}
{j используется как смещение при поиске следующего подходящего слова}
words[j].pr:=false; {помечаем слово как свободное}
for l:=1 to k do {помечаем клетки кроссворда, в которые было вписано слово как свободные}
for z:=1 to k do
if krword[l,z].numberWord=j then
krword[l,z].numberWord:=0;
i:=i-1; {уменьшаем количество вписанных слов на 1}
l:=0;
end;
end;
if i=num+1 then testword:=true else testword:=false {если все клетки кроссворда заполнены, функция возвращает true}
end;
begin
num:=0; {количество слов в шаблоне - ноль}
for i:=1 to k do {проход по строкам шаблона для поиска слов}
begin
w:=false; {слово не найдено}
len:=0; {длина слова - ноль}
for j:=1 to k do {идем по строке}
begin
if (kword[i,j]=0) and not w then {если в ячейке - начало слова}
begin
num:=num+1; {количество слов увеличиваем на 1}
List[num].InI:=i; {в список слов шаблона заносим координаты начала слова}
List[num].InJ:=j; {номер строки и номер столбца}
List[num].Horizont:=true;{ориентация по горизонтали}
w:=true; {признак слова}
end;
if kword[i,j]=0 then len:=len+1;{если признак слова true, длина слова увеличивается на 1}
if (kword[i,j]=1) and w then {если слово закончилось}
begin
if len>1 then {и длина слова больше 1}
List[num].Dlina:=len {заносим длину слова в список слов}
else num:=num-1; {если длина слова равна 1, извлекаем слово из списка слов}
len:=0; {длина слова 0}
w:=false; {слово не найдено}
end
end;
if w then if len>1 then list[num].dlina:=len else num:=num-1 {заносим последнее слово шаблона}
end;
for j:=1 to k do {проходим по столбцам с целью поиска слов}
begin
w:=false;
len:=0;
for i:=1 to k do
begin
if (kword[i,j]=0) and not w then
begin
w:=true;
num:=num+1;
List[num].InI:=i;
List[num].InJ:=j;
List[num].Horizont:=false;
end;
if kword[i,j]=0 then len:=len+1;
if (kword[i,j]=1) and w then
begin
if len>1 then
List[num].Dlina:=len
else num:=num-1;
len:=0;
w:=false;
end
end;
if w then if len>1 then list[num].dlina:=len else num:=num-1
end;
{инициализация массива кроссворда}
for i:=1 to k do
for j:=1 to k do
begin
krword[i,j].ch:='#';
krword[i,j].numberWord:=0;
end;
{инициализация массива количества слов заданной длины}
for i:=1 to k do
begin
dlw[i].kolkrWord:=0;
dlw[i].kolWord:=0;
end;
{подсчет количества слов заданной длина}
for i:=1 to k do
begin
for j:=1 to num do {в шаблоне}
if list[j].dlina=i then
dlw[i].kolkrWord:=dlw[i].kolkrWord+1;
for j:=1 to kolWord do {в списке слов}
if length(words[j].word)=i then
dlw[i].kolWord:=dlw[i].kolWord+1;
end;
{проверка соответствия количества слов по длине}
w:=true;
for i:=1 to k do
if dlw[i].kolKrWord>dlw[i].kolWord then {в списке слов заданной длины должно быть не меньше, чем требуется по шаблону}
w:=false;
{если слов не хватает, вывод сообщения, иначе пробуем вписать слова в шаблон}
if not w then printError
else if testWord then
printrez
else printError;
{инициализация меню}
InitMenu;
end;
{процедура инициализации экрана, верхней строки меню и организации работы с меню}
Procedure Init;
var
i,iold: integer;{координаты маркера}
c: char; {последний считанных символ}
p: boolean; {признак ввода входных данных}
{процедура вывода сообщения об ошибке при попытке
вызова процедуры нахождения варианта построения кроссворда
при незаданных начальных условиях}
procedure TestError;
var
c:char;
begin
window(25,12,55,14); {вывод в окно символами красного цвета}
TextBackGround(Red);
ClrScr;
write('Не заданы входные данные!');
repeat until keypressed;
c:=readkey;
InitMenu;
end;
begin
InitMenu; {вывод верхней строки меню}
p:=false; {начальные данные для построения кроссворда не заданы}
i:=1;{маркер установлен на первый пункт меню}
iold:=1; {перемещений маркера не было}
repeat
TextBackGround(LightGray); {перемещение маркера с позиции iold на позицию i}
gotoxy((iold-1)*30+2,1);
write(menu[iold]);
TextBackGround(Green);
gotoxy((i-1)*30+2,1);
write(menu[i]);
c:=readkey;
while c=#0 do c:=readkey; {ожидание нажатия клавиши}
case c of
#77: begin iold:=i; if i<3 then inc(i) else i:=1 end; {перемещение маркера вправо}
#75: begin iold:=i; if i>1 then dec(i) else i:=3 end; {перемещение маркера влево}
#13: begin iold:=i; {выбран пункт меню}
case i of
1: p:=InitMenuUp; {Выбран пункт ДАННЫЕ, вызываем процедуру вывода выпадающего меню}
2: if p then begin Test; p:=false end {выбран пункт ТЕСТ, если начальные данные заданы,
вызываем процедуру поиска варианта кроссворда}
else TestError; {если не заданы, выводим сообщение}
end;
end;
end;
until (i=3) and (c=#13); {выход из программы при выборе пункта ВЫХОД}
end;
Begin
Init; {Запуск процедуры инициализации}
window(1,1,80,25);{восстановление параметров экрана}
TextBackGround(Black);
ClrScr;
TextColor(white);
End.
Дата добавления: 2015-12-08; просмотров: 58 | Нарушение авторских прав