program Noname4;
function minutes (Amin, Bmin :integer) : integer;
function time (Aval, Bval :integer) : integer;
begin
if (0 <= Aval) and (Bval < 24) then
time :=Bval - Aval;
if (0 <= Amin) and (Bmin < 60) then
minutes :=Bmin - Amin;
end;
var Aval, Amin, Bval, Bmin, n , x , i , y :integer;
duom, rez : text;
begin
readln(Aval, Amin, Bval, Bmin );
writeln(time(Aval, Bval));
writeln(minutes(Amin, Bmin));
readln;
assign(duom, 'Duomenys2.txt');
Reset(duom);
Readln(duom, n );
assign(rez, 'rezultatai2.txt');
rewrite(rez);
for i := 1 to n do
begin
Readln(duom, Aval, Amin, Bval, Bmin);
x := time(Aval, Bval);
y := minutes (Amin, Bmin);
writeln(rez, x);
writeln(rez, y);
end;
close(duom);
close(rez);
end.
Hello, I am getting a error (duplicate identifier, identifier already defined in line 2). It shows red in the ( duom, rez : text; ) line. Can't find out why
program Noname4;
function minutes (Amin, Bmin :integer) : integer;
function time (Aval, Bval :integer) : integer;
begin
if (0 <= Aval) and (Bval < 24) then
time :=Bval - Aval;
if (0 <= Amin) and (Bmin < 60) then
minutes :=Bmin - Amin;
end;
var Aval, Bval, n , x , i , y :integer;
duom, rez : text;
begin
assign(duom, 'Duomenys2.txt');
Reset(duom);
Readln(duom, n );
assign(rez, 'Rezultatai2.txt');
rewrite(rez);
for i := 1 to n do
begin
Readln(duom, Aval, Bval, Amin, Bmin);
x := time(Aval, Bval);
y := minutes(Amin, Bmin);
writeln(rez, x);
writeln(rez, y);
end;
close(duom);
close(rez);
end;
begin
end.
I did what you said, the program now works fine except it doesn't write the the answer in 'Rezultatai2.txt' file.
change:
var Aval, Amin, Bval, Bmin, n , x , i , y :integer;
duom, rez : text;
to:
var Aval, Bval, n , x , i , y :integer;
duom, rez : text;
they are already defined as variables passed into your minute function
Related
My code is doing strange thing when MoveMessage procedure takes max values(ScreenWidth and ScreenHeight). So the "Hello, world" string moves to the right down corner and doing strange thing, but the max and min values are set correctly.
Can someone tell me where is my mistake.
program HelloCrt;
uses crt;
const
Message = 'Hello, world!';
procedure GetKey(var code: integer);
var
c: char;
begin
c := Readkey;
if c = #0 then
begin
c := Readkey;
code := -ord(c);
end
else
code := ord(c);
end;
procedure ShowMessage(x, y: integer; msg: string);
begin
GotoXY(x, y);
write(msg);
GotoXY(1, 1);
end;
procedure HideMessage(x, y: integer; msg: string);
var
len, i: integer;
begin
len := Length(msg);
GotoXY(x, y);
for i := 1 to len do
write(' ');
GotoXY(1, 1);
end;
procedure MoveMessage(var x, y: integer; msg: string; dx, dy: integer);
begin
HideMessage(x, y, msg);
x := x + dx;
y := y + dy;
if x > (ScreenWidth - length(msg)) then
x := (ScreenWidth - length(msg) + 1);
if x < 1 then
x := 1;
if y > ScreenHeight then
y := ScreenHeight;
if y < 1 then
y := 1;
ShowMessage(x, y, msg);
end;
var
CurX, CurY: integer;
c: integer;
begin
clrscr;
CurX := (ScreenWidth - length(Message)) div 2;
CurY := ScreenHeight div 2;
ShowMessage(CurX, CurY, Message);
while true do
begin
Getkey(c);
if c > 0 then
break;
case c of
-75:
MoveMessage(CurX, CurY, Message, -1, 0);
-77:
MoveMessage(CurX, CurY, Message, 1, 0);
-72:
MoveMessage(CurX, CurY, Message, 0, -1);
-80:
MoveMessage(CurX, CurY, Message, 0, 1);
end
end;
clrscr;
end.
Even just in the middle of the program I inserted "write (OutPut, '2');" and even at the very end it is, but the "output" file is still created empty.
program HelloFromRussia;
var
s, y, h, n, x: Integer;
InPut, OutPut: Text;
begin
assign(InPut,'c:\input.txt');
assign(OutPut,'c:\output.txt');
reset(InPut);
rewrite(OutPut);
read(InPut, y);
write(OutPut, '1');
for var i:=1 to y do
begin
read(InPut, s);
if s mod 2 = 0 then write(OutPut, s, ' ');
end;
writeln(OutPut);
reset(InPut);
read(InPut, y);
for var i:=1 to y do
begin
read(InPut, s);
if s mod 2 <> 0 then writeln(OutPut);
write(OutPut, s, ' ');
end;
for h:=1 to y do begin
if s mod 2=0 then
n:=n+1;
if s mod 2<>0 then
x:=x+1;
end;
if (n>x) then writeln(OutPut, 'YES')
else writeln(OutPut, 'NO');
write(OutPut, '2');
close(InPut);
close(OutPut);
end.
I'm coding the Knight's tour problem to find a tour for the knight in a n*n chessboard. I have made 2 answers, which I think are identical. However, when compiled, two codes produce 2 different results. I want to know the difference between two of my codes.
This is my first code: http://ideone.com/WUI7xD.
const
max = 10;
type
square = array [-1..max+1, -1..max+1] of longint;
vector = array [1..max*max] of longint;
var
n : longint;
x : array [1..8] of longint = (-2, -2, -1, -1, +1, +1, +2, +2);
y : array [1..8] of longint = (-1, +1, -2, +2, -2, +2, -1, +1);
c, r : square;
a, b : vector;
checking : boolean;
procedure input;
begin
readln(n);
end;
procedure backTrack(i, u, v : longint);
var
j : longint;
begin
if (i > n * n) then
begin
checking := true;
exit;
end;
for j := 1 to 8 do
begin
if checking then exit;
inc(u, x[j]);
inc(v, y[j]);
if (u > 0) and (u <= n) and (v > 0) and (v <= n) and (i<=n*n) and (c[u,v] = 0) then
begin
c[u, v] := 1;
r[u, v] := i;
backTrack(i + 1, u, v);
c[u, v] := 0;
end;
dec(u, x[j]);
dec(v, y[j]);
end;
end;
procedure solve;
begin
fillchar(c, sizeof(c), 0);
c[1, 1] := 1;
r[1, 1] := 1;
checking := false;
backTrack(2, 1, 1);
end;
procedure output;
var
j, i : longint;
begin
for j := 1 to n do
begin
for i := 1 to n do
write(r[i, j], ' ');
writeln;
end;
readln;
end;
begin
input;
solve;
output;
end.
And my second code: http://ideone.com/FdFQuX
const
max = 10;
type
square = array [-1..max+1, -1..max+1] of longint;
vector = array [1..max*max] of longint;
var
n : longint;
x : array [1..8] of longint = (-2, -2, -1, -1, +1, +1, +2, +2);
y : array [1..8] of longint = (-1, +1, -2, +2, -2, +2, -1, +1);
c, r : square;
a, b : vector;
checking : boolean;
procedure input;
begin
readln(n);
end;
procedure backTrack(i, u, v : longint);
var
j : longint;
begin
if (i > n * n) then
begin
checking := true;
exit;
end;
r[u, v] := i;
for j := 1 to 8 do
begin
if checking then exit;
inc(u, x[j]);
inc(v, y[j]);
if (u > 0) and (u <= n) and (v > 0) and (v <= n) and (i <= n * n) and (c[u, v] = 0) then
begin
c[u, v] := 1;
backTrack(i + 1, u, v);
c[u, v] := 0;
end;
dec(u,x[j]);
dec(v,y[j]);
end;
end;
procedure solve;
begin
fillchar(c, sizeof(c), 0);
c[1, 1] := 1;
r[1, 1] := 1;
checking := false;
backTrack(1, 1, 1);
end;
procedure output;
var
j, i : longint;
begin
for j := 1 to n do
begin
for i:=1 to n do
write(r[i, j], ' ');
writeln;
end;
end;
begin
input;
solve;
output;
end.
r[u,v]:=i; appears before for j:=1 to 8 do in the second code but not the first.
There are differencing tools which can be used to tell where two text files differ. It is a good idea to become familiar with such tools.
OK, I just installed a Tortoise git in my PC. And I'm quiet amuse about the water effect from its about page.
try to move your mouse cursor on the turtle picture from tortoise GIT - About
its more like we are playing out finger on a water.
Does anyone know how to do make that kind of water effect in Delphi ?
See Leonel Togniolli's "Water Effects" at efg's lab.
The ripple effect is based on 2D Water Effects in December 1999 Game Developer Magazine Article
.
The algorithm is described in here 2D Water, as mentioned by François and as a reference in the source code.
Leonel's implementation is partly based on the gamedev article the-water-effect-explained by Roy Willemse. Here is also pascal code.
There is one more Delphi example at efg's called "Ripple Project", a screen shot is shown below.
Please do the following :
01. Create a Delphi Unit named "WaterEffect.pas" and paste the following codes:
unit WaterEffect;
interface
uses
Winapi.Windows, System.SysUtils, Vcl.Graphics, Math;
const
DampingConstant = 15;
type
PIntArray = ^TIntArray;
TIntArray = array[0..16777215] of Integer;
PPIntArray = ^TPIntArray;
TPIntArray = array[0..16777215] of PIntArray;
PRGBArray = ^TRGBArray;
TRGBArray = array[0..16777215] of TRGBTriple;
PPRGBArray = ^TPRGBArray;
TPRGBArray = array[0..16777215] of PRGBArray;
TWaterDamping = 1..99;
TWaterEffect = class(TObject)
private
{ Private declarations }
FrameWidth: Integer;
FrameHeight: Integer;
FrameBuffer01: Pointer;
FrameBuffer02: Pointer;
FrameLightModifier: Integer;
FrameScanLine01: PPIntArray;
FrameScanLine02: PPIntArray;
FrameScanLineScreen: PPRGBArray;
FrameDamping: TWaterDamping;
procedure SetDamping(Value: TWaterDamping);
protected
{ Protected declarations }
procedure CalculateWater;
procedure DrawWater(ALightModifier: Integer; Screen, Distance: TBitmap);
public
{ Public declarations }
constructor Create;
destructor Destroy; override;
procedure ClearWater;
procedure SetSize(EffectBackgroundWidth, EffectBackgroundHeight: Integer);
procedure Render(Screen, Distance: TBitmap);
procedure Bubble(X, Y: Integer; BubbleRadius, EffectBackgroundHeight: Integer);
property Damping: TWaterDamping read FrameDamping write SetDamping;
end;
implementation
{ TWaterEffect }
const
RandomConstant = $7FFF;
procedure TWaterEffect.Bubble(X, Y: Integer; BubbleRadius, EffectBackgroundHeight: Integer);
var
Rquad: Integer;
CX, CY, CYQ: Integer;
Left, Top, Right, Bottom: Integer;
begin
if (X < 0) or (X > FrameWidth - 1) then X := 1 + BubbleRadius + Random(RandomConstant) mod (FrameWidth - 2 * BubbleRadius - 1);
if (Y < 0) or (Y > FrameHeight - 1) then Y := 1 + BubbleRadius + Random(RandomConstant) mod (FrameHeight - 2 * BubbleRadius - 1);
Left := -Min(X, BubbleRadius);
Right := Min(FrameWidth - 1 - X, BubbleRadius);
Top := -Min(Y, BubbleRadius);
Bottom := Min(FrameHeight - 1 - Y, BubbleRadius);
Rquad := BubbleRadius * BubbleRadius;
for CY := Top to Bottom do
begin
CYQ := CY * CY;
for CX := Left to Right do
begin
if (CX * CX + CYQ <= Rquad) then
begin
Inc(FrameScanLine01[CY + Y][CX + X], EffectBackgroundHeight);
end;
end;
end;
end;
procedure TWaterEffect.CalculateWater;
var
X, Y, XL, XR: Integer;
NewH: Integer;
P1, P2, P3, P4: PIntArray;
PT: Pointer;
Rate: Integer;
begin
Rate := (100 - FrameDamping) * 256 div 100;
for Y := 0 to FrameHeight - 1 do
begin
P1 := FrameScanLine02[Y];
P2 := FrameScanLine01[Max(Y - 1, 0)];
P3 := FrameScanLine01[Y];
P4 := FrameScanLine01[Min(Y + 1, FrameHeight - 1)];
for X := 0 to FrameWidth - 1 do
begin
XL := Max(X - 1, 0);
XR := Min(X + 1, FrameWidth - 1);
NewH := (P2[XL] + P2[X] + P2[XR] + P3[XL] + P3[XR] + P4[XL] + P4[X] +
P4[XR]) div 4 - P1[X];
P1[X] := NewH * Rate div 256;
end;
end;
PT := FrameBuffer01;
FrameBuffer01 := FrameBuffer02;
FrameBuffer02 := PT;
PT := FrameScanLine01;
FrameScanLine01 := FrameScanLine02;
FrameScanLine02 := PT;
end;
procedure TWaterEffect.ClearWater;
begin
if FrameBuffer01 <> nil then ZeroMemory(FrameBuffer01, (FrameWidth * FrameHeight) * SizeOf(Integer));
if FrameBuffer02 <> nil then ZeroMemory(FrameBuffer02, (FrameWidth * FrameHeight) * SizeOf(Integer));
end;
constructor TWaterEffect.Create;
begin
inherited;
FrameLightModifier := 10;
FrameDamping := DampingConstant;
end;
destructor TWaterEffect.Destroy;
begin
if FrameBuffer01 <> nil then FreeMem(FrameBuffer01);
if FrameBuffer02 <> nil then FreeMem(FrameBuffer02);
if FrameScanLine01 <> nil then FreeMem(FrameScanLine01);
if FrameScanLine02 <> nil then FreeMem(FrameScanLine02);
if FrameScanLineScreen <> nil then FreeMem(FrameScanLineScreen);
inherited;
end;
procedure TWaterEffect.DrawWater(ALightModifier: Integer; Screen, Distance:
TBitmap);
var
DX, DY: Integer;
I, C, X, Y: Integer;
P1, P2, P3: PIntArray;
PScreen, PDistance: PRGBArray;
PScreenDot, PDistanceDot: PRGBTriple;
BytesPerLine1, BytesPerLine2: Integer;
begin
Screen.PixelFormat := pf24bit;
Distance.PixelFormat := pf24bit;
FrameScanLineScreen[0] := Screen.ScanLine[0];
BytesPerLine1 := Integer(Screen.ScanLine[1]) - Integer(FrameScanLineScreen[0]);
for I := 1 to FrameHeight - 1 do FrameScanLineScreen[i] := PRGBArray(Integer(FrameScanLineScreen[i - 1]) + BytesPerLine1);
begin
PDistance := Distance.ScanLine[0];
BytesPerLine2 := Integer(Distance.ScanLine[1]) - Integer(PDistance);
for Y := 0 to FrameHeight - 1 do
begin
PScreen := FrameScanLineScreen[Y];
P1 := FrameScanLine01[Max(Y - 1, 0)];
P2 := FrameScanLine01[Y];
P3 := FrameScanLine01[Min(Y + 1, FrameHeight - 1)];
for X := 0 to FrameWidth - 1 do
begin
DX := P2[Max(X - 1, 0)] - P2[Min(X + 1, FrameWidth - 1)];
DY := P1[X] - P3[X];
if (X + DX >= 0) and (X + DX < FrameWidth) and (Y + DY >= 0) and (Y + DY < FrameHeight) then
begin
PScreenDot := #FrameScanLineScreen[Y + DY][X + DX];
PDistanceDot := #PDistance[X];
C := PScreenDot.rgbtBlue - DX;
if C < 0 then PDistanceDot.rgbtBlue := 0 else if C > 255 then PDistanceDot.rgbtBlue := 255 else
begin
PDistanceDot.rgbtBlue := C;
C := PScreenDot.rgbtGreen - DX;
end;
if C < 0 then PDistanceDot.rgbtGreen := 0 else if C > 255 then PDistanceDot.rgbtGreen := 255 else
begin
PDistanceDot.rgbtGreen := C;
C := PScreenDot.rgbtRed - DX;
end;
if C < 0 then PDistanceDot.rgbtRed := 0 else if C > 255 then PDistanceDot.rgbtRed := 255 else
begin
PDistanceDot.rgbtRed := C;
end;
end
else
begin
PDistance[X] := PScreen[X];
end;
end;
PDistance := PRGBArray(Integer(PDistance) + BytesPerLine2);
end;
end;
end;
procedure TWaterEffect.Render(Screen, Distance: TBitmap);
begin
CalculateWater;
DrawWater(FrameLightModifier, Screen, Distance);
end;
procedure TWaterEffect.SetDamping(Value: TWaterDamping);
begin
if (Value >= Low(TWaterDamping)) and (Value <= High(TWaterDamping)) then FrameDamping := Value;
end;
procedure TWaterEffect.SetSize(EffectBackgroundWidth, EffectBackgroundHeight: Integer);
var
I: Integer;
begin
if (EffectBackgroundWidth <= 0) or (EffectBackgroundHeight <= 0) then
begin
EffectBackgroundWidth := 0;
EffectBackgroundHeight := 0;
end;
FrameWidth := EffectBackgroundWidth;
FrameHeight := EffectBackgroundHeight;
ReallocMem(FrameBuffer01, FrameWidth * FrameHeight * SizeOf(Integer));
ReallocMem(FrameBuffer02, FrameWidth * FrameHeight * SizeOf(Integer));
ReallocMem(FrameScanLine01, FrameHeight * SizeOf(PIntArray));
ReallocMem(FrameScanLine02, FrameHeight * SizeOf(PIntArray));
ReallocMem(FrameScanLineScreen, FrameHeight * SizeOf(PRGBArray));
ClearWater;
if FrameHeight > 0 then
begin
FrameScanLine01[0] := FrameBuffer01;
FrameScanLine02[0] := FrameBuffer02;
for I := 1 to FrameHeight - 1 do
begin
FrameScanLine01[I] := #FrameScanLine01[I - 1][FrameWidth];
FrameScanLine02[I] := #FrameScanLine02[I - 1][FrameWidth];
end;
end;
end;
end.
In "uses" add "WaterEffect".
Add a "Timer" with "Enable" property and "Interval=25".
In "Private Declaration" add "Water: TWaterEffect;" and "FrameBackground: TBitmap;".
Define "var X:Integer;"
Define the following
procedure TMainForm.FormCreate(Sender: TObject);
begin
Timer01.Enabled := true;
FrameBackground := TBitmap.Create;
FrameBackground.Assign(Image01.Picture.Graphic);
Image01.Picture.Graphic := nil;
Image01.Picture.Bitmap.Height := FrameBackground.Height;
Image01.Picture.Bitmap.Width := FrameBackground.Width;
Water := TWaterEffect.Create;
Water.SetSize(FrameBackground.Width,FrameBackground.Height);
X:=Image01.Height;
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
FrameBackground.Free;
Water.Free;
end;
procedure TMainForm.Image01MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Water.Bubble(X,Y,1,100);
end;
procedure TMainForm.Image01MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
Water.Bubble(X,Y,1,100);
end;
procedure TMainForm.Timer01Timer(Sender: TObject);
begin
if Random(8)= 1 then
Water.Bubble(-1,-1,Random(1)+1,Random(500)+50);
Water.Render(FrameBackground,Image01.Picture.Bitmap);
with Image01.Canvas do
begin
Brush.Style:=bsClear;
font.size:=12;
Font.Style:=[];
Font.Name := 'Comic Sans MS';
font.color:=$e4e4e4;
Textout(190, 30, DateTimeToStr(Now));
end;
end;
Now Compile. I think you will get the required effect.
That effect is generated by applying certain numerical transformations to the image. They're defined in the CWaterEffect class, which you can inspect for yourself in the WaterEffect.cpp source file.
I'm trying to implement A* path finding algorithm (now it's Dijkstra's algorithm i.e without heuristic) using this article Link. But I can't figure out what's wrong in my code (it finds incorrect path).
instead of the empty begin ... end; it should be this step:
If it is on the open list already, check to see if this path to that
square is better, using G cost as the measure. A lower G cost means
that this is a better path. If so, change the parent of the square to
the current square, and recalculate the G and F scores of the square.
but I think it is not important because there is no diagonal movement.
uses
crt;
const
MAXX = 20;
MAXY = 25;
type
TArr = array [0..MAXY, 0..MAXX] of integer;
TCell = record
x: integer;
y: integer;
end;
TListCell = record
x: integer;
y: integer;
G: integer;
parent: TCell;
end;
TListArr = array [1..10000] of TListCell;
TList = record
arr: TListArr;
len: integer;
end;
var
i, j, minind, ind, c: integer;
start, finish: TCell;
current: TListCell;
field: TArr;
opened, closed: TList;
procedure ShowField;
var
i, j: integer;
begin
textcolor(15);
for i := 0 to MAXX do
begin
for j := 0 to MAXY do
begin
case field[j, i] of
99: textcolor(8); // not walkable
71: textcolor(14); // walkable
11: textcolor(10); // start
21: textcolor(12); // finish
15: textcolor(2); // path
14: textcolor(5);
16: textcolor(6);
end;
write(field[j, i], ' ');
end;
writeln;
end;
textcolor(15);
end;
procedure AddClosed(a: TListCell);
begin
closed.arr[closed.len + 1] := a;
inc(closed.len);
end;
procedure AddOpened(x, y, G: integer);
begin
opened.arr[opened.len + 1].x := x;
opened.arr[opened.len + 1].y := y;
opened.arr[opened.len + 1].G := G;
inc(opened.len);
end;
procedure DelOpened(n: integer);
var
i: integer;
begin
AddClosed(opened.arr[n]);
for i := n to opened.len - 1 do
opened.arr[i] := opened.arr[i + 1];
dec(opened.len);
end;
procedure SetParent(var a: TListCell; parx, pary: integer);
begin
a.parent.x := parx;
a.parent.y := pary;
end;
function GetMin(var a: TList): integer;
var
i, min, mini: integer;
begin
min := MaxInt;
mini := 0;
for i := 1 to a.len do
if a.arr[i].G < min then
begin
min := a.arr[i].G;
mini := i;
end;
GetMin := mini;
end;
function FindCell(a: TList; x, y: integer): integer;
var
i: integer;
begin
FindCell := 0;
for i := 1 to a.len do
if (a.arr[i].x = x) and (a.arr[i].y = y) then
begin
FindCell := i;
break;
end;
end;
procedure ProcessNeighbourCell(x, y: integer);
begin
if (field[current.x + x, current.y + y] <> 99) then // if walkable
if (FindCell(closed, current.x + x, current.y + y) <= 0) then // and not visited before
if (FindCell(opened, current.x + x, current.y + y) <= 0) then // and not added to list already
begin
AddOpened(current.x + x, current.y + y, current.G + 10);
SetParent(opened.arr[opened.len], current.x, current.y);
// field[opened.arr[opened.len].x, opened.arr[opened.len].y]:=16;
end
else
begin
end;
end;
begin
randomize;
for i := 0 to MAXX do
for j := 0 to MAXY do
field[j, i] := 99;
for i := 1 to MAXX - 1 do
for j := 1 to MAXY - 1 do
if random(5) mod 5 = 0 then
field[j, i] := 99
else field[j, i] := 71;
// start and finish positions coordinates
start.x := 5;
start.y := 3;
finish.x := 19;
finish.y := 16;
field[start.x, start.y] := 11;
field[finish.x, finish.y] := 21;
ShowField;
writeln;
opened.len := 0;
closed.len := 0;
AddOpened(start.x, start.y, 0);
SetParent(opened.arr[opened.len], -1, -1);
current.x := start.x;
current.y := start.y;
repeat
minind := GetMin(opened);
current.x := opened.arr[minind].x;
current.y := opened.arr[minind].y;
current.G := opened.arr[minind].G;
DelOpened(minind);
ProcessNeighbourCell(1, 0); // look at the cell to the right
ProcessNeighbourCell(-1, 0); // look at the cell to the left
ProcessNeighbourCell(0, 1); // look at the cell above
ProcessNeighbourCell(0, -1); // look at the cell below
if (FindCell(opened, finish.x, finish.y) > 0) then
break;
until opened.len = 0;
// count and mark path
c := 0;
while ((current.x <> start.x) or (current.y <> start.y)) do
begin
field[current.x, current.y] := 15;
ind := FindCell(closed, current.x, current.y);
current.x := closed.arr[ind].parent.x;
current.y := closed.arr[ind].parent.y;
inc(c);
end;
ShowField;
writeln(c);
readln;
end.
Edit Feb 1 '12: updated code, also fixed path marking (there should be or instead and), looks like it works now :)
You should rewrite the program to use a loop instead of cut-and-paste to visit each neighbor. If you do that you will avoid bugs like the following:
if (field[current.x, current.y - 1] <> 99) then
if (FindCell(closed, current.x, current.y - 1) <= 0) then
if (FindCell(opened, current.x + 1, current.y) <= 0) then
(See the inconsistent current.x + 1, current.y in the last line.)
With respect to the loop, I was thinking of something like this (pseudo-Python):
neighbor_offsets = [(0, 1), (0, -1), (1, 0), (-1, 0)]
for offset in neighbor_offsets:
neighbor = current + offset
if is_walkable(neighbor) and not is_visited(neighbor):
# Open 'neighbor' with 'current' as parent:
open(neighbor, current)
# Perhaps check if the goal is reached:
if neighbor == finish:
goal_reached = True
break
If you don't write a loop but just refactor to
ProcessCell(x+1, y);
ProcessCell(x-1, y);
ProcessCell(x, y-1);
ProcessCell(x, y-1);
then that's a great improvement too.
Youre posting quite a lot of code, have you tried narrow it down where it fails?
Have you compared your code with the pseudocode on wikipedia?
Also remember that dijkstra is just A* with a heuristic of 0.
Edit:
The article you linked (which I now realize is the very same I used to learn the A*, funny) contains illustrated steps. I would suggest that you recreate that map/grid and run your implementation on it. Then step through the images:
Are the eight initial neighbors added to the open list? Do they have the correct parent?
Is the correct open node picked as next to be scanned according to the heuristic?
Is the list of closed nodes correct?
And so on...