у нас тут в Дюне на Сеге затык вылез 
в особо тяжелых случаях глубокого кастома гор на карте (в оригинале такого не было), хотя впрочем и без кастома - тупо стандартные стены выстроить и юнит может начинать тупить при езде. куска оригинального сеговского варианта Дюны с этим просчетом у нас нет. есть досовский вариант Дюны, а сеговская произошла от неё и наверное там алгоритм очень похож:
/**
* Calculate the route to a tile.
*
* Stack: 1 - An encoded tile to calculate the route to.
*
* @param script The script engine to operate on.
* @return 0 if we arrived on location, 1 otherwise.
*/
uint16 Script_Unit_CalculateRoute(ScriptEngine *script)
{
Unit *u;
uint16 encoded;
uint16 packedSrc;
uint16 packedDst;
u = g_scriptCurrentUnit;
encoded = STACK_PEEK(1);
if (u->currentDestination.x != 0 || u->currentDestination.y != 0 || !Tools_Index_IsValid(encoded)) return 1;
packedSrc = Tile_PackTile(u->o.position);
packedDst = Tools_Index_GetPackedTile(encoded);
if (packedDst == packedSrc) {
u->route[0] = 0xFF;
u->targetMove = 0;
return 0;
}
if (u->route[0] == 0xFF) {
Pathfinder_Data res;
uint8 buffer[42];
res = Script_Unit_Pathfinder(packedSrc, packedDst, buffer, 40);
memcpy(u->route, res.buffer, min(res.routeSize, 14));
if (u->route[0] == 0xFF) {
u->targetMove = 0;
if (u->o.type == UNIT_SANDWORM) {
script->delay = 720;
}
}
} else {
uint16 distance;
distance = Tile_GetDistancePacked(packedDst, packedSrc);
if (distance < 14) u->route[distance] = 0xFF;
}
if (u->route[0] == 0xFF) return 1;
if (u->orientation[0].current != (int8)(u->route[0] * 32)) {
Unit_SetOrientation(u, (int8)(u->route[0] * 32), false, 0);
return 1;
}
if (!Unit_StartMovement(u)) {
u->route[0] = 0xFF;
return 0;
}
memmove(&u->route[0], &u->route[1], 13);
u->route[13] = 0xFF;
return 1;
}затык в чем - я ваще не понимаю что там происходит ))) поэтому попытался родить свой... и сразу-же на первом скачке и раскололся. то есть как только на пути есть препятствие - мне пока не понятно как его "обходить".
поэтому если вдруг кто занимался подобным вопросом и у кого есть и кому не жалко - выложить крайне спартанского и простого алгоритма поиска пути - был бы очень признателен. по замыслу мне надо понять что там происходить и попытаться уже его воспроизвести в нашей дюновской приставочной вселенной.
правой и левой кнопкой мышки ставим боксы "от" и "до", а средней кнопкой мышки можно препятствия рисовать.
Enumeration
#Window
#MainCanvas
EndEnumeration
Structure MAPy
MAPx.b[16]
EndStructure
Global Dim MAPArry.MAPy(16)
Structure MAPPoint
MAPPointX.b
MAPPointY.b
EndStructure
Global OldPoint.MAPPoint
Global OldToPoint.MAPPoint
OldPoint\MAPPointX = -1
OldPoint\MAPPointY = -1
OldToPoint\MAPPointX = -1
OldToPoint\MAPPointY = -1
Procedure.a SetRedMark(x, y)
ret.a
If MAPArry(y)\MAPx[x] = 0
MAPArry(y)\MAPx[x] = 1
ret = 1
EndIf
ProcedureReturn ret
EndProcedure
For i = 1 To 20
ret = 0
Repeat
x = Random(15, 1)
y = Random(15, 1)
ret = SetRedMark(x, y)
Until ret = 1
Next
Procedure CountPathNext(fromx, intox, fromy, intoy)
If fromx > intox
xnext = -1
ElseIf fromx < intox
xnext = 1
Else ; =
xnext = 0
EndIf
If fromy > intoy
ynext = -1
ElseIf fromy < intoy
ynext = 1
Else ; =
ynext = 0
EndIf
If MAPArry(fromy + ynext)\MAPx[fromx + xnext] = 0
MAPArry(fromy + ynext)\MAPx[fromx + xnext] = -3
CountPathNext(fromx + xnext, intox, fromy + ynext, intoy)
EndIf
EndProcedure
Procedure PaintCanvas()
color.l
If OldPoint\MAPPointX > -1 And OldToPoint\MAPPointX > -1
; means both points is sets.
; start count
CountPathNext(OldPoint\MAPPointX, OldToPoint\MAPPointX, OldPoint\MAPPointY, OldToPoint\MAPPointY)
EndIf
If StartDrawing(CanvasOutput(#MainCanvas))
For y = 0 To 14
For x = 0 To 14
Select MAPArry(y)\MAPx[x]
Case 0
color = RGB(100, 200, 100)
Case 1
color = RGB(200, 100, 100)
Case -1
color = RGB(50, 50, 200)
Case -2
color = RGB(100, 100, 200)
Case -3
color = RGB(150, 150, 200)
EndSelect
Box(x*32, y*32, 32, 32, color)
Next
Next
StopDrawing()
EndIf
EndProcedure
If OpenWindow(#Window, 100, 100, 500, 500, "", #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered)
CanvasGadget(#MainCanvas, 10, 10, 480, 480)
PaintCanvas()
Repeat
Select WaitWindowEvent()
Case #PB_Event_Gadget
Select EventGadget()
Case #MainCanvas
Select EventType()
Case #PB_EventType_LeftClick
; select box
x = GetGadgetAttribute(#MainCanvas, #PB_Canvas_MouseX)
x / 32
y = GetGadgetAttribute(#MainCanvas, #PB_Canvas_MouseY)
y / 32
If MAPArry(y)\MAPx[x] = 0
If OldPoint\MAPPointX > -1 And OldPoint\MAPPointY > -1
MAPArry(OldPoint\MAPPointY)\MAPx[OldPoint\MAPPointX] = 0
EndIf
MAPArry(y)\MAPx[x] = -1
OldPoint\MAPPointX = x
OldPoint\MAPPointY = y
; clear old path counting
For y = 0 To 14
For x = 0 To 14
If MAPArry(y)\MAPx[x] = -3
MAPArry(y)\MAPx[x] = 0
EndIf
Next
Next
PaintCanvas()
EndIf
Case #PB_EventType_RightClick
; go to box
x = GetGadgetAttribute(#MainCanvas, #PB_Canvas_MouseX)
x / 32
y = GetGadgetAttribute(#MainCanvas, #PB_Canvas_MouseY)
y / 32
If MAPArry(y)\MAPx[x] = 0
If OldToPoint\MAPPointX > -1 And OldToPoint\MAPPointY > -1
MAPArry(OldToPoint\MAPPointY)\MAPx[OldToPoint\MAPPointX] = 0
EndIf
MAPArry(y)\MAPx[x] = -2
OldToPoint\MAPPointX = x
OldToPoint\MAPPointY = y
; clear old path counting
For y = 0 To 14
For x = 0 To 14
If MAPArry(y)\MAPx[x] = -3
MAPArry(y)\MAPx[x] = 0
EndIf
Next
Next
PaintCanvas()
EndIf
Case #PB_EventType_MiddleButtonUp
; third mouse button - to set walls
x = GetGadgetAttribute(#MainCanvas, #PB_Canvas_MouseX)
x / 32
y = GetGadgetAttribute(#MainCanvas, #PB_Canvas_MouseY)
y / 32
If MAPArry(y)\MAPx[x] = 1
MAPArry(y)\MAPx[x] = 0
; clear old path counting
For y = 0 To 14
For x = 0 To 14
If MAPArry(y)\MAPx[x] = -3
MAPArry(y)\MAPx[x] = 0
EndIf
Next
Next
PaintCanvas()
ElseIf MAPArry(y)\MAPx[x] = 0
MAPArry(y)\MAPx[x] = 1
; clear old path counting
For y = 0 To 14
For x = 0 To 14
If MAPArry(y)\MAPx[x] = -3
MAPArry(y)\MAPx[x] = 0
EndIf
Next
Next
PaintCanvas()
EndIf
EndSelect
EndSelect
Case #PB_Event_CloseWindow
qiut = 1
EndSelect
Until qiut = 1
EndIf
Endпроблема оригинального кода:
а в некоторых случаях оно и вовсе падает в бексконечную рекурсию - юнит, страдая расстройством памяти, начинает туда сюда гонять. в видео этого нет, но оно кароче есть
Отредактировано SeregaZ (04.07.2021 18:03:05)