Версия для печати темы

Автор: ТОХА 28.03.2011 19:38

Здравствуйте!
при написании одного из модулей программы я столкнулся с такой проблемой как наложение фигур друг на друга. Как сделать так чтоб последующая фигура рисовалась на свободном месте экрана и не накладывалась на другие?

 uses Crt, Graph;
const k=100;
var
 GraphDriver, GraphMode: Integer;
 X1,y1, r: Integer;ch:char;
begin
 GraphDriver := Detect;
 InitGraph(GraphDriver, GraphMode, ' ');
 if GraphResult<> grOk then
   Halt(1);
repeat
 ch:=readkey;
 if ch=chr(13) then begin
  X1 := Random(640-k)+k;
   y1 := Random(480-k)+k;
  r:=Random(k)+1;
  circle(X1,y1,r);
 end;
until ch=chr(27);
CloseGraph;
end.

Автор: мисс_граффити 28.03.2011 20:57

фигуры - только круги? а что делать, если свободных мест не осталось вообще?

Автор: ТОХА 28.03.2011 21:01

да, только круги
это просто часть моей игры на запоминание, сделаю их такого размера чтоб в районе 50 вмещалось, больше запомнить будет просто невозможно)

Автор: volvo 29.03.2011 2:39

Если только круги - то можно сделать

uses
  Crt, Graph;

const
  k = 100;
  maxCircles = 50;

var
  GraphDriver, GraphMode: Integer;
  X1,y1, r: Integer; ch: char;

  i, curr : integer;
  ok : boolean;
  C : array[1 .. maxCircles] of
      record
        X, Y, R : longint;
      end;

begin
  GraphDriver := Detect;
  InitGraph(GraphDriver, GraphMode, ' ');
  if GraphResult<> grOk then Halt(1);

  curr := 0;
  repeat
    ch := readkey;
    if ch = chr(13) then
    begin
      repeat
        X1 := Random(GetMaxX - k) + k; { Не надо привязываться к "магическим числам" }
        Y1 := Random(GetMaxY - k) + k;
        r := Random(k) + 1;

        ok := true;
        for i := 1 to curr do
          ok := ok and (sqr(C[i].X - X1) + sqr(C[i].Y - Y1) >
                        sqr(R + C[i].R));
      until ok;

      inc(curr);
      C[curr].X := X1;
      C[curr].Y := Y1;
      C[curr].R := R;

      Circle(X1, Y1, R);
    end;
  until ch = chr(27);
  CloseGraph;
end.

Автор: ТОХА 29.03.2011 2:55

Цитата(volvo @ 28.03.2011 23:39)

uses
           (sqr(C[i].X - X1) + sqr(C[i].Y - Y1) > sqr(R + C[i].R))

Автор: volvo 29.03.2011 4:44

Чего ж тут такого особенного? Чистая логика. Когда новая окружность не будет пересекаться с уже отрисованной? Правильно, когда расстояние между центрами окружностей больше суммы их радиусов. Причем это должно проверяться для ВСЕХ уже отрисованных объектов.

Чтоб не вычислять квадратный корень, я оставил квадрат расстояния между центрами. Значит, сравнивать его надо с квадратом суммы радиусов. Всё просто.

Автор: ТОХА 29.03.2011 4:49

точно это ж геометрия за 8 класс

Автор: TarasBer 29.03.2011 13:13

> repeat
random...
until ok;

Предлагаю придумать не потенциально-бесконечный алгоритм.

Автор: volvo 29.03.2011 13:52

Автор: TarasBer 29.03.2011 14:05

> Random - это генератор, который возвращает равномерно-распределенные случайные числа

Не случайные, а ПСЕВДОслучайные.
Будут ли тройки последовательно возвращаемых значений равномерно распределены?
Позволяют ли внутренние особенности именно данной реализации алгоритма надеяться на отсутствие возможности зацикливания?

Автор: ТОХА 29.03.2011 15:31

смысл игры в том, что нужно запомнить какой шарик появился на поле и щелкнуть на него(пока вместо мыши энтер), я сомневаюсь что есть люди которые дойдут до зацикливания
TarasBer, надеюсь я ответил на твой вопрос


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

Автор: TarasBer 29.03.2011 16:16

> TarasBer, надеюсь я ответил на твой вопрос

Нет, вопрос был не об этом. Вопрос был в том, что сама концепция выполнения случайного действия до выполнения какого-то условия мне видится сомнительной. Кто сказал, что условие когда-либо выполнится, мало ли как случайное действие себя вести будет?

Автор: volvo 29.03.2011 18:40

Автор: ТОХА 29.03.2011 18:51

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

Автор: TarasBer 29.03.2011 19:03

> Это твои заморочки. Оно ОБЯЗАНО отработать по изложенным выше причинам.

Причины недостаточно доказаны.

> А отработает оно за 0.0002 сек. или за 0.05 сек - это дело десятое (в данном конкретном случае)

Лишь бы раз в год оно не заработало за 50 сек.

> Проверил на своей машине: сгенерировал (без вывода на экран) 50 окружностей, в цикле. Цикл прогнал 10000 раз. А потом - полтора миллиарда раз. И в первом и во втором случае среднее время генерации всех 50 окружностей приблизительно одно и то же.

Возьми не среднее, а максимальное. А потом возьми другой ГСЧ, для него придётся доказывать всё по новой.

Это хорошо, что полтора миллиарда испытаний отработали как надо, но всё-таки само понятие случайного числа противоречит понятию алгоритма, и завязывание жизненно важных участков алгоритма на случайные числа лишает алгоритм права называться алгоритмом, поскольку делает его поведение непредсказуемым.
Ты математически можешь доказать, что алгоритм гарантировано даст нужный результат не более, чем за эн тактов процессора (или итераций цикла, или ещё каких-то условных единиц)? Нет, не можешь. Поэтому с такими алгоритмами надо быть очень осторожными. И если есть обходные пути, работающие за разумное время - то надо их искать. Иначе на этом алгоритме надо огромными красными буквами писать, что так как он основан на случайных событиях, то он ничего не гарантирует.

Добавлено через 2 мин.
> как пользоваться коммандой MouseIn для кругов и эллипсов?

Чтобы узнать, что точка с координитами mx, my попала в эллипс с центром в точке x, y и полуосями rx, ry, надо сравнить

sqr((mx-x)/rx) + sqr((my-y)/ry)

с единицей.

Автор: ТОХА 29.03.2011 19:15

Спасибо )

Автор: ТОХА 29.03.2011 21:48

немного запутался и возникло 2 проблемы:
мышь ползает только по верхней половине экрана
программа виснет после появления 8 шарика, почему именно 8 я без понятия
буду благодарен если кто-нить посмотрит))


Прикрепленные файлы
 PROG.PAS ( 5.15 килобайт ) Кол-во скачиваний: 378

Автор: volvo 29.03.2011 23:06

Автор: ТОХА 30.03.2011 1:07

нашел, исправил, а что делать с мышкой?

Автор: TarasBer 30.03.2011 13:30

> Максимальное время различается не больше, чем на 20%.

Ну если ты перебрал при этом все 4 млрд возможных стартовых состояния ГСЧ, то это подойдёт, как доказательство.

> Я тебе уже говорил, где нужна шлифовка тактов.

Как будто мне она тут нужна. Чё сразу - раз ТарасБер, значит шлифовка тактов?
Мне не нужно, чтобы раз в год программа затупливала на минуту. Конечно, когда пишешь игрушку, на это вообще все кладут - у 10 игроков игра упала, у 90 отработала, вот и зашибись. А в серьёзном программировании так нельзя.

Автор: ТОХА 1.04.2011 2:52

мышку одолел,

вопрос покажется странным но как сделать так чтобы перерисовка картинки занимала больше времени, я понимаю что все стараются избавляться от перерисовки всего экрана, но мне это нужно для того чтоб человеческий глаз начинал воспринимать весь экран заново а не только появившуюся часть

можно ли рисовать черный прямоугольник на весь экран на секунду а потом убирать его и чтоб на нем сохранилось все что было до его рисования?

Автор: volvo 1.04.2011 21:20

Автор: ТОХА 1.04.2011 22:39

а с помощью комманд getimage и putimage можно сделать так?:
1 нарисовать появившийся круг
2 сохранить весь экран
3 очистить
4 нарисовать сохраненный фрагмент
и если можно то насколько быстро это будет происходить чтоб не успеть воспринять 1 пункт, а то смысл игры становится не таким интересным

Автор: volvo 1.04.2011 23:08

А ты знаешь, мне тут еще один финт в голову пришел. Попробуй, будет оно работать или нет, мне сейчас негде, Турбо Паскаля под рукой нет, а в FPC это не отработает.

{ Отрисовал картинку, теперь надо "погасить" на секунду }

{ Гасим. Для этого просто все цвета сделаем "черными" }
for i := 1 to 15 do
begin
  setpalette (i, black); { Нулевой цвет я бы не трогал. }
end;

readln; { Ждем какое-то время, можешь заменить на Delay }

{ "Проявляем" картинку }
for i := 1 to 15 do
begin
  setpalette (i, i);
end;
{ ... и рисуем новую окружность сразу после "проявки"... }

Автор: ТОХА 1.04.2011 23:17

работает, правда белый цвет поменялся на голубой, проверял на самом первом с кругами без меню, но все равно спасибо)))

Добавлено через 4 мин.
на основную программу не очень повлияло, там красный используется, курсор голубой только

Добавлено через 19 мин.
для окончательного завершения осталось только подправить функцию mousein, у меня 1 из 10 запусков она хоть как-то работает на шариках и то под восьмой сбивается
остальные случаи при нахождении курсора внутри она возвращает false, да и способ игры не очень получается, приходится ставить readkey, наводишь мышь и жать энтер, иначе она так быстро рисует и проверяет координаты что я даже навести не успеваю))

Добавлено через 5 мин.

Function MouseIn(KoordX,KoordY,x1,y1,r:word):boolean;
var
rdx,rcx:word;
begin
asm
 mov ax,$03
 int $33
 mov rdx,dx
 mov rcx,cx
end;
MouseIn := (sqr((KoordX-x1)/r) + sqr((KoordY-y1)/r))<=1
end;
{из основной}
if ButtonPressed=1 then begin
 GetMouseXY(KoordX,KoordY);
if MouseIn(KoordX,KoordY,x1,y1,r) then next_circle:=true else next_circle:=false;
 end;

Автор: volvo 2.04.2011 0:01

Ты б прикрепил весь файл полностью (можно в приват), как только доберусь до TP - посмотрю, что там творится... А то так "глухие телефоны" получаются...

Автор: ТОХА 2.04.2011 0:05

ок в приват скину, а то при защите найдут проект мой тута и скажут скачал

Автор: volvo 2.04.2011 0:55

Что-то я не понял, чего ты творишь... Вот тут:

   { из основной }
   if ButtonPressed = 1 then
   begin
      GetMouseXY(KoordX,KoordY);
      if MouseIn(KoordX,KoordY,x1,y1,r) then next_circle:=true else next_circle:=false;
   end;

{ Заметь, я сделал параметры типа LongInt сразу, чтоб предотвратить переполнение }
Function MouseIn (KoordX, KoordY, x1, y1, r : LongInt) : boolean;
begin
   MouseIn := sqr(KoordX - X1) + sqr(KoordY - Y1) <= sqr®;
end;

Автор: ТОХА 2.04.2011 1:02

модуль мыши просто из FAQ брал,
как я и предпологал он рисует все круги сразу, как будто buttonpressed=1 это отсутсвие нажатия клавиши

Добавлено через 4 мин.
при изменении buttonpressed=1 -> buttonpressed=5 результат тот же, как будто условия вовсе нет

Автор: ТОХА 2.04.2011 1:46

ошибка в buttonpress это 100%, изменил условие начала вместо левой кнопки на ентер с учетом координат мыши, работает

Автор: volvo 2.04.2011 1:50

Так... Нашел DosBox с шестым Турбо-Паскалем... Вот это:

Function MouseIn (x1, y1, r : LongInt) : boolean;
var
   C_X, C_Y: word;
begin
   Asm
      mov ax, $03
      int $33
      mov C_X, CX
      mov C_Y, DX
   end;
   MouseIn := sqr(C_X - X1) + sqr(C_Y - Y1) <= sqr®;
end;

{ и в основном коде: }

   repeat { который после mouse_on }

      { ... }
      repeat until ButtonPressed = 1; { вместо if ButtonPressed=1 then }
      { Просто ждем, пока будет нажата левая кнопка мыши,
      а потом - проверяем, где именно она была нажата }

      next_circle := MouseIn(x1, y1, r);

   until next_circle = false;

Автор: ТОХА 2.04.2011 2:15

Эврика
все работает, буду до конца вечера тестить на баги)
без вас я бы не справился, это точно))

Автор: andriano 2.04.2011 18:18

      IntIt := 0;
      repeat
        r := Random(k) + 20;
        X1 := Random(GetMaxX - r*2) + r;
        Y1 := Random(GetMaxY - r*2) + r;

        ok := true;
        for i := 1 to curr do
          ok := ok and (sqr(C[i].X - X1) + sqr(C[i].Y - Y1) >
                        sqr(R + C[i].R));
        inc(IntIt);
      until ok or (IntIt > MaxIt);
      inc(curr);
      if IntIt > MaxIt then
        writeln('Ошибка: невозможно разместить ',curr,'-ю окружность');

Автор: volvo 2.04.2011 18:46

Автор: ТОХА 2.04.2011 20:31

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


Прикрепленные файлы
 PROJECT.PAS ( 5.27 килобайт ) Кол-во скачиваний: 310

Автор: Lapp 3.04.2011 6:09

Цитата(ТОХА @ 2.04.2011 17:31)

Автор: ТОХА 3.04.2011 16:51

я не студент
учусь в 10 классе)

Автор: hydroxychloroquine sulfate 200 m 5.12.2021 21:51

Cialis Super Actif Plus

Автор: is gabapentin a controlled subst 6.12.2021 3:44

Compro Viagra Poco Prezzo Mexico