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

← →
Селезин © (2006-08-22 00:54) [0]

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

Задачка такая. Имеется карта из гексагонов (шестиугольников). При движении мыши по карте необходимо подсчитывать координаты текущего гексагона и выдавать его в 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)+")";

← →
Ketmar © (2006-08-22 00:59) [1]

выдрал из своего проекта. пояснять лениво. %-)

function TfmMain.IsMouseInCell (x, y: Integer): Boolean; var sx, sy: Integer; begin sx := 90+x*42; sy := 60+y*32+15-15*(x mod 2); sx := msX-sx; sy := msY-sy; result := false; if (sx < 1) or (sx > 50) or (sy < 1) or (sy > 34) then exit; if (sy < 15) and ((sx < 7-(sy-1) div 2) or (sx > 44+(sy-1) div 2)) then exit; if (sy > 20) and ((sx < (sy-19) div 2) or (sx > 51-(sy-19) div 2)) then exit; result := true; end;

← →
Селезин © (2006-08-22 01:25) [2]

А хде, собственна координаты? Насколько я понял, функция выдает попадание в какую-то клетку, а не координаты этой клетки. Это значит, 4 раза вызывать функцию и делать проверку по 12 условиям?

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

← →
Zeqfreed © (2006-08-22 01:30) [3]

Как один из вариантов, можно построить quad-tree для всего поля, где каждый лист (насколько я могу вспомнить терминологию) будет соответствовать ограничивающему прямоугольнику для каждой отдельной клетки. Затем, я бы, чтобы не заморачиваться с формулами взял ч/б маску клетки и проверял попадание по отобраным поиском в quad-tree клеткам по маске. В теории это должно быстро работать :)

← →
Джо © (2006-08-22 01:32) [4]

Не знаю, поправит ли это проблемы с производительностью, но не пробовал использовать Region functions из GDI? Т.е, в данном случае, PtInRegion.

← →
Ketmar © (2006-08-22 01:36) [5]

> [2] Селезин © (22.08.06 01:25)
а координаты, собственна, -- эта rectangle. а дальше -- цикл. даже на моём pIII/600 это ну никак не тормозит. да и обратить функцию не так сложно, просто мне лениво. %-) зато кода немного.

← →
Ketmar © (2006-08-22 01:40) [6]

> [4] Джо © (22.08.06 01:32)
много регионов надо. %-) моя функция делает почти то же самое, но для частного случая. %-)
смотри: sx и sy -- это начало rect"а ячейки. msX и msY -- это мышь. дальше идёт как раз определение, валяется ли мышь в нужном регионе. %-)

← →
Джо © (2006-08-22 01:41) [7]

> [6] Ketmar © (22.08.06 01:40)
> > [4] Джо © (22.08.06 01:32)
> много регионов надо

А мне их не жалко :)

← →
Джо © (2006-08-22 01:44) [8]

> [6] Ketmar © (22.08.06 01:40)
> > [4] Джо © (22.08.06 01:32)
> много регионов надо.

А к тому же — почему "много"?
Действие первое: определяем ближайщие (в определенном радиусе) гексагоны по расстоянию от курсора до произвольной (скажем, первой) вершины гексагона. Или от курсора до центра тяжести. Оставшиеся гексагоны по одному "превращаем" в regions и проверяем до первого "попадания".

← →
Ketmar © (2006-08-22 01:47) [9]

> [8] Джо © (22.08.06 01:44)
ты накладные расходы прикинул на всю эту кухню? %-)

← →
guav © (2006-08-22 01:49) [10]

Откуда вызывается та процедура из [0] ?
Если из OnMouseMove, то можно переместить в OnIdle (событие компонента TApplicationEvents).

← →
Джо © (2006-08-22 01:50) [11]

> [9] Ketmar © (22.08.06 01:47)
> > [8] Джо © (22.08.06 01:44)
> ты накладные расходы прикинул на всю эту кухню? %-)

Ну уж поменьше, чем 25 квадратных корней в [0] ;-p

← →
Джо © (2006-08-22 01:50) [12]

> [11] Джо © (22.08.06 01:50)
> Ну уж поменьше, чем 25 квадратных корней в [0] ;-p

Пардон, "возведений в квадрат". :)

← →
Ketmar © (2006-08-22 01:53) [13]

> [11] Джо © (22.08.06 01:50)
5 делений и 3 умножения ещё меньше. %-)

← →
Джо © (2006-08-22 02:03) [14]

> [13] Ketmar © (22.08.06 01:53)
> > [11] Джо © (22.08.06 01:50)
> 5 делений и 3 умножения ещё меньше. %-)

Да я и не спорю. Так, спросонок выдвигаю непроверенные идеи. :)

← →
Ketmar © (2006-08-22 02:10) [15]

кстати, ради интереса: 10000000 возведений в квадрат у меня выполняется за ~50 миллисекунд. вопрос: а в этом ли тормоза?

← →
Джо © (2006-08-22 02:11) [16]

> [15] Ketmar © (22.08.06 02:10)
> кстати, ради интереса: 10000000 возведений в квадрат у меня
> выполняется за ~50 миллисекунд. вопрос: а в этом ли тормоза?

Фиг знает. Я сабжевый код не запускал, или, боже упаси, не анализировал. Вообще, ИМХО, такой код без комментариев выкладывать — неприлично. :(

← →
Ketmar © (2006-08-22 02:14) [17]

> [16] Джо © (22.08.06 02:11)
да я тоже. увидел кучу ужоса и просто нервно закурил. %-)

← →
guav © (2006-08-22 02:27) [18]

Кстати, о квадратах. _разных_ там только 5, так что можно ещё оптимизировать, ничего не меняя

← →
Селезин © (2006-08-22 02:27) [19]

Прилично-неприлично. От вас тоже коментариев не было.

А весь прикол в следующем. Тормоза возникают в строке alphaWind1.Caption := "("+IntToStr(XRes)+":"+IntToStr(YRes)+")"; Надеюсь здесь комментариев не надо. Таки интересно, почему?

← →
Ketmar © (2006-08-22 02:30) [20]

> [19] Селезин © (22.08.06 02:27)
таки наверное потому, что по сведениям моего телепатора это окно с альфа-каналом.

← →
Селезин © (2006-08-22 02:35) [21]

Черта с два, это самый обычный TLabel

← →
Ketmar © (2006-08-22 02:37) [22]

> [21] Селезин © (22.08.06 02:35)
вот "alphaWind1" меня сильно смущает. ну и -- неизветсно, на ком этот label лежит. так что все беды от 17-й строки, как всегда.

← →
Селезин © (2006-08-22 02:49) [23]

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

← →
Ketmar © (2006-08-22 03:10) [24]

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

← →
Селезин © (2006-08-22 03:16) [25]

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

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

← →
tButton © (2006-08-22 04:37) [26]

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

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

← →
Наиль © (2006-08-22 07:20) [27]

Насколько я понял из кода, твой алгоритм достаточно хорош чтобы не тормозить. Но рискну предложить свой вариант.
---- ---- / \ / \ / \ / \ ---- \ / \ / \ / \ / ---- ---- \ / \ / ---- +----+--+ +----+--+ | |\ | | |\ | | | \| | | \| | 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 08:11) [28]

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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;

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

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

Расчет координат Найти похожие ветки