From 9064a9de55326a9c4a224758d0f689c8cb98d4a4 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Fri, 15 May 2026 10:34:47 +0200 Subject: [PATCH] =?UTF-8?q?=D0=97=D0=B0=D0=BA=D0=BE=D0=BD=D1=87=D0=B8?= =?UTF-8?q?=D0=BB=20=D1=81=D0=BE=D0=BA=D0=BE=D0=B1=D0=B0=D0=BD=20=D0=B8?= =?UTF-8?q?=D0=B7=207-=D0=B9=20=D0=B3=D0=BB=D0=B0=D0=B2=D1=8B,=20=D1=87?= =?UTF-8?q?=D0=B5=D1=82=D0=B2=D0=B5=D1=80=D1=82=D0=BE=D0=B3=D0=BE=20=D1=83?= =?UTF-8?q?=D0=BF=D1=80=D0=B0=D0=B6=D0=BD=D0=B5=D0=BD=D0=B8=D1=8F?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../7/4_solver/assets/1.slv | 6 + .../7/4_solver/assets/2.slv | 9 + .../7/4_solver/assets/graphics.png | Bin 0 -> 1337 bytes .../7/4_solver/assets/numbers.png | Bin 0 -> 2057 bytes .../7/4_solver/problems.pas | 218 ++++++++++++++ .../7/4_solver/solver.lpi | 93 ++++++ .../7/4_solver/solver.lpr | 28 ++ .../7/4_solver/solver.lps | 241 +++++++++++++++ .../7/4_solver/states.pas | 277 ++++++++++++++++++ .../7/4_solver/unit1.lfm | 185 ++++++++++++ .../7/4_solver/unit1.pas | 177 +++++++++++ Занимательное программирование/README.txt | 4 +- 12 files changed, 1236 insertions(+), 2 deletions(-) create mode 100644 Занимательное программирование/7/4_solver/assets/1.slv create mode 100644 Занимательное программирование/7/4_solver/assets/2.slv create mode 100644 Занимательное программирование/7/4_solver/assets/graphics.png create mode 100644 Занимательное программирование/7/4_solver/assets/numbers.png create mode 100644 Занимательное программирование/7/4_solver/problems.pas create mode 100644 Занимательное программирование/7/4_solver/solver.lpi create mode 100644 Занимательное программирование/7/4_solver/solver.lpr create mode 100644 Занимательное программирование/7/4_solver/solver.lps create mode 100644 Занимательное программирование/7/4_solver/states.pas create mode 100644 Занимательное программирование/7/4_solver/unit1.lfm create mode 100644 Занимательное программирование/7/4_solver/unit1.pas diff --git a/Занимательное программирование/7/4_solver/assets/1.slv b/Занимательное программирование/7/4_solver/assets/1.slv new file mode 100644 index 0000000..9ef8749 --- /dev/null +++ b/Занимательное программирование/7/4_solver/assets/1.slv @@ -0,0 +1,6 @@ +xxxxxxxxxxx +x x +x b x +x p sbxx x +x x px +xxxxxxxxxxx diff --git a/Занимательное программирование/7/4_solver/assets/2.slv b/Занимательное программирование/7/4_solver/assets/2.slv new file mode 100644 index 0000000..3caee9e --- /dev/null +++ b/Занимательное программирование/7/4_solver/assets/2.slv @@ -0,0 +1,9 @@ +xxxxxxxxx +x x x +xx x xx +x x +x p x x +x x x +x b x x +x s x +xxxxxxxxx diff --git a/Занимательное программирование/7/4_solver/assets/graphics.png b/Занимательное программирование/7/4_solver/assets/graphics.png new file mode 100644 index 0000000000000000000000000000000000000000..39b8af109ace7b2ff5d63f538eab91e0b98d48a5 GIT binary patch literal 1337 zcmV-91;+Y`P)z@;j|==^1poj5AY({UO#lFTCIA3{ga82g0001h=l}q9FaQARU;qF* zm;eA5aGbhPJOBUyFi=cXMF0Q*fB*mhfB=Ai0001hfB=91fPlcjz<_{&{{R30{{a90 z00030{{a60|NsC0|4$PpNdN!<32;bRa{vGf6951U69E94oEQKA00(qQO+^Rl0~Znq zCxaBv&j0`fQ%OWYRA}Din%i>gAPhyV;laxI!TRQ6jy>7!o9Nal03_)IgsjtcWcIvpgg%e#d2|qZV@7ekR!-N z5%swN>L?50Muiigc;R_QLJ5rtv8U|zj^cc@W6#@(jVc4|z-qv8*qg@Tk2Sz<)szfHwQh2?+pk zA=~{95U=sriM3fi@+5>K{dq5l;{0hv+4A# zl$QDAF$Cv2KjnN15P!bMfcyY%sjmR_LW}{a2c=0lJd8pC`Tl51m#+fkr{@WwD31#< zWQ`$Y%>mGa7-8=3*G&G3#fZ_j9KxKadWJG#@E7D*lCevgO;^hk~CrTkiDPnT~t3eTv<~bIS zZu;{);qV%yLSs^`(*Y{_*}1a&H4~t7CJ(v;)) zZdlpg8o(ur-BoIo2KZ&(bI@hJ}#+t;QyL19dutb}L^FfcTXM4FSE{YMh)1(eu*~yW6a?2bJj} zFH+Fitg?NO=ZrS9Z+G*n>OuW-$EHDL_wgD*dDSn=9c(w{49RnBCjCuK`URj>^`N_g z8RlA|C=r-yhuYl$<=e*)(mbb?!FCF2ZwqGY?u*@&T&2(|RWm<-uAzaWlkG-hL`dy! zeo&HqS#n*o)fg4+H%^>6TPzEzVwbAD+N}ulLenaDbc*_K0r~n*yq^*Cp?n_pZCOK* z3=vx4JFs_e>-;nzSMH$wd^q>nde9R<-`Ynt>AwPq?+gNT#D8SJyR|%g@5i^E%lgm5 vlIx@w!Hj+Q&k2KnZg|($iu50Bqk7OkWulq(vX0%g00000NkvXXu0mjfufbGT literal 0 HcmV?d00001 diff --git a/Занимательное программирование/7/4_solver/assets/numbers.png b/Занимательное программирование/7/4_solver/assets/numbers.png new file mode 100644 index 0000000000000000000000000000000000000000..e0897473c4157d6d38ad3979ade38b4d88ca0d21 GIT binary patch literal 2057 zcmZ{lc|6mPAICqlnXAoxhoq6*IYNgsNABUvTqA2C*S?On37cGVmM&|qrrcK-a%4s5 z`yDCeNZI(Rd{J%|(|-E@_x9d3#IrFSbyipY(-I{~1&85Vz8R|H#4RQ_knnDR099=x<5$wigZ` zuc1hu?+-IN)(&Z7I>fT*trgi}T8$D?vG+dv*~(a9Tf|e=1z0Y_U0vH9{$}5{f|G@w z#V-E&-2CrG|LVG7!#LA}@T}gM*#9FQCL{xfxygBVyXkujFSb?%j3ZvGmQ2L5Erg4q zPwIFUd@XjEF5JwG4%J02VBm0oQFe2DCY`+RO>){jsnr=DQ3_N7q zkY0>2(N~zi6|$5C=0To+*lmMwWMhMy_*p*b2G9$$XHFa^{%yRHd-(LULpX$l6CZD5 zXtPJ>r;{vMdHvO*D}=uCcK}Rmz`UY%xZG1>n^3edQL&mL!f`X=`K!;Cesb-h(M4bA zQsRrnHoL`(`JC^F^WkMD%x5Oh3Y)7=Y~u=qpRAgv9%ql_Mnccw8ip>ANSWEo%M6+8 zk&qUeS0|HJ z%x7h%_rJ>NvU~HwD2rh7T$}o=%E4r=y-x$LK0ejB#q%$#GPpLs-8{<-HZn9ztk2}C zzh*i2@hU#{G?zAyE;)<*!mOT#ox1)4P&!=jwJ2ysj6fTBKcT=9EeTAEo&vEzTI638 z)BgHpy|HU(-Je+$&T?cHkMNo|MomnLM;2lY6_u>RG(%v|F<6V@$u5PpXB}{dKHfFz zkjZ0|@tlslEO!fQGReG6n?zs}?V%r|5&}_0;P@7*aq*;pYI^^<5W$d4>d;ZgHh*TM zhM}UQHAh$6eg>yquZnKE)Mm>~9ZMj>egRd$*b_$#ELGEm5H2klV%WQrO!LBx z(Wl1Zsg+dYF~S@^@Eb<1pc4~jpCRT)KIrM*3Nk-8?$am&nqVAq#|$bzgZ9+RRrEL%@|z)N7}3%wh8ua&vx@xcB;Z?Bv7ShU zjciIM2h}(;XXmGP8734CT58~ke78(@c0R+cNQWLlxlnE`7Fry zH}1PCpwD%Kg*Ul(yn=kC_3+(~UixF$igi(A3hb5r|79m^@>GNp*Q)96+rR} z1X$`uDIN-597L20EJYw}!h^k}+PN|NBG~(W6O)w;~(ihBd($um@ z&4|{D_)yF3PaJq>b}9hL>yh9MLZVnrts3KmD#R^N!%OeTpRR*Ot+`YGSQH0F-0&Wu%Nk<>e7;5yG*kdM8C&Z4e~`TbaAW=X@A(C z`NT{#dE6EidUvA~5;`)(+@VdriwJFs8noPtb4&}z`;1#9e66Vg`QOE#UW&x-Qc*N& zcUkyP*|M1K@5)Meb?KaTOsMPC7L#>Ui#^>4vt3fD=siJjuS4x z*CyrRTs^YS)+;KYp)JIFuKMf%h^Vf-OqZIynim%UnTd(MC<0v>fN--GPJL=W_DF}U z*O$D84JS#3>%m`aK4fMOcQ)|bd6#6!*F7;}h#=-~_X5)PA%A#98%Xo~wl1ApJy~mm z6MKpZa=`Vdn%_LB*^76R8n2Z9#^J*?f#8i2w~rQBcNN9vKDDAY-IxuexDJ4s&Sn72 z+m#oc&G%w;FB8Jm%U#@smz?`$lN04DC1{IkHuK}WGQCok)|o3;G3`K zwk=V1yKfUJwG`t8itxw5^)DD;?hkmaelEimfLAQz6`nivTGTop%#nQ1z~7;Bck%1I zhDVNHJ4jO?I94OA;;Q7ziG=H{P%}?74N(X3Yb?)bzt=#*H)$8=tsG@b6X;P4(Q{C4 zp--`UmhuiFbNdzrRoR0sRa4Sc%GoKWAefsD?8&gbMkH_G;xP-k2h8#99l nil then + begin + SetLength(Result, Length(Result) + 1); + Result[High(Result)] := NewState + end + end + end +end; + +function CanPush(Element, Delta: TPosition; Walls, Boulders: TPositions): Boolean; +var + NewPosition: TPosition; +begin + NewPosition.X := Element.X + Delta.X; + NewPosition.Y := Element.Y + Delta.Y; + Result := IsFree(NewPosition, Walls) and IsFree(NewPosition, Boulders) +end; + +function IsGoal(ANode: TNode): Boolean; +var + CurrentPlace: TPosition; +begin + Result := true; + + for CurrentPlace in ANode.State.Places do + begin + Result := AtSomePosition(CurrentPlace, ANode.State.Boulders); + if not Result then + Exit + end +end; + +function Search(InitialState: TState): TStates; +var + Frontier: TPriorityQueue; + Heuristics, i: Integer; + NextState, CurrentState: TState; + NextNode, CurrentNode: TNode; + Neighbours: TStates; + Visited: TStates; +begin + Visited := TStates.Create; + Result := TStates.Create; + + Frontier := TPriorityQueue.Create; + try + Heuristics := CalculateHeuristic(initialState); + { Создаем начало графа. } + NextState := TState.Create(InitialState); + NextNode := TNode.Create(NextState, nil, 0, Heuristics); + Frontier.Add(NextNode); + + while not Frontier.IsEmpty do + begin + Heuristics := Frontier.Count; + CurrentNode := Frontier.Poll; + + SetLength(Visited, Length(Visited) + 1); + Visited[High(Visited)] := CurrentNode.State; + + if IsGoal(CurrentNode) then + begin + Result := ReconstructPath(CurrentNode); + Exit + end; + Neighbours := GetNeighbours(CurrentNode.State); + + for i := 0 to High(Neighbours) do + begin + NextState := Neighbours[i]; + for CurrentState in Visited do + if CurrentState.Compare(NextState) then + begin + FreeAndNil(NextState); + break + end; + + if NextState <> nil then + begin + Heuristics := CalculateHeuristic(NextState); + NextNode := TNode.Create(NextState, CurrentNode, CurrentNode.Cost + 1, Heuristics); + Frontier.Add(NextNode) + end + end + end + finally + FreeAndNil(Frontier) + end; +end; + +function AtSomePosition(Needle: TPosition; Heap: TPositions): Boolean; +var + CurrentPosition: TPosition; +begin + Result := false; + for CurrentPosition in Heap do + if CurrentPosition = Needle then + begin + Result := true; + Exit + end +end; + +function ManhattanDistance(A, B: TPosition): Integer; +begin + Result := Abs(A.X - B.X) + Abs(A.Y - B.Y) +end; + +function CalculateHeuristic(AState: TState): Integer; +var + CurrentPlace, CurrentBoulder: TPosition; + Distance, MinimalDistance: Integer; +begin + Result := 0; + for CurrentBoulder in AState.Boulders do + begin + MinimalDistance := Integer.MaxValue; + for CurrentPlace in AState.Places do + begin + Distance := ManhattanDistance(CurrentBoulder, CurrentPlace); + if (not AtSomePosition(CurrentPlace, AState.Boulders)) and (Distance < MinimalDistance) then + MinimalDistance := Distance + end; + Inc(Result, MinimalDistance) + end +end; + +function ReconstructPath(CameFrom: TNode): TStates; +var + Temporary: TState; + CurrentLength, CurrentSegment: Integer; +begin + Result := TStates.Create; + CurrentLength := 0; + + while CameFrom <> nil do + begin + SetLength(Result, CurrentLength + 1); + Result[CurrentLength] := TState.Create(CameFrom.State); + CameFrom := CameFrom.Node; + Inc(CurrentLength) + end; + Dec(CurrentLength); + CurrentSegment := 0; + + while CurrentSegment < CurrentLength do + begin + Temporary := Result[CurrentSegment]; + Result[CurrentSegment] := Result[CurrentLength]; + Result[CurrentLength] := Temporary; + Dec(CurrentLength); + Inc(CurrentSegment) + end +end; + +end. + diff --git a/Занимательное программирование/7/4_solver/solver.lpi b/Занимательное программирование/7/4_solver/solver.lpi new file mode 100644 index 0000000..225be54 --- /dev/null +++ b/Занимательное программирование/7/4_solver/solver.lpi @@ -0,0 +1,93 @@ + + + + + + + + <Scaled Value="True"/> + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <XPManifest> + <DpiAware Value="True"/> + </XPManifest> + <Icon Value="0"/> + </General> + <BuildModes> + <Item Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <UseFileFilters Value="True"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + </RunParams> + <RequiredPackages> + <Item> + <PackageName Value="LCL"/> + </Item> + </RequiredPackages> + <Units> + <Unit> + <Filename Value="solver.lpr"/> + <IsPartOfProject Value="True"/> + </Unit> + <Unit> + <Filename Value="unit1.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="Unit1"/> + </Unit> + <Unit> + <Filename Value="state.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="State"/> + </Unit> + <Unit> + <Filename Value="assets/problems.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="Problems"/> + </Unit> + <Unit> + <Filename Value="assets/4.slv"/> + <IsPartOfProject Value="True"/> + </Unit> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <Target> + <Filename Value="solver"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Debugging> + <DebugInfoType Value="dsDwarf3"/> + </Debugging> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions> + <Item> + <Name Value="EAbort"/> + </Item> + <Item> + <Name Value="ECodetoolError"/> + </Item> + <Item> + <Name Value="EFOpenError"/> + </Item> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/Занимательное программирование/7/4_solver/solver.lpr b/Занимательное программирование/7/4_solver/solver.lpr new file mode 100644 index 0000000..d5fc39e --- /dev/null +++ b/Занимательное программирование/7/4_solver/solver.lpr @@ -0,0 +1,28 @@ +program solver; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX} + cthreads, + {$ENDIF} + {$IFDEF HASAMIGA} + athreads, + {$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, Unit1, States, Problems + { you can add units after this }; + +{$R *.res} + +begin + RequireDerivedFormResource:=True; + Application.Scaled:=True; + {$PUSH}{$WARN 5044 OFF} + Application.MainFormOnTaskbar:=True; + {$POP} + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/Занимательное программирование/7/4_solver/solver.lps b/Занимательное программирование/7/4_solver/solver.lps new file mode 100644 index 0000000..043698c --- /dev/null +++ b/Занимательное программирование/7/4_solver/solver.lps @@ -0,0 +1,241 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectSession> + <Version Value="12"/> + <BuildModes Active="Default"/> + <Units> + <Unit> + <Filename Value="solver.lpr"/> + <IsPartOfProject Value="True"/> + <EditorIndex Value="-1"/> + <CursorPos Y="27"/> + <UsageCount Value="80"/> + </Unit> + <Unit> + <Filename Value="unit1.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="Unit1"/> + <TopLine Value="60"/> + <CursorPos Y="73"/> + <UsageCount Value="80"/> + <Loaded Value="True"/> + <LoadedDesigner Value="True"/> + </Unit> + <Unit> + <Filename Value="state.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="State"/> + <EditorIndex Value="-1"/> + <CursorPos X="8"/> + <UsageCount Value="76"/> + </Unit> + <Unit> + <Filename Value="assets/problems.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="Problems"/> + <EditorIndex Value="-1"/> + <CursorPos X="14"/> + <UsageCount Value="51"/> + </Unit> + <Unit> + <Filename Value="assets/1.slv"/> + <EditorIndex Value="3"/> + <CursorPos X="8" Y="6"/> + <UsageCount Value="31"/> + <Loaded Value="True"/> + <DefaultSyntaxHighlighter Value="None"/> + </Unit> + <Unit> + <Filename Value="states.pas"/> + <UnitName Value="States"/> + <EditorIndex Value="4"/> + <TopLine Value="219"/> + <CursorPos X="13" Y="168"/> + <UsageCount Value="38"/> + <Loaded Value="True"/> + </Unit> + <Unit> + <Filename Value="unit1.lfm"/> + <EditorIndex Value="-1"/> + <UsageCount Value="5"/> + <DefaultSyntaxHighlighter Value="LFM"/> + </Unit> + <Unit> + <Filename Value="assets/2.slv"/> + <EditorIndex Value="-1"/> + <CursorPos X="14" Y="9"/> + <UsageCount Value="20"/> + <DefaultSyntaxHighlighter Value="None"/> + </Unit> + <Unit> + <Filename Value="assets/3.slv"/> + <EditorIndex Value="-1"/> + <UsageCount Value="21"/> + <DefaultSyntaxHighlighter Value="None"/> + </Unit> + <Unit> + <Filename Value="../../../../opt/lazarus/fpc/3.2.2/source/rtl/objpas/fgl.pp"/> + <EditorIndex Value="1"/> + <TopLine Value="891"/> + <CursorPos X="5" Y="905"/> + <UsageCount Value="20"/> + <Loaded Value="True"/> + </Unit> + <Unit> + <Filename Value="problems.pas"/> + <UnitName Value="Problems"/> + <EditorIndex Value="2"/> + <TopLine Value="118"/> + <CursorPos X="63" Y="129"/> + <UsageCount Value="25"/> + <Loaded Value="True"/> + </Unit> + <Unit> + <Filename Value="assets/4.slv"/> + <IsPartOfProject Value="True"/> + <IsVisibleTab Value="True"/> + <EditorIndex Value="5"/> + <CursorPos Y="3"/> + <UsageCount Value="36"/> + <Loaded Value="True"/> + <DefaultSyntaxHighlighter Value="None"/> + </Unit> + </Units> + <JumpHistory HistoryIndex="29"> + <Position> + <Filename Value="problems.pas"/> + <Caret Line="138" TopLine="116"/> + </Position> + <Position> + <Filename Value="problems.pas"/> + <Caret Line="130" Column="30" TopLine="116"/> + </Position> + <Position> + <Filename Value="states.pas"/> + <Caret Line="163" Column="11" TopLine="156"/> + </Position> + <Position> + <Filename Value="states.pas"/> + <Caret Line="191" Column="14" TopLine="170"/> + </Position> + <Position> + <Filename Value="states.pas"/> + <Caret Line="196" Column="16" TopLine="175"/> + </Position> + <Position> + <Filename Value="states.pas"/> + <Caret Line="44" Column="18" TopLine="29"/> + </Position> + <Position> + <Filename Value="states.pas"/> + <Caret Line="48" Column="25" TopLine="29"/> + </Position> + <Position> + <Filename Value="states.pas"/> + <Caret Line="52" Column="11" TopLine="29"/> + </Position> + <Position> + <Filename Value="states.pas"/> + <Caret Line="70" Column="11" TopLine="46"/> + </Position> + <Position> + <Filename Value="states.pas"/> + <Caret Line="194" Column="7" TopLine="170"/> + </Position> + <Position> + <Filename Value="states.pas"/> + <Caret Line="210" Column="3" TopLine="184"/> + </Position> + <Position> + <Filename Value="states.pas"/> + <Caret Line="201" Column="25" TopLine="188"/> + </Position> + <Position> + <Filename Value="states.pas"/> + <Caret Line="37" Column="22" TopLine="23"/> + </Position> + <Position> + <Filename Value="problems.pas"/> + <Caret Line="114" Column="11" TopLine="107"/> + </Position> + <Position> + <Filename Value="assets/1.slv"/> + <Caret Line="3" Column="12"/> + </Position> + <Position> + <Filename Value="problems.pas"/> + <Caret Line="42" Column="17" TopLine="35"/> + </Position> + <Position> + <Filename Value="problems.pas"/> + <Caret Line="55" Column="24" TopLine="35"/> + </Position> + <Position> + <Filename Value="problems.pas"/> + <Caret Line="68" Column="17" TopLine="59"/> + </Position> + <Position> + <Filename Value="problems.pas"/> + <Caret Line="13" Column="17"/> + </Position> + <Position> + <Filename Value="problems.pas"/> + <Caret Line="53" Column="76" TopLine="40"/> + </Position> + <Position> + <Filename Value="problems.pas"/> + <Caret Line="14" Column="20"/> + </Position> + <Position> + <Filename Value="problems.pas"/> + <Caret Line="90" Column="42" TopLine="74"/> + </Position> + <Position> + <Filename Value="problems.pas"/> + <Caret Line="13" Column="17"/> + </Position> + <Position> + <Filename Value="problems.pas"/> + <Caret Line="53" Column="21" TopLine="30"/> + </Position> + <Position> + <Filename Value="problems.pas"/> + <Caret Line="13" Column="45"/> + </Position> + <Position> + <Filename Value="problems.pas"/> + <Caret Line="56" Column="35" TopLine="29"/> + </Position> + <Position> + <Filename Value="assets/1.slv"/> + <Caret Line="10" Column="17"/> + </Position> + <Position> + <Filename Value="problems.pas"/> + <Caret Line="120" TopLine="118"/> + </Position> + <Position> + <Filename Value="assets/1.slv"/> + <Caret Line="9" Column="9"/> + </Position> + <Position> + <Filename Value="assets/1.slv"/> + <Caret Column="9"/> + </Position> + </JumpHistory> + <RunParams> + <FormatVersion Value="2"/> + <Modes ActiveMode=""/> + </RunParams> + <HistoryLists> + <List Name="WorkingDirectory" Type="File" Count="1"/> + <List Name="LaunchingApplication" Type="File" Count="1"> + <Item1 Value="C:\WINDOWS\system32\cmd.exe /C ${TargetCmdLine}"/> + </List> + <List Name="CommandLineParameters" Count="1"/> + </HistoryLists> + </ProjectSession> +</CONFIG> diff --git a/Занимательное программирование/7/4_solver/states.pas b/Занимательное программирование/7/4_solver/states.pas new file mode 100644 index 0000000..3dbcc00 --- /dev/null +++ b/Занимательное программирование/7/4_solver/states.pas @@ -0,0 +1,277 @@ +unit States; + +{$mode ObjFPC}{$H+} + +interface + +uses + Classes, SysUtils, fgl; + +type + TPosition = record + X, Y: Integer + end; + TPositions = array of TPosition; + + TState = class + private + PAgent: TPosition; + PWalls, PPlaces, PBoulders: TPositions; + + procedure CopyArrays(AState: TState); + + public + constructor Create; + constructor Create(ASTate: TState; AAgent: TPosition); + constructor Create(ASTate: TState); + + property Walls: TPositions read PWalls; + property Places: TPositions read PPlaces; + property Boulders: TPositions read PBoulders; + property Agent: TPosition read PAgent write PAgent; + + procedure AddWall(AX, AY: Integer); + procedure AddPlace(AX, AY: Integer); + procedure AddBoulder(AX, AY: Integer); + procedure SetAgent(AX, AY: Integer); + function Compare(AState: TState): Boolean; + end; + TStates = array of TState; + + TBoard = class + private + PWidth, PHeight: Integer; + PInitialState: TState; + + public + property Width: Integer read PWidth; + property Height: Integer read PHeight; + property InitialState: TState read PInitialState; + + constructor Create(AWidth, AHeight: Integer; AInitialState: TState); + destructor Destroy; override; + end; + + INode = interface + function GetTotalCost: Integer; + end; + + TNode = class(TInterfacedObject, INode) + private + PState: TState; + PNode: TNode; + PCost, Heuristic: Integer; + public + property State: TState read PState; + property Node: TNode read PNode; + property Cost: Integer read PCost; + + constructor Create(AState: TState; ANode: TNode; ACost, AHeuristic: Integer); + destructor Destroy; + + function GetTotalCost: Integer; + end; + TNodes = array of TNode; + + TNodeList = specialize TFPGList<TNode>; + TPriorityQueue = class + private + Nodes: TNodeList; + + public + constructor Create; + + procedure Add(ANode: TNode); + function Poll: TNode; + function IsEmpty: Boolean; + function Count: Integer; + end; + + operator = (P1, P2: TPosition) B: Boolean; + + function IsFree(NewPosition: TPosition; Walls: TPositions): Boolean; + +implementation + +procedure TSTate.CopyArrays(AState: TState); +begin + PWalls := Copy(AState.Walls, 0, Length(ASTate.Walls)); + PPlaces := Copy(AState.Places, 0, Length(ASTate.Places)) +end; + +constructor TState.Create; +begin +end; + +constructor TState.Create(ASTate: TState; AAgent: TPosition); +begin + PAgent := AAgent; + CopyArrays(AState); + PBoulders := TPositions.Create +end; + +constructor TState.Create(ASTate: TState); +begin + PAgent := AState.Agent; + CopyArrays(AState); + PBoulders := Copy(AState.Boulders, 0, Length(AState.Boulders)) +end; + +procedure TState.AddWall(AX, AY: Integer); +var + CurrentLength: Integer; +begin + CurrentLength := Length(PWalls); + SetLength(PWalls, CurrentLength + 1); + + PWalls[CurrentLength].X := AX; + PWalls[CurrentLength].Y := AY +end; + +procedure TState.AddPlace(AX, AY: Integer); +var + CurrentLength: Integer; +begin + CurrentLength := Length(PPlaces); + SetLength(PPlaces, CurrentLength + 1); + + PPlaces[CurrentLength].X := AX; + PPlaces[CurrentLength].Y := AY +end; + +procedure TState.AddBoulder(AX, AY: Integer); +var + CurrentLength: Integer; +begin + CurrentLength := Length(PBoulders); + SetLength(PBoulders, CurrentLength + 1); + + PBoulders[CurrentLength].X := AX; + PBoulders[CurrentLength].Y := AY +end; + +procedure TState.SetAgent(AX, AY: Integer); +begin + PAgent.X := AX; + PAgent.Y := AY +end; + +function TState.Compare(AState: TState): Boolean; +var + i: Integer; +begin + Result := (Agent = AState.Agent) + and (Length(Walls) = Length(AState.Walls)) + and (Length(Boulders) = Length(AState.Boulders)) + and (Length(Places) = Length(AState.Places)); + if not Result then + Exit; + for i := 0 to High(Walls) do + if Walls[i] <> AState.Walls[i] then + begin + Result := false; + Exit + end; + for i := 0 to High(Boulders) do + if Boulders[i] <> AState.Boulders[i] then + begin + Result := false; + Exit + end; + for i := 0 to High(Places) do + if Places[i] <> AState.Places[i] then + begin + Result := false; + Exit + end +end; + +constructor TBoard.Create(AWidth, AHeight: Integer; AInitialState: TState); +begin + PWidth := AWidth; + PHeight := AHeight; + PInitialState := AInitialState +end; + +destructor TBoard.Destroy; +begin + PInitialState.Destroy; + inherited +end; + +constructor TNode.Create(AState: TState; ANode: TNode; ACost, AHeuristic: Integer); +begin + PState := AState; + PNode := ANode; + PCost := ACost; + Heuristic := AHeuristic +end; + +destructor TNode.Destroy; +begin + PState.Free; + inherited +end; + +function TNode.GetTotalCost: Integer; +begin + Result := Cost + Heuristic +end; + +constructor TPriorityQueue.Create; +begin + Nodes := TNodeList.Create +end; + +procedure TPriorityQueue.Add(ANode: TNode); +var + Index, TotalCost: Integer; + CurrentNode: TNode; +begin + Index := 0; + TotalCost := ANode.GetTotalCost; + + for CurrentNode in Nodes do + begin + if CurrentNode.getTotalCost >= TotalCost then + break; + Inc(Index) + end; + Nodes.Insert(Index, ANode) +end; + +function TPriorityQueue.Poll: TNode; +begin + Result := Nodes.Extract(Nodes.First) +end; + +function TPriorityQueue.IsEmpty: Boolean; +begin + Result := Count = 0 +end; + +function TPriorityQueue.Count: Integer; +begin + Result := Nodes.Count +end; + +operator = (P1, P2: TPosition) B: Boolean; +begin + B := (P1.X = P2.X) and (P1.Y = P2.Y) +end; + +function IsFree(NewPosition: TPosition; Walls: TPositions): Boolean; +var + Wall: TPosition; +begin + for Wall in Walls do + if NewPosition = Wall then + begin + Result := false; + Exit + end; + Result := true +end; + +end. + diff --git a/Занимательное программирование/7/4_solver/unit1.lfm b/Занимательное программирование/7/4_solver/unit1.lfm new file mode 100644 index 0000000..2bc893a --- /dev/null +++ b/Занимательное программирование/7/4_solver/unit1.lfm @@ -0,0 +1,185 @@ +object Form1: TForm1 + Left = 284 + Height = 771 + Top = 158 + Width = 695 + Caption = 'Form1' + ClientHeight = 771 + ClientWidth = 695 + DesignTimePPI = 120 + LCLVersion = '4.6.0.0' + OnCreate = FormCreate + OnDestroy = FormDestroy + object OpenLevel: TButton + AnchorSideLeft.Control = Owner + AnchorSideLeft.Side = asrCenter + AnchorSideTop.Control = Owner + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrCenter + Left = 259 + Height = 40 + Top = 25 + Width = 176 + BorderSpacing.Top = 25 + Caption = 'Открыть уровень' + TabOrder = 0 + OnClick = OpenLevelClick + end + object BackBuffer: TImage + AnchorSideLeft.Control = Screen + AnchorSideTop.Control = Screen + AnchorSideRight.Control = Screen + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Screen + AnchorSideBottom.Side = asrBottom + Left = 25 + Height = 384 + Top = 90 + Width = 640 + Anchors = [akTop, akLeft, akRight, akBottom] + Visible = False + end + object Screen: TImage + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = OpenLevel + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Owner + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 25 + Height = 384 + Top = 90 + Width = 640 + BorderSpacing.Left = 25 + BorderSpacing.Top = 25 + end + object MoveList: TListBox + AnchorSideLeft.Control = Owner + AnchorSideTop.Control = Screen + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Screen + AnchorSideRight.Side = asrBottom + AnchorSideBottom.Control = Owner + AnchorSideBottom.Side = asrBottom + Left = 25 + Height = 247 + Top = 499 + Width = 640 + Anchors = [akTop, akLeft, akRight, akBottom] + BorderSpacing.Left = 25 + BorderSpacing.Top = 25 + BorderSpacing.Bottom = 25 + ItemHeight = 0 + TabOrder = 1 + end + object OpenDialog: TOpenDialog + Left = 40 + Top = 8 + end + object ImageList: TImageList + Height = 32 + Width = 32 + Left = 552 + Top = 16 + Bitmap = { + 4C7A120000002000000020000000FD0B00000000000078DAED5D69AC5E4519BE + 585A0A29B2191590450A01B4D4564CD8A4501428A48845C2160C06221A8DA450 + 68841A7BCAF2035340220911454C6A950006642948C05E68590C150B365A4591 + 96BD589142955EB09F33F80C9D3B7766CECC39F3CE9CDEFB3EC99BF69EF9BE79 + E6CCFA3EB37D7D7D0C0683C16030180C0683C16030180C46D750F5EC968BB3E7 + 30AAB4F8387D69A1E176217D1AAA205E7F3A9AA6A19E3B24AC791A2A67FCAE32 + 777F2E1D7F5DBD4BC3DF8C3B5D1AC2F8EB9EA7E40F2F6BD7F7366FFED2F99FB7 + FE956E7FDDEA7FCAF4BFA5C79F2E8CBF5DF03FBAE07F75C1FF643018EFB7C0EA + FF6D4EFEEB320ACE4D710FFED70CDB149E96D78CDFF6DC96B6D2FC316918FA79 + 5F19D73F8B2D0BDF7B0DCE53775EB8F229A66E9B79D9678BBF26EF43CBC2FABE + 81E5EECB8B21EFD0E7E6AF4BBF2DFF7DE55DD747B8F2BBAE5C43CD5A86D636E9 + E70C7D3F57FEB8FEDF157E7778FBFCF7C563F62F7D55BB72AFAB9F43EB82D9DF + F9F330455EF8CA3F2ABEC0B4D9DAAFADFC43F22F24AF43FBA490F69FAADD87D6 + 7FBDDFADEBBF43CBDA9F67764D5315E00F2BAF747D43ECFBB7ED975C75BFCEEF + 886DD3E1F5B1DEF7F0F93F756D3374ECADD3D721EF1DDD7745EA0BDFFBFB7C9D + 363E709DD6F1F9A3A9F5500A7E4A0DE4F65BF2694F9E0B62FDCFFA3F9FFEF7E9 + 356AFD1F3E079D58FF379A836FAFFFDBAF41B4D3FF29D6609AEAFFB46B5071FA + 3FF51A5CACFE4FBD0619A3FFA9D66043F53FDD1A7498FEA75A830FD5FF747B00 + C2F43F55FEC7E87FAAFA17AAFFD3EF0188D3FFE9F700C4E9FFD4FD6F53FD9F66 + 0F4073FD9F62FC4DA3FFE3FD8F94FA3FD4FFCAA5FF437C50D6FFACFF198190FD + 570EDB8CE73CFAFBFB9DFAC915C6FCF1FD8BCD3FD1396CFEAB2D2C24EEC004F6 + A22CF1FBBF176768FB4AF8FEEF7F3EB28DC7F2C8B2334D7F1ECB6F8BC38CBB4B + FC75F9D286BF4DFE3BCBDFF4FB3CE5DF26FFAD6393CBF7748C3149F9EBF46F43 + FEE0B1D9A1877CFC6DCA7F107F9F5F0B0D4A0345FE7BB44769FE21F590A2FC1B + F253977F8AF74FC38FF084FC43FA3F6F1AAAC6FD5F70FFEFD4E0D520FE54FDBF + 75FC7169EF9CE3AF873BE5F83B68BF5584FFD5D4CFEA9AFFD7C80726F0FF53CE + 5D506AA4CD59DB763EFF4BD6BFD2FA8BB8FF89EF7FFDFE3F69FF1FE0FF93E9AF + 40FF9F4C7F05FAFF24FA6B18FBFFEC7F8F6CFF3F4E7FD7FBFF24E51FE1FF93CD + 7F04FAFF64FA2BD0FF27D35F99E7DF46FAFC67AEF9E7CEEBAFC2EB0FC5D75F78 + FDAD383FAF3F3372CE47E8FFBAC69398BF6DF16EF22D999FF90BF67B01FDBEB2 + 983D7441DFEB207FA5FB32A9FA7D976F047EEB19EBA0F124603DDAE31F2AFE21 + 3E721D7FE83ED040FEA8F7F7E870EB5ED8007E6BF93BB9ABC8FDD771FC5E9F3F + 622FAE756D3E097F83FDC0C9F3BF8A3B0B95BCFE451849FB6BC09DEAFD63E763 + 9AB6BF8CFD2F8F7FDDF13FD8FF1C41FCA5F51783B5FE48ABEB5A9B67FEB2FC5D + D2FCE4BE4697F989FCCDA0F2F76A8D487DEFD88B3368ED2384BFA9BE37F8AD6B + 6F75FC6DF47DDBF76FABEF2DFC51E5DF56DFFBB456307F0B7D9F8CBFA1BE6F9B + FF6DF57DB2F6D792BB4DFB6BA3EF9BBC7FE9FE97C7BF62FE07FB9FCCCF5ABF58 + 332C0EDBFEAC1093E51AF37D932FE4FBFAF8A9C613DBF72BE3734DD26FC6DFF4 + FD555A5C71E969EE0ABF397E85A423B6FCBBFAFD367718A7F87ED7DABEAB8D51 + 9591AFAE9975B4B2F9D32DBFEF6B7FB6F4BBF8F4EFBBDA78E8F773F25799F2BF + 8B7D44AE36DED5F6DFF5FE5BAF5B6DFD87D8F1BF6E0C6C3A7E878EFF39F9AB00 + 2ECABE9DC7FF6EB6FD2E8FFFA69F6B7B27D7F7FB1CE358E8F85B79BE5FD747A5 + 18FF53F2B76DA3A9FCAF9138FEF30C0883B159CEDB9D2FEC1D0C39FB65E4DD56 + D8ADC630BE5F26EE4F0A5B29EC5DBCFFDB99F96F17F69AB0A3F0776EFEB9C2F6 + D0FE7E3B77F91BE9617EE6677EE61FF6FC8263BCB065866D04FF0AE3F97802FE + 0911B27A027B480C0683C1600C2BDD3F49D80261CF0B1B10F686B0DF420F8F26 + E6FEB236E7F04F618F097B46F33B96081B4BE87F297FEF7BC2B6D2C28E12B61E + 611711F15F81F81F75845F8EF0A544FC5350C6473BC2BF04FEBF15AA97E752BE + 7F0DF716C21E01FFF905F86783FBCF54F5DFC37D1174C85A61FB67E41D25EC7A + BCF7CBC22666E4FEA0B0FB34EDB54746EEED843D09EE5FCBB464E4DE46ABE70B + A9FB7B0BFF4270CB79D05199B9A7817BB5B07105DAF8FDE05F63990730ED6304 + FCCB22F4FFDEEC2931180C068331ACF4FF11C27E099FFB1DE8FFC785CDA2D61E + 22FE399A8FF1127CD1BF6ACF7E27F70710711F069DF35F61E748CD6768E37548 + C33C22FE9F22FE1F39C2E721FC3122FEA9C2BEE65ADB11CFCFA6E40F48DFCDE0 + FF7E464EB91765B2B09F80FB2FC276CAC0BBA7E16FCB3670492E5D22787681EE + 7D0E7D806C17BF17764A81721F2DEC2C61AF222F2E2ED82F4AFC47D8F685D2F0 + 3AD2309560AE45CE2FDE28ECE39ECFA8F9D12309DE4DF5F3731CE1876BEDE1A3 + 04FC17206EF98EA719FDFF24B47D897B89CA7614C65D855731EFFEACB60FE059 + 0AED6FA4E314618BC02FDBFE9B1877BF9B732E8AC16030180C46D1F98029D0C4 + 122767E61E079FA75788FF06F0BE989B5F701D0FCE3B85DD96935FF0EC88F917 + B9E6BB73017EA5F54FC5DFD9F82527B87EA13DCBC28FBC5E8BFAB64301FE7BC0 + 33CD784ECE2FE2FE2A38AEB78491F24BCD0B9DF347B9065E807F56E4B1E69F25 + E63F01EFE8B217D4DC1FFE3E2F733F7C5B89FE9FF9BBC1CF6030180C06836C8C + 1F1BE87B7E8550FBF4B0E6E0DBFB389D887F7FF03F5728FF0F01FFF242FCC7A9 + EB850AF19F0EFE3B0AF17F03FC72EEE1DBB21C84FD1BE73EE4FF2F16B63521FF + 25463B93EB8D8BB106AF20F7856F47C4FF1D61AF609DFF1023EC686DFD7D41A1 + F23909FC722EF24305F84761ED5FE2984279F03CF86710C4FD01ECFB18ED08DF + 4A9B073E94807F35E23EC711AECEFFACD3CF6625E457E7AF5E37F75760EFC75A + 845F4A38FEF66B6D5D9E7BFB8DB03F69CFA40EDF92B88ECBBD0F0FA03CE4F9BF + 7FE01CCAA03D110C0683C1603086DD5CC00C610FE20CBE5C177B1A9A685C06EE + F9F0753662DFE1A39ADFBD845883A9B55FB9DE35497BBE0BD606256611716FA1 + ED819D6A093F02FBD04F27E23FA8F0FC833AE37E55217E75FE429E81F8845CFF + 871EDE20EF3C40BDDC91905F9D379F8F39875538072DE700DED234C18789F897 + 68FAFA4A5D67E03CC20A735F4462FE8710FF1FA416B5844F41F8BB14732022CE + BB10FF0F3DED53F5438711F05F8BB87FECF9CC2AAAF90711E799BEFB35A00D07 + F099C904FC3B68E70B265BC2BF88B037A9EE25D0C61E39DFB7ABF67CBCB60F6D + 3E611F3016ED5D9D33598C33702ADF97528E7F48C396B807E649F43BEBF1FF0B + 29E65D180C0683C16014D5FC4B4BDEFF23FDDE807B8FD4FAD3EE05F2E7544AFD + 13E01B4B2DFA2F8AB3AF01FCEA1EB69905B80F80E65B49B9F6E5E1BF17EF7E62 + 01EE83C1BDAC509F7027F8CF28C0BD27DAFB6B257487FC4923BCFB0F0AE5BD9A + 6F39B600F7AEE0DE5028EF555FFB54A1BCBF0CFC3F2FC4BF00FCD7166EF797B1 + 67C46030180CC6889807F89CDC836DDCFF27CF7DCE143686987B9EB6F6BF18F7 + 51DD8E34483C4175079188F733DAF983238DB09D70F7BAC49544FC7311FF7D8E + F06F22FC6962BDB3D011AEF6E7AF20E23F46FDBE80AD9E8967D720FC860C7EAF + AC7313B11E27F77E9C8735B89729E79E70D7DD6CCCF398B8917ADE0BBF73F10C + DADFC3D86F7217F644CB75C0ABA9EE65C71D6B03E0F9ACA5FDF553DEFFA8DDBD + 5639C2F741F800C51D90DA398F633D9F51FDE0E104FC6B10F7173C9F51F5F2F3 + 04FC6AFFC91535F92FB11B01BFBADF74BD79BE01BFC9B008E10F10D53FB9BFE4 + 266DFC53EDEF0ECC81F55047A8FB00B9F7EF6EEDFEBF7558FF9F4B75F688C160 + 30180C4671FD2FD71C6FC1FD6F03F0036E15F6E90CDC5FD7D6F857E3FCE32A4D + 97CF20E49EA0FDF6E04CE3FEE70BB4BDA71F21E2BFAE46FF2F223E7FFA84DAFF + EE089F4EB926A7FDCEE37447F8BE5A3D1843C0BFACE6FDF7D2F4C75E04FC6A8F + C53D8EF06F69FC9F22E03F50BB67FC5C236C1AB4E706841F483C07D6C3799B5F + E13C400F6BB2EA0CF6BE84FDC0C9D80BF516DEF921DC3D3006FB507A25EEFFC7 + 7CD47BBF8B52685C98ED9B1F4C10FFA1D80336C712B6B5B0BF83FF78C2FCDD88 + 3A7E9CF67C1B8C87120F13E7F1D55AFD5FAE9DC153BF01B27386723E0D757E0D + CE20ACC4DD08DBF631180C4604FE071237534E + } + end +end diff --git a/Занимательное программирование/7/4_solver/unit1.pas b/Занимательное программирование/7/4_solver/unit1.pas new file mode 100644 index 0000000..af58196 --- /dev/null +++ b/Занимательное программирование/7/4_solver/unit1.pas @@ -0,0 +1,177 @@ +unit Unit1; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, + States, Problems; + +const + CELL_SIZE = 32; + +type + + { TForm1 } + + TForm1 = class(TForm) + BackBuffer: TImage; + ImageList: TImageList; + MoveList: TListBox; + Screen: TImage; + OpenLevel: TButton; + OpenDialog: TOpenDialog; + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure OpenLevelClick(Sender: TObject); + private + + public + + end; + +var + Form1: TForm1; + Board: TBoard; { Игровое поле. } + +implementation + +{$R *.lfm} + +{ Загрузить уровень из файла. } +procedure LoadLevel(FileName: String); +var + f: File of Char; + i, j, ColumnCount, CurrentColumn: Integer; + c: Char; + InitialState: TState; +begin + AssignFile(f, FileName); { Открыть файл. } + Reset(f); + + FreeAndNil(Board); + InitialState := TState.Create; + + { Читаем первую строку, чтобы найти количество столбцов. } + ColumnCount := 0; + repeat + Read(f, c); + if c = 'x' then + InitialState.AddWall(ColumnCount, 0); + Inc(ColumnCount) + until c <> 'x'; + Dec(ColumnCount); + Read(f, c); { Считываем и пропускаем перевод строки. } + j := 1; + + repeat { Цикл по строкам. } + CurrentColumn := 0; + + for i := 0 to ColumnCount - 1 do { Цикл по элементам строки. } + begin + Read(f, c); { Считаем текущий эелемент } + + case c of + 'x': + begin + InitialState.AddWall(i, j); + Inc(CurrentColumn) + end; + 's': + InitialState.SetAgent(i, j); + 'p': { Если это "место". } + InitialState.AddPlace(i, j); + 'b': { Если это "камень". } + InitialState.AddBoulder(i, j) + end + end; + Inc(j); + Read(f, c); { считываем и пропускаем возврат каретки } + Read(f, c) { Считываем и пропускаем перевод строки. } + until CurrentColumn = ColumnCount; + + Board := TBoard.Create(ColumnCount, j, InitialState); + + CloseFile(f) { закрыть файл } +end; + +procedure DrawCell(APosition: TPosition; Bitmap: TBitmap); +begin + Form1.BackBuffer.Canvas.Draw(APosition.X * CELL_SIZE, + APosition.Y * CELL_SIZE, + Bitmap) +end; + +procedure RedrawField; +var + Bitmap: TBitmap; + ScreenRect: TRect; + CurrentPosition: TPosition; +begin + Bitmap := TBitmap.Create; { Объект для временного хранения рисунка. } + + Form1.BackBuffer.Canvas.Brush.Color := clBlack; + Form1.BackBuffer.Canvas.Clear; + + { Рисуем стены. } + Form1.ImageList.GetBitmap(8, bitmap); + for CurrentPosition in Board.InitialState.Walls do + DrawCell(CurrentPosition, bitmap); + { Рисуем агента. } + Form1.ImageList.GetBitmap(4, bitmap); + DrawCell(Board.InitialState.Agent, Bitmap); + + { Рисуем камни. } + Form1.ImageList.GetBitmap(2, bitmap); + for CurrentPosition in Board.InitialState.Boulders do + DrawCell(CurrentPosition, bitmap); + + { Рисуем объекты. } + Form1.ImageList.GetBitmap(1, bitmap); + For CurrentPosition in Board.InitialState.Places do + DrawCell(CurrentPosition, bitmap); + + Bitmap.Free; + + { Копируем содержимое виртуального экрана на основной. } + ScreenRect := Rect(0, 0, Screen.Width, Screen.Height); + Form1.Screen.Canvas.CopyRect(ScreenRect, Form1.BackBuffer.Canvas, ScreenRect) +end; + +{ TForm1 } + +procedure TForm1.OpenLevelClick(Sender: TObject); +var + i: Integer; + Solution: TStates; + SolutionLine: String; +begin + if OpenDialog.Execute then + begin + LoadLevel(OpenDialog.FileName); + RedrawField; + + Solution := Search(Board.InitialState); + for i := 0 to High(Solution) do + begin + SolutionLine := 'Agent: (' + IntToStr(Solution[i].Agent.X) + + ', ' + IntToStr(Solution[i].Agent.Y) + ')'; + FreeAndNil(Solution[i]); + MoveList.AddItem(SolutionLine, nil) + end + end; +end; + +procedure TForm1.FormCreate(Sender: TObject); +begin + Board := nil +end; + +procedure TForm1.FormDestroy(Sender: TObject); +begin + FreeAndNil(Board) +end; + +end. + diff --git a/Занимательное программирование/README.txt b/Занимательное программирование/README.txt index 09b4801..b30f0ee 100644 --- a/Занимательное программирование/README.txt +++ b/Занимательное программирование/README.txt @@ -20,5 +20,5 @@ Lazarus. только теоретические задания. Седьмая глава "Простые компьютерные игры" применяет Lazarus. Изображения -для частично сделаны заново, частично скопированы из приложения книги -и отредактированы. +частично сделаны заново, частично скопированы из приложения книги и +отредактированы.