Подключение мыши, (программа Кроссворд) Опции

[LOVE133]

так это и надо было, просто для того чтобы это сделать пришлось вот так вот извратиться.. переделать в файл записей, потом отсортировать.А идея у меня была вначале такая - создать еще массив в котором будет храниться такая информация
1 поле - количество букв
2 поле - номер с какого по порядку начинаются слова с заданным количеством букв(1 поле )
3 поле - номер, на каком заканчиваются слова с таким количеством букв.
все это для того чтобы было удобнее перемещаться по файлу, посмотрел сколько букв, перешел на нужное количество шагов и начинай подбирать подходит слово , не подходит.

только вот абсолютно пока не представляю, как там будет рекурсия работать.Нам что-то сказали, типа вставляешь слова, вставляешь, потом когда доходишь до того места , когда боьлше ни одно слово не подходит, вернуться на шаг назад, поменять какое-то другое слово, и опять вставлять, только вот как это делать, никто толкьом объяснить не может...

[Бродяжник]

Это типа словарь

[LOVE133]

пасибки )) то что нужно и даже больше ))
я где-то здесь на форуме находила, вы решали уже задачу про кроссворд, только там его решить надо было и проверить , а мне составить, но там наверно тоже нужно было его составлять.ТОлько вот с делфи мы еще не работали, может посоветуете с чего хоть начинать слова забивать в кроссворд ?

[Бродяжник]

Ох...
Это очень сильно зависит от того, какой будет окончательная схема работы.
Если бы я стал это делать, я делал бы так:
1. Строим сетку кроссворда и проверяем ее на правильность.
2. По имеющейся сетке строим список "гнезд" с указанием начальных координат слов, их длины и направления. Нужен для организации рекурсии.
3. Желательно отсортировать этот список по убыванию длины слова. Мне кажется, что вначале нужно впихивать самые длинные слова.
4. Далее:
- берем очередное "гнездо" и ищем такое слово, которое туда подойдет;
- если нашли, вписываем его в сетку и рекурсивно переходим к следующему "гнезду";
- если не нашли, возвращаемся на предыдущий шаг рекурсии и ищем для этого шага другое слово.
Если следовать этой схеме, то нужно начинать со списка гнезд. То есть нужно на готовой сетке найти все клетки, у которых есть либо только сосед справа, либо только сосед снизу. Это точки начала слов. Для каждой такой точки определить направление слова и его длину. И занести все это в массив. Круче было бы использовать динамический список... но зачем? И так возни хватит.
Удачи!

[LOVE133]

смысл понятен, только как проверять подходит слово или нет, я не совсем уловила структуру "гнезда" , это массив или что-то еще? допустим. нашли слово, 5 букв, вертикально , на пересечении буква е, как дальше впихивать с учетом этой самой буквы е?

[Бродяжник]

Структура самого гнезда очень простая - координаты начала, длина слова и направление.
Нечто вроде

type
  TGnezdo = record
    x,y: byte;
    len: byte;
    horizontal: boolean;
  end;

var
  Gnezdo: array[1..100] od TGnezdo;

Первым делом заполняем этот массив - когда еще никаких букв нет. Потом берем первое найденное гнездо. Пусть будет, как у Вас: 5 букв, вертикально. Выбираем из словаря первое попавшееся слово из пяти букв (обозначим его, как slovo). Гнездо у нас вертикальное. Поэтому организовываем нечто такое:

ok := true;
i:=0;
while (ok) and (i<Gnezdo[1].len) do
  begin
    if (Setka[Gnezdo[1].x][Gnezdo[1].y+i] <> ' ') and (Setka[Gnezdo[1].x][Gnezdo[1].y+i] <> Slovo[i+1])
      then ok := false
      else inc(i);
  end;

Если после выхода из этого цикла ok = true, значит, слово подходит. Тогда вписываем его в сетку:

for i=0 to Gnezdo[1].len-1 do
  begin
    Setka[Gnezdo[1].x][Gnezdo[1].y+i] := Slovo[i+1];
  end;

Если слово не вертикальное, а горизонтальное, тогда работаем с Setka[Gnezdo[1].x+i][Gnezdo[1].y].
(Gnezdo[1] - это просто для примера, т.е. первое гнездо, а так-то должно быть что-то вида Gnezdo[k].)
Если слово не подошло, берем следующее.
Правка: исправил struct на record. Что-то меня проглючило...

Сообщение отредактировано: volvo - 2.11.2006 16:25

[LOVE133]

Setka[Gnezdo[1].x][Gnezdo[1].y+i] := Slovo[i+1];

тут сначала координаты сетки [x][y] , а потом что? Slovo{i+1} ?

[Бродяжник]

Slovo - это слово из словаря, которое мы сейчас проверяем. Это строка. А Slovo[i+1] - это его очередной проверяемый символ. i+1 - потому что i отсчитывается от нуля, а символы в строке нумеруются с 1.

[LOVE133]

понятно, теперь сижу втыкаюсь ... вот еще косяк объявился. не хочет repeat заботать ...

Код

begin

Window(25,25,100,100);
writeln('Input the size of the crossvord:') ;
readln(n);
driver:=detect;
initgraph(driver,mode,'');
setcolor(white);
settextstyle(4,0,4);
outTextXY(490,60,'New');
outTextXY(490,100,'Make!');
outTextXY(490,140,'EXIT');
initmouse;
showmouse;
c:=0;
Repeat
  repeat
   if  ( mousein (490,55,600,90) ) and mousepressed then  c:=1;
   if (mousein (490,100,600,150)) and mousepressed then c:=2;
   if (mousein (490,160,600,210)) and mousepressed  then c:=3;
   until c>0;
repeat
case c of
1: begin
  setviewport(1,1,479,479,clipoff);
  clearviewport;
  setka(n,selected,a);
  zapolnyaem(selected,n,a);


  outtextXY(490,300,'enter!');
  if proverka(a,n) then
  begin
    settextstyle(2,0,2);
    outtextXY(490,180,'VSE V NORME!');
    c:=5;
  end
   else c:=1;
   end;

   2:begin
   c:=5;
     readln;
     end;
   3:begin
     outtextXY(490,300,'Bolwoe spasibo!');
     readln;
     c:=5;
     end;
   end;
   until c=5;
until c=5;
readln;
end.

после выполнения один раз просто выкидывает и все...
вроде должен подождать пока я на выход нажму..

[volvo]

не хочет repeat заботать ...

Какой именно? У тебя их 3...

[LOVE133]

они по моему все не работают, один общий, то есть выполнять все, пока не выход, то есть c:=5;
второй на case работает, то есть пока c<>5, выполнять по case и третий ждет пока клавишу не нажмут , а потом работать начать .Вроде должно работать, но после одного прохода. как только я заканчиваю сетку рисовать , он меня тихонько выкидывает....Там файл, модуль ваш, с мышкой

[LOVE133]

Вот что у меня получилось . структура данных

Код

Tgnezdo=record
     x,y:integer;                  - координаты ячейки, где начинается слово
     len:byte;                      -длина слова
     horizontal:boolean;    - горизонтально или вертикально расположено слово
     end;

Дальше я бы хотела сделать так 1) берем первое гнездо из массива гнезд , смотрим, как расположено слово , сколько букв в нем
2) смотрим на сетку-массив символов, где если есть буква , то стоит пробел, если буквы нет в этом месте, то стоит 0

Код

for i:=1 to n do
   for j:=1 to n do
    begin
     if a[i,j]=1 then bukv[i,j]:=' ' else bukv[i,j]:='0';
     end;    - где a[I,j] – исходный массив нулей и единиц(сетка кроссворда)

3) считываем из файла слово нужной длины, кидаем в массив , дальше идем так:

Код

for w:=1 to q do      {q-количество слов , счетчик}    

for j:=1 to b[gnezdo[q].len].first do readln(f,s);
{здесь b-массив записей, обозначающих начало и конец слов в текстовом файле заданной длины, то есть  B[3].first=576, потому что слова длиной 3 начинаются с 576 строки в словаре}

  with gnezdo[w] do
  begin
  
{после прохода следующего блока если ок истина, то слово подходит и его можно запихнуть в сетку по горизонтали  }  

if horizontal then
    begin
    okgor:=true;
    i:=0;
     while okgor and ( i <len) do
     begin
     if (bukv[x,y+i]=' ') then
       begin
        okgor:=true;
        ok:=true;
        inc(i);
        end
       else if  (bukv[x,y+i]<>s[i])
     then
     begin
      okgor:=false
     end
     else inc(i);
     end;

  
{все верно, запихиваем в сетку }

  if okgor then
      for i:=0 to len-1 do
       begin
       bukv[x,y+i]:=s[i+1];
       end

  

  {все то же самое , но для вертикали }
    okgor:=true;
    i:=0;
     while okgor and ( i <len) do
     begin
     if   (bukv[x+i,y]=' ')   then
     begin
      okgor :=true;
      inc(i);
      end
      else if  (bukv[x+i,y]<>s[i])
     then
     begin
           okgor:=false
      end
       else inc(i);

     end;

     if okgor then
      for i:=0 to len-1 do
       begin
       bukv[x+i,y]:=s[i+1];
       end



   end;

        end;
        end;

У меня теперь проблема, все это работает для одного слова. То есть как считали его , так одно и гоняем, он не считывает нигде больше. Как это можно загнать в рекурсию, то есть что б он считывал, прогонял, проверял, смотрел, если подходит, считываем еще одно слово, если не подходит , возвращаемся на шаг назад и считываем другое слово . Можно как-нибудь из этого организовать рекурсию?то есть считывать слова. пока весь кроссворд не заоплнится ?

[Бродяжник]

if horizontal then
    begin
      okgor:=true;
      i:=0;
      while okgor and ( i <len) do
        begin
          if (bukv[x,y+i]=' ') then
            begin
              okgor:=true; 
              ok:=true;
              inc(i);
            end
          else if  (bukv[x,y+i]<>s[i])
            then
              begin
                okgor:=false
              end
          else inc(i);
       end; 

В этом фрагменте

          if (bukv[x,y+i]=' ') then
            begin
              okgor:=true; { ВОТ ЭТО ЛИШНЕЕ }
              ok:=true;
              inc(i);
            end

Лишнее, потому что okgor перед входом в цикл уже true, а как только оно станет не трю, цикл завершается, поэтому внутри цикла делать его трю не имеет смысла.
По поводу репитов-антилов Вы разобрались? Как только Вы заполнили сетку и нажали клавишу, автоматически выполняется проверка, и если все ОК, тогда с:=5, и тут же происходит выход из всех циклов и завершение программы. Так и должно быть по Вашей программе.
Я посмотрел выложенный код... если Вы не против, я бы немного изменил подход к работе с мышью. Если Вам интересно, я выложу подправленный вариант. В текущем варианте мне не всегда удавалось сбросить помеченную клетку.
По поводу рекурсии... можно ли оформить поиск слова в словаре и проверку по гнезду в отдельные функции такого вида:

function NewWord(dlina: integer): string;
begin
  {возвращает слово заданной длины. 
  при этом надо как-то учитывать те слова, 
  что уже были выбраны ранее.}
end;

function GoodWord(s: string; i: integer): boolean;
begin
  {возвращает true, если слово, заданное строкой s, 
   можно вписать в гнездо с номером i}
end;

Тогда рекурсивная функция могла бы выглядеть как-то так:

function CheckNext(i: integer): boolean;
var s: string;
begin
  if i > числа_гнезд then {все гнезда проверены}
    begin
       CheckNext := true;  {шабаш}
       exit;
    end;

    repeat

      s := NewWord(Gnezdo[i].len);  {выбираем слово из словаря}

      if GoodWord(s,i) {слово хорошее}
         then 
           begin
              if CheckNext(i+1) then   {вызываем рекурсию}
                 begin
                    CheckNext := true;
                    exit;
                 end;
           end;
    until больше_нет_слов_такой_длины;

    CheckNext := false; {заполнить гнездо так и не удалось}
end;

Сложность будет с проверкой условия больше_нет_слов_такой_длины и организацией работы с функцией NewWord. Добрые у вас преподаватели...

Сообщение отредактировано: volvo - 2.11.2006 16:26

[LOVE133]

конечно, интересно мне все.С мышью я тоже мучалась ))) а с циклами что делать тогда? Больше надеяться не на кого , потому что все только открывают рот удивленно " И это на первом курсе??". Тем более проблемы будут с проверкой это точно... Можно словарь разбить на файлы по длине слов...еще есть такие идеи:

Для очередного слова в сетке (желательно начинать с длинных)

фаза Do
* определяешь маску (какие буквы уже определены)
* получаешь курсор выборки из словаря по данной маске и запоминаешь его значение
* если обломились производишь откат к предыдущему слову
* вставляешь выбранное из словаря слово и переходишь к следующему

фаза Redo (когда был откат)
* переводишь курсор вперед
* если обломились (или вернулись на первое запомненное значение) производишь откат к предыдущему слову
* вставляешь выбранное из словаря слово и переходишь к следующему



Для случаев, когда в маске зафиксирован префикс (первые несколько букв) диапазон поиска можно сократить.

Также можно ввести проверку для каждой позиции буквы в слове собрать множество доступных букв и фильтровать запросы к словарю на основе этих данных.
Например, буква Ъ не встречается в начале слова так что незачем сканировать словарь.

[Бродяжник]

Я позволил себе
1) сделать так, чтобы клетки меняли состояние не просто, когда мышь нажата, а именно по факту нажатия (т.е. не было нажато - стало нажато);
2) заменить операторы типа

if a < 1 then f:=false else f:=true

на эквивалентные им

f:=(a>=1);

3) выровнять текст, чтобы было удобнее читать.
Расскажите, как должны работать циклы, и я подумаю.

[LOVE133]

циклы должны работать так
1) New- создать новую сетку , то етсь совсем новую , пустую, нажал - заполнил
2) Make - составить кроссворд , рекурсивно заполнить словами (здесь буду работать, что получится сегодня, покажу )
3) Exit _ когда пользователь нажмет на эту "кнопку" - выход из программы
тоесть нажал на new - новую сетку сделал , нажал потом на make - заполнил кроссворд, дальше еще подумаю , над сохранением ... но это если основную часть выполню и останется время. ТО есть пользователь может составить несколько кроссвордов , переходя по кнопкам.ПОка не нажмется Exit . Задумка была такая.

[LOVE133]

Уважаемый Бродяжник , посидели вчера , покумекали, вот что получили , осталось забить это в код....
Вот данная рекурсивная процедура . Будем использовать как мне их обозвали «дырки», то есть места выхода из процедуры, через которые будет проскакивать рекурсия не выполняя никаких функций.
Выглядит это так (должно по крайней мере)
«гнезда» - упорядоченный массив записей содержащий вот такую структуру

Tgnezdo=record
x,y:integer; - координаты ячейки, где начинается слово
len:byte; -длина слова
horizontal:boolean; - горизонтально или вертикально расположено слово

вот данная процедура

Код

Функция ARBEIT ( передаем текстовое поле, где пробелами обозначены места где есть или должна быть  буква, и номер «гнезда» ) :Boolean;

N слова:=0; retValue:=0;(retValue – метка для прохождения процедур без выполнения)


Процедура Mask(текстовое поле, «гнездо» ):string;
(процедура получает строку типа такой “_А_ _ Л”)
Получение очередного слова из
Файла


                        Сравнение с маской            
                                                                 не подходит
                                                                  ( Inc(номер слова))
                                                              
Подходит




Если номер гнезда равен
                            максимальному номеру гнезд

                  нет                                              да

клонируем текстовое поле                                           забиваем слово в текстовое поле
забиваем слово в клон                                                      retValue:=2 ( то есть True)
(*первый выход из рекурсии)




If     ARBEIT (копия текстового поля; N гнезда +1)


False                                                            True  
(переход к получения
нового слова  
                                            
                                             Присваиваем полю значение копии
                                             retValue:=2 ( то есть True)

ТО есть теперь все циклы и условия нужно будет проверять с условием if RetValue =2 или нет . Осталось только реализовать это в код… я все-таки не до конца понимаю рекурсию. Может чем поможете, Алгоритм в принципе понятен и мелкие процедурки типа получения слова осилила. Но вот все это собрать без продлем не могу … эх.. жаль н еработают рисунки, прикрепила текстовый файл, елси что там все понятне. но смысл тут уловить можно .

[Бродяжник]

Уважаемая Love (можно без 133?),
я тем временем немного поправил циклы, так что меню уже почти работает. Единственное, что накладываются друг на друга сообщения, так что их надо как-то очищать, когда они уже не нужны. Я обвел кнопки рамочками по размеру области для MouseIn, чтобы четко видеть, где отлавливается щелчок.
И я уже почти закончил рекурсивную модельку, которая по заданной сетке подбирает гнезда и заполняет их, следя за пересечениями. Думаю, что сегодня и закончу. Она с массой ограничений, но схема там работает.
А уже завтра гляну на Ваш материал.

[Бродяжник]

Хотя бы в какой-то степени оно работает!
(Я составил 4 простеньких кроссворда. Дальше тестить поленился).
Читайте ридми.
Воть.

[LOVE133]

Вчера посидела с реализацией своей рекурсивной модели (см.выше) , вроде все должно работать , но есть какие-то непонятки, не могу найти где. В файле несколько процедур добавлено, основная ARBEIT , должна возвращать истину, елси все так и все работает, а так же текстовое поле , в котором все должно быть расставлено по местам , но почему-то этого не происходит.... может как-нибудь подправить можно. А в вашем кроссворде я так поняла можно модель рекурсивную взять, и вставить в прогу основную)). Может к вечеру что-то прояснится ....


в 11.30 началось переполнение стека.... (*паника и старх*)

Сообщение отредактировано: LOVE133 - 6.05.2006 14:35