Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Расчет координат [D7]


Страницы:   1 2 3

Селезин ©   (2006-08-22 00:54:00) 

Не знаю, куда правильнее написать, сюда или в игровой форум. Ну, перекинут, если что.

Задачка такая. Имеется карта из гексагонов (шестиугольников). При движении мыши по карте необходимо подсчитывать координаты текущего гексагона и выдавать его в label. Гексагоны симметричные с горизонтальными верхними и нижними сторонами. Ширина гексагона - 68 по максимуму, 32 по горизонтальной стороне. Высота гексагона - 50.

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


Xleft := (X-32) div 50;
YTop := (Y-25) div 50;
X1 := Xleft*50+32;
X2 := X1+50;
Y1 := YTop*50+25;
Y2 := Y1+25;
Y3 := Y2+25;
if (Odd(XLeft)) then
begin
 if (sqr(X-X1)+sqr(Y-Y1)<=sqr(X-X2)+sqr(Y-Y2)) AND (sqr(X-X1)+sqr(Y-Y1)<=sqr(X-X1)+sqr(Y-Y3)) then
 begin
   XRes := XLeft;
   YRes := YTop;
 end
 else
   if (sqr(X-X2)+sqr(Y-Y2)<=sqr(X-X1)+sqr(Y-Y1)) AND (sqr(X-X2)+sqr(Y-Y2)<=sqr(X-X1)+sqr(Y-Y3))  then
   begin
     XRes := XLeft+1;
     YRes := YTop;
   end
   else
     if (sqr(X-X1)+sqr(Y-Y3)<=sqr(X-X1)+sqr(Y-Y1)) AND (sqr(X-X1)+sqr(Y-Y3)<=sqr(X-X2)+sqr(Y-Y2))
     then
     begin
       XRes := XLeft;
       YRes := YTop+1;
     end;
end
else
begin
 if (sqr(X-X1)+sqr(Y-Y2)<=sqr(X-X2)+sqr(Y-Y1)) AND (sqr(X-X1)+sqr(Y-Y2)<=sqr(X-X2)+sqr(Y-Y3))
 then
 begin
   XRes := XLeft;
   YRes := YTop;
 end
 else
   if (sqr(X-X2)+sqr(Y-Y1)<=sqr(X-X1)+sqr(Y-Y2)) AND (sqr(X-X2)+sqr(Y-Y1)<=sqr(X-X2)+sqr(Y-Y3))
   then
   begin
     XRes := XLeft+1;
     YRes := YTop;
   end
   else
     if (sqr(X-X2)+sqr(Y-Y3)<=sqr(X-X1)+sqr(Y-Y2)) AND (sqr(X-X2)+sqr(Y-Y3)<=sqr(X-X2)+sqr(Y-Y1))
     then
     begin
       XRes := XLeft+1;
       YRes := YTop+1;
     end;
end;
alphaWind1.Caption := '('+IntToStr(XRes)+':'+IntToStr(YRes)+')';

ANTPro   (2006-08-22 19:14:00) [1]

Селезин ©   (22.08.06 17:08) [42]
alphaWind1.Caption := ...

Замени Label на вот это и забудешь про тормоза:


     Form1.Canvas.Brush.Color:=clInfoBk;//Цвет фона
     Form1.Canvas.Pen.Color:=clBlack;   //Цвет Текста
     Form1.Canvas.Rectangle(0,0,105,25);//Фон для красоты
     Form1.Canvas.TextOut(5,5,'X='+Int2Digs(X,3)+' Y='+Int2Digs(Y,3));//Вывод текста


ЗЫ: Надо будет обновлять, через OnPaint.

Селезин   (2006-08-22 17:08:00) [2]

Ну да, у меня условия посложнее, и их меньше. А как еще расстояния вычислить?
Кстати, сейчас заметил, условия с sqrN, разделенные else, лучше поменять местами - вероятность попадания в первую проверку больше (около 40%)

Селезин   (2006-08-22 16:59:00) [3]

А есть другой способ вычисления расстояний?
В принципе, sqr выносится 'за скобки'

Xleft := (X-32) div 50; {приближенные координаты - поиск по прямоугольнику аналогично [27]}
YTop := (Y-25) div 50;
X1 := Xleft*50+32; {координаты центроа соседних гексов}
X2 := X1+50;
Y1 := YTop*50+25; {координаты центров соседних гексов}
Y2 := Y1+25;
Y3 := Y2+25;
sqr1:=sqr(X-X1);
sqr2:=sqr(X-X2);
sqr3:=sqr(X-Y1);
sqr4:=sqr(X-Y2);
sqr5:=sqr(X-Y3);
{определение расстояний до центров трех гексов, входящих в прямоугольник}
if (Odd(XLeft)) then
  if (sqr2+sqr4<=sqr1+sqr3) AND (sqr2+sqr4<=sqr1+sqr5)  then Inc(XLeft);
  else
    if (sqr1+sqr5<=sqr1+sqr3) AND (sqr1+sqr5<=sqr2+sqr4) then Inc(YTop)
else
  if (sqr2+sqr3<=sqr1+sqr4) AND (sqr2+sqr3<=sqr2+sqr5) then Inc(XLeft);
  else
    if (sqr2+sqr5<=sqr1+sqr4) AND (sqr2+sqr5<=sqr2+sqr3) then
    begin
      Inc(XLeft);
      Inc(YTop);
    end;
label1.Caption := '('+IntToStr(XLeft)+':'+IntToStr(YTop)+')';

Наиль   (2006-08-22 14:52:00) [4]

Я начал писать до того как, MBo реализовал мой алгоритм.
Поэтому дальнейший текст немного запоздалый.

Я не зря написал, что приведёный автором алгоритм не плох.
Тем более, что если его грамотно переписать, то он займёт строчек 15-20.
Мой алгоритм не намного лучше, или хуже.
Но есть некоторые моменты на которые стоит обратить внимание.
1. Лестница
if then else
 if then else
будет одинаковая в обоих алгоритмах (или на ступеньку больше, в моём случае)
2. Даже для линий с углом наклона 25/18 можно подобрать целочисленную формулу. (что-то вроде 18*x+a<25*y+b)
3. В авторском варианте вероятность угадать гексогон с первого сравнения значительно выше.
4. В моём случае три очень простых условия и четыре else.
Я считаю, что единственый недостаток авторского кода в большом количестве sqr.

MBo   (2006-08-22 14:15:00) [5]


const
 Edge = 80;
 HalfEdge = Edge div 2;
 HalfHgt = Edge * 1732 div 2000;
 Hgt = HalfHgt * 2;
 Wdt = 2 * Edge;
 CellWdt = 3 * HalfEdge;
 Shift = Edge;

function TForm6.FindHexCell(x, y: Integer): TPoint;
var
 nx, remx, ny, remy, tmp: Integer;
begin
 x := x - Shift + HalfEdge;
 y := y - Shift + HalfHgt;
 nx := x div CellWdt;
 remx := ((x mod CellWdt) - CellWdt) * HalfHgt;
 tmp := -1;
 if Odd(nx) then begin
   y := y - HalfHgt;
   Inc(tmp);
 end;
 ny := y div Hgt;
 remy := ((y mod Hgt) - HalfHgt) * HalfEdge;
 if remy < remx then begin
   Inc(nx);
   Inc(ny, tmp);
 end;
 if remy > -remx then begin
   Inc(nx);
   Inc(ny, tmp + 1);
 end;
 Result.X := nx;
 Result.Y := ny;
end;

procedure TForm6.FormMouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
var
 p: TPoint;
begin
 p := FindHexCell(x, y);
 Caption := Format('      %d: %d', [p.Y, p.X]);
end;

procedure TForm6.FormPaint(Sender: TObject);
var
 ix, iy, xx, yy: Integer;
 s: string;

 procedure DrawHex;
 begin
   Canvas.MoveTo(xx - Edge, yy);
   Canvas.LineTo(xx - HalfEdge, yy - HalfHgt);
   Canvas.LineTo(xx + HalfEdge, yy - HalfHgt);
   Canvas.LineTo(xx + Edge, yy);
   Canvas.LineTo(xx + HalfEdge, yy + HalfHgt);
   Canvas.LineTo(xx - HalfEdge, yy + HalfHgt);
   Canvas.LineTo(xx - Edge, yy);
 end;
begin
 for iy := 0 to 3 do
   for ix := 0 to 3 do begin
     yy := Shift + iy * Hgt;
     if Odd(ix) then
       yy := yy + HalfHgt;
     xx := Shift + CellWdt * ix;
     DrawHex;
     s := Format('%d: %d', [iy, ix]);
     Canvas.TextOut(xx - 10, yy - 10, s);
   end;
end;

Селезин   (2006-08-22 13:02:00) [6]

Дык 4 области - 3 сравнения. Плюс проверка на четность "кладки". В моем варианте идет проверка на четность и два сравнения (после оптимизации).
И кстати, проверка выше-ниже предполагает действительные (линия-то с углом наклона 25/18).

Боюсь, что рисунок не нарисую, отличие алгоритма в том, что режется почти так же, но вычисляется не 'сверху-снизу границы', а расстояние до центров трех граничных областей (основная, справа-вверху, справа-внизу). Понятно, что какое расстояние меньше, туда и попадает точка. Так что всего две поверки получается фактически.

MBo   (2006-08-22 12:10:00) [7]

>Но вот сравнений будет поболе
два-три сравнения, вся работа в целых числах, строчек 10-15 получится

Селезин   (2006-08-22 12:06:00) [8]

---
tButton ©   (22.08.06 08:11) [28]

о. ещё есть извращённый метод. создать двухмерный массив и в него записать координаты гексагона соотвествующего координатам пикселя.
индексами массива будут координаты пикселя.
---
Ага, особенно если учесть, что карта размером 2500*1260 пикселей :)

---
MBo ©   (22.08.06 08:58) [29]

Автор, воспользуйся
>Наиль ©   (22.08.06 07:20) [27]
Это отличный алгоритм.
---
Ну практически то же тяготение к центру. Но вот сравнений будет поболе (хотя без корней для вычисления расстояний обойдется).

=====
По поводу тормозов - дело было в буферизации отрисовки окна. Хотя если присмотреться, даже после оптимизации и снятии буферизации видны слабые рывки при быстрых скоростях мыши.

miek   (2006-08-22 11:51:00) [9]

Тормоза в той строчке (скорее всего) из-за того, что вместе с обновлением caption обновляется и само окно, под которым лежит label.

tButton   (2006-08-22 10:40:00) [10]


> Согласен, но оптимизировать, так оптимизировать.

может, ну его тогда нафиг?

Ketmar   (2006-08-22 10:21:00) [11]

> [32] Наиль ©   (22.08.06 10:18)
тогда уж WinAPI, FastMM и асм. %-)

Наиль   (2006-08-22 10:18:00) [12]


> ай, ну право же, не могут IntToStr() так дико тормозить.

Согласен, но оптимизировать, так оптимизировать.

tButton   (2006-08-22 10:14:00) [13]

ещё извращённый способ.
когда берётся разноцветный битмап-шаблон и по цвету пикселя определяется в какой hex попадает точка.

Ketmar   (2006-08-22 10:03:00) [14]

> [27] Наиль ©   (22.08.06 07:20)
> преобразование к строке всегда
ай, ну право же, не могут IntToStr() так дико тормозить.

MBo   (2006-08-22 08:58:00) [15]

Автор, воспользуйся
>Наиль ©   (22.08.06 07:20) [27]
Это отличный алгоритм.

tButton   (2006-08-22 08:11:00) [16]

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

Наиль   (2006-08-22 07:20:00) [17]

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

   ----            ----
 /      \        /      \
/        \      /        \
           ----
\        /      \        /
 \      /        \      /
   ----            ----
        \        /
         \      /
           ----

  +----+--+       +----+--+
  |    |\ |       |    |\ |
  |    | \|       |    | \|
  | a  |b +----+--| a  |b +
  |    | /|    |\ |    | /|
  |    |/ |    | \|    |/ |
  +----+--+ a  |b +----+--+
        \ |    | /|
         \|    |/ |
          +----+--+

На гексаконы накладываются (не визуально конечно) прямоугольники ab (см. рисунок). Получается кирпичная стена сверху-вниз. Тогда алгоритм такой:
1. Определение координаты кирпича.
1.1. Определить номер столбца и смещение столбца по Y.
1.2. Используя смещение найти номер кирпича.
2. Если точка находится в половинке a, то гексагон определён однозначно.
3. Если точка находится в половинке b, то пользуясь сравнением "выше или ниже линии" определяем над каким из трёх гексагонов находится мышь.

> Ну и на том спасибо, будет разбирать остальной код.

Не нужно разбирать остальной код, ибо:
> Тормоза возникают в строке alphaWind1.Caption := '('+IntToStr(XRes)+':'+IntToStr(YRes)+')';

У тебя производится преобразование к строке всегда, даже если ты в том же гексагоне.
Нужно делать так:

if (oldX<>newX) or (oldY<>newY) then ...Caption:= ...newX ...newY...;

tButton   (2006-08-22 04:37:00) [18]

а... мм... такой вариант (запланировал, ибо собирался с гексагонами работать, но ещё не испытал)

взять часть гексагонов (в область +/- 1.5_радиуса_гексагона) и найти расстояние до центра ближайшего?

Селезин   (2006-08-22 03:16:00) [19]

Ну и на том спасибо, будет разбирать остальной код.

В общем же, было предложено два стандарных решения. Неужто кроме как через прямоугольник и тяготение масс (расстояние до центра гекса) или тяготение цвета (маска прямоугольника) больше вариантов нету?

Ketmar   (2006-08-22 03:10:00) [20]

> [23] Селезин ©   (22.08.06 02:49)
"как всегда" -- это значит, что без кода проблема нелокализуема.

Страницы:   1 2 3

Наверх

Титульная страница Поиск, карта сайта Написать письмо