Форум на Исходниках.RU

На Паскале очень даже ничего...

Я захотел посмотреть, что тут делается, запустил под ХР найденый в сети ТР 7.0, а он на эту программу (впрочем и на нижнюю тоже) ругается давно не виданным сообщением: Деление на нуль, ошибка 200. При этом родные туториалы компилит и исполняет нормально, то есть сам Пасик не битый. В чем моя ошибка? Откуда "груз 200"?
]]> Arsenal Алгоритмы https://forum.sources.ru/index.php?showtopic=9240&view=findpost&p=90633 Sat, 12 Jul 2003 13:57:48 +0000 Волновой алгоритм https://forum.sources.ru/index.php?showtopic=9240&view=findpost&p=90633

Program Voln; Uses Crt; Const Map : array [1..10, 1..10] of Byte = ( (0, 0, 1, 0, 0, 0, 0, 0, 0, 0), (1, 0, 0, 0, 0, 1, 0, 0, 1, 0), (0, 0, 0, 1, 1, 1, 0, 0, 1, 1), (0, 1, 0, 0, 0, 1, 0, 0, 1, 0), (0, 0, 0, 0, 1, 1, 1, 0, 1, 0), (0, 0, 1, 1, 1, 0, 1, 0, 0, 0), (0, 0, 0, 1, 0, 0, 1, 0, 0, 0), (1, 1, 0, 1, 0, 0, 1, 1, 1, 0), (0, 1, 0, 0, 0, 0, 1, 0, 0, 0), (0, 1, 0, 0, 0, 0, 1, 0, 0, 0) ); var XS, YS, XE, YE : Byte; X, Y, I : Byte; MapM : array [1..10, 1..10] of Byte; Moves : Byte; MovesX : array [1..100] of Byte; MovesY : array [1..100] of Byte; Procedure Next(Var X, Y : Byte); Begin If (X <10) and (MapM[X, Y] - MapM[X + 1, Y] = 1) then Begin X := X + 1; Exit; End; If (X >1) and (MapM[X, Y] - MapM[X - 1, Y] = 1) then Begin X := X - 1; Exit; End; If (Y <10) and (MapM[X, Y] - MapM[X, Y + 1] = 1) then Begin Y := Y + 1; Exit; End; If (Y >1) and (MapM[X, Y] - MapM[X, Y - 1] = 1) then Begin Y := Y - 1; Exit; End; End; Begin ClrScr; For Y := 1 to 10 do Begin For X := 1 to 10 do Write(Map[X, Y], ' '); WriteLn; End; WriteLn('Please enter X and Y of the start: '); ReadLn(XS, YS); WriteLn('Please enter X and Y of the end: '); ReadLn(XE, YE); If (Map[XS, YS] = 1) or (Map[XE, YE] = 1) then Begin WriteLn('Error!!!'); ReadLn; Halt; End; MapM[XS, YS] := 1; I := 1; Repeat I := I + 1; For Y := 1 to 10 do For X := 1 to 10 do If MapM[X, Y] = I - 1 then Begin If (Y <10) and (MapM[X, Y + 1] = 0) and (Map[X, Y+1] = 0) Then MapM[X, Y+1] := I; If (Y >1) and (MapM[X, Y-1] = 0) and (Map[X, Y-1] = 0) Then MapM[X, Y-1] := I; If (X <10) and (MapM[X+1, Y] = 0) and (Map[X+1, Y] = 0) Then MapM[X+1, Y] := I; If (X >1) and (MapM[X-1, Y] = 0) and (Map[X-1, Y] = 0) Then MapM[X-1, Y] := I; End; If I = 100 then Begin WriteLn('You can''t go there!!!'); ReadLn; Halt; End; Until MapM[XE, YE] >0; Moves := I - 1; X := XE; Y := YE; I := Moves; Map[XE, YE] := 4; Repeat MovesX[I] := X; MovesY[I] := Y; Next(X, Y); Map[X, Y] := 3; I := I - 1; Until (X = XS) and (Y = YS); Map[XS, YS] := 2; For I := 1 to Moves do WriteLn('X = ', MovesX[I],', Y = ', MovesY[I]); WriteLn('Total: ', Moves, ' moves'); ReadLn; For Y := 1 to 10 do Begin For X := 1 to 10 do Write(Map[X, Y], ' '); WriteLn; End; ReadLn; End.

]]> Danaris Алгоритмы https://forum.sources.ru/index.php?showtopic=9240&view=findpost&p=90632 Sat, 12 Jul 2003 09:34:58 +0000 Волновой алгоритм https://forum.sources.ru/index.php?showtopic=9240&view=findpost&p=90632 Antipich Алгоритмы https://forum.sources.ru/index.php?showtopic=9240&view=findpost&p=90631 Thu, 10 Jul 2003 23:29:30 +0000 Волновой алгоритм https://forum.sources.ru/index.php?showtopic=9240&view=findpost&p=90631 Shiru_Otaku Алгоритмы https://forum.sources.ru/index.php?showtopic=9240&view=findpost&p=90630 Thu, 10 Jul 2003 18:09:56 +0000 Волновой алгоритм https://forum.sources.ru/index.php?showtopic=9240&view=findpost&p=90630

Uses Crt; Const Wall = #254; Move = #250; Nk = 250; Var R: array [0..79, 0..49] of Byte; Ni: Byte; FX, FY: Byte; i, j: Word; Procedure Init; Begin For j := 0 to 49 do For i := 0 to 79 do If (i in [0, 79]) or (j in [0, 49]) then R[i, j] := 255 else Case Mem[$B800:j*160+i*2] of 32: R[i, j] := 254; Ord('X'): R[i, j] := 0; 1: R[i, j] := 253; else R[i, j] := 255 End; Ni := 0 End; Procedure Clear; Begin For j := 1 to 48 do For i := 1 to 78 do Case Mem[$B800:j*160+i*2] of Ord(Move): Begin GotoXY(i, j); Write(' '#8) End; 2: Begin GotoXY(i, j); Write(#1#8) End End End; Procedure Start; Var Ok: Boolean; X, Y, N, X1, Y1: Byte; Procedure Check(X, Y: Byte); Begin Case R[X, Y] of 253: Ok := True; 254: R[X, Y] := Ni+1 End End; Procedure Find(X, Y: Byte); Begin If R[X, Y] < N then Begin N := R[X, Y]; X1 := X; Y1 := Y End End; Begin Init; Ok := False; Repeat For j := 1 to 48 do For i := 1 to 78 do Begin If Ok then Break; If R[i, j] = Ni then Begin Check(i, j-1); Check(i+1, j); Check(i, j+1); Check(i-1, j) End End; Inc(Ni) Until Ok or (Ni > Nk); If Ok then Begin X := FX; Y := FY; TextAttr := ; Repeat N := 255; Find(X, Y-1); Find(X+1, Y); Find(X, Y+1); Find(X-1, Y); If R[X1, Y1] = 0 then Break; GotoXY(X1, Y1); Write(Move); X := X1; Y := Y1 Until False End else Begin TextAttr := E; GotoXY(FX, FY); Write(#2) End; TextAttr := F; Window(1, 1, 80, 50); GotoXY(3, 1); Write('Итераций - ', Ni, '/250 '#8#8); If ReadKey = #0 then ReadKey; TextAttr := F; Window(2, 2, 80, 49); Clear; GotoXY(FX, FY) End; Begin TextMode(Co80+Font8x8); TextAttr := E; ClrScr; GotoXY(3, 50); Write(#27#26#24#25' - Move; Space,Del,PgDn,Home,End,Tab - Wall; Insert - Man; PgUp - Target'); GotoXY(54, 1); Write('ENTER - Start; ESC - Exit'); Window(2, 2, 79, 49); TextAttr := F; ClrScr; Window(2, 2, 80, 49); Repeat Case ReadKey of #00: Case ReadKey of #72: If WhereY > 1 then GotoXY(WhereX, WhereY-1); #75: If WhereX > 1 then GotoXY(WhereX-1, WhereY); #77: If WhereX < 78 then GotoXY(WhereX+1, WhereY); #80: If WhereY < 48 then GotoXY(WhereX, WhereY+1); #71: {Home} Begin If WhereY > 1 then GotoXY(WhereX, WhereY-1); If Mem[$B800:WhereY*160+WhereX*2] = 32 then Write(Wall+#8) else Write(' '#8); If (FX = WhereX) and (FY = WhereY) then FX := 0 End; #83: {Del} Begin If WhereX > 1 then GotoXY(WhereX-1, WhereY); If Mem[$B800:WhereY*160+WhereX*2] = 32 then Write(Wall+#8) else Write(' '#8); If (FX = WhereX) and (FY = WhereY) then FX := 0 End; #81: {PgDn} Begin If WhereX < 78 then GotoXY(WhereX+1, WhereY); If Mem[$B800:WhereY*160+WhereX*2] = 32 then Write(Wall+#8) else Write(' '#8); If (FX = WhereX) and (FY = WhereY) then FX := 0 End; #79: {End} Begin If WhereY < 48 then GotoXY(WhereX, WhereY+1); If Mem[$B800:WhereY*160+WhereX*2] = 32 then Write(Wall+#8) else Write(' '#8); If (FX = WhereX) and (FY = WhereY) then FX := 0 End; #59: {F1 - Clr} Begin For j := 1 to 48 do For i := 1 to 78 do Begin GotoXY(i, j); Write(' '#8) End; FX := 0 End; #60: {F2 - Fill} Begin For j := 1 to 48 do For i := 1 to 78 do Begin GotoXY(i, j); Write(Wall+#8) End; FX := 0 End; #73: {PgUp} Write('X'#8); #82: {Ins} Begin i:= WhereX; j := WhereY; GotoXY(FX, FY); Write(' '); GotoXY(i, j); Write(#1#8); FX := i; FY := j End End; #09: {Tab} For Ni := 1 to 100 do Begin i := Random(78)+1; j := Random(48)+1; If Mem[$B800:j*160+i*2] <> 1 then Begin GotoXY(i, j); Write(Wall+#8) End End; #32: {Space} Begin If Mem[$B800:WhereY*160+WhereX*2] = 32 then Write(Wall+#8) else Write(' '#8); If (FX = WhereX) and (FY = WhereY) then FX := 0 End; #13: {Enter} If FX <> 0 then Start; #27: {Esc} Break End Until False; TextMode(Co80); TextAttr := 7; ClrScr End.

]]> Jin X Алгоритмы https://forum.sources.ru/index.php?showtopic=9240&view=findpost&p=90629 Thu, 10 Jul 2003 14:48:34 +0000 Волновой алгоритм https://forum.sources.ru/index.php?showtopic=9240&view=findpost&p=90629 Я конечно пыталась придумать что-то, но никакого обьективного алгоритма не получилось.

P.S. Путь, конечно, должен быть наиболее краток.]]> J_S Алгоритмы