Changeset 32
- Timestamp:
- Mar 4, 2014, 11:40:01 PM (11 years ago)
- Location:
- trunk
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk
- Property svn:ignore
-
old new 4 4 xtactics.res 5 5 xtactics.dbg 6 heaptrclog.trc
-
- Property svn:ignore
-
trunk/UCore.pas
r30 r32 30 30 FInitialized: Boolean; 31 31 procedure DoOnMove(CellFrom, CellTo: TCell; var CountOnce, 32 CountRepeat: Integer; Update: Boolean );32 CountRepeat: Integer; Update: Boolean; var Confirm: Boolean); 33 33 procedure DoOnWin(Player: TPlayer); 34 34 public … … 58 58 59 59 procedure TCore.DoOnMove(CellFrom, CellTo: TCell; var CountOnce, 60 CountRepeat: Integer; Update: Boolean );60 CountRepeat: Integer; Update: Boolean; var Confirm: Boolean); 61 61 begin 62 62 if Update then FormMove.SpinEditOnce.MaxValue := CellFrom.GetAvialPower + CountOnce … … 72 72 CountOnce := FormMove.SpinEditOnce.Value; 73 73 CountRepeat := FormMove.SpinEditRepeat.Value; 74 end; 74 Confirm := True; 75 end else Confirm := False; 75 76 end; 76 77 -
trunk/UFormMain.pas
r30 r32 187 187 if Assigned(Cell) then begin 188 188 Core.Game.CurrentPlayer.View.FocusedCell := Cell; 189 StatusBar1.Panels[0].Text := '[' + IntToStr(Cell.Pos.X) + ', ' + IntToStr(Cell.Pos.Y) + '] ';189 StatusBar1.Panels[0].Text := '[' + IntToStr(Cell.Pos.X) + ', ' + IntToStr(Cell.Pos.Y) + '] (' + IntToStr(Cell.MovesFrom.Count) + ', ' + IntToStr(Cell.MovesTo.Count) + ')'; 190 190 end else begin 191 191 Core.Game.CurrentPlayer.View.FocusedCell := nil; -
trunk/UGame.pas
r31 r32 95 95 destructor Destroy; override; 96 96 procedure Grow(APlayer: TPlayer); 97 procedure ClearCellMoves;98 97 procedure ComputePlayerStats; 99 98 function GetPixelSize: TPoint; … … 132 131 end; 133 132 133 { TMove } 134 134 135 TMove = class 135 CellFrom: TCell; 136 CellTo: TCell; 136 private 137 FCellFrom: TCell; 138 FCellTo: TCell; 139 procedure SetCellFrom(AValue: TCell); 140 procedure SetCellTo(AValue: TCell); 141 public 142 List: TObjectList; // TList<TMove> 137 143 CountOnce: Integer; 138 144 CountRepeat: Integer; 145 constructor Create; 146 destructor Destroy; override; 147 property CellFrom: TCell read FCellFrom write SetCellFrom; 148 property CellTo: TCell read FCellTo write SetCellTo; 139 149 end; 140 150 … … 142 152 143 153 TMoveEvent = procedure(CellFrom, CellTo: TCell; var CountOnce, CountRepeat: Integer; 144 Update: Boolean ) of object;154 Update: Boolean; var Confirm: Boolean) of object; 145 155 TWinEvent = procedure(Player: TPlayer) of object; 146 156 … … 179 189 PlayerModeText: array[TPlayerMode] of string = ('Human', 'Computer'); 180 190 clOrange = $009Aff; 181 PlayerColors: array[0..7] of TColor = (clBlue, clRed, clGreen, clOrange, clPurple, clMaroon, clAqua, clFuchsia); 191 PlayerColors: array[0..7] of TColor = (clBlue, clRed, clGreen, clOrange, 192 clPurple, clMaroon, clAqua, clFuchsia); 182 193 183 194 … … 239 250 end; 240 251 252 { TMove } 253 254 procedure TMove.SetCellFrom(AValue: TCell); 255 begin 256 if FCellFrom = AValue then Exit; 257 if Assigned(AValue) and not Assigned(FCellFrom) then begin 258 AValue.MovesFrom.Add(Self); 259 end else 260 if not Assigned(AValue) and Assigned(FCellFrom) then begin 261 FCellFrom.MovesFrom.Remove(Self); 262 end; 263 FCellFrom := AValue; 264 end; 265 266 procedure TMove.SetCellTo(AValue: TCell); 267 begin 268 if FCellTo = AValue then Exit; 269 if Assigned(AValue) and not Assigned(FCellTo) then begin 270 AValue.MovesTo.Add(Self); 271 end else 272 if not Assigned(AValue) and Assigned(FCellTo) then begin 273 FCellTo.MovesTo.Remove(Self); 274 end; 275 FCellTo := AValue; 276 end; 277 278 constructor TMove.Create; 279 begin 280 FCellFrom := nil; 281 FCellTo := nil; 282 end; 283 284 destructor TMove.Destroy; 285 begin 286 CellFrom := nil; 287 CellTo := nil; 288 if Assigned(List) then 289 List.Remove(Self); 290 inherited Destroy; 291 end; 292 241 293 { TView } 242 294 … … 303 355 304 356 destructor TCell.Destroy; 305 begin 357 var 358 I: Integer; 359 begin 360 for I := MovesFrom.Count - 1 downto 0 do 361 TMove(MovesFrom[I]).Free; 306 362 FreeAndNil(MovesFrom); 363 for I := MovesTo.Count - 1 downto 0 do 364 TMove(MovesTo[I]).Free; 307 365 FreeAndNil(MovesTo); 308 366 inherited Destroy; … … 464 522 I: Integer; 465 523 begin 466 for I := 0 to Moves.Count - 1 do 524 I := 0; 525 while I < Moves.Count do 467 526 with TMove(Moves[I]) do begin 468 527 if CellFrom.Player = Player then begin … … 486 545 CountOnce := 0; 487 546 end; 547 Inc(I); 488 548 end; 489 549 // Remove empty moves 490 550 for I := Moves.Count - 1 downto 0 do 491 551 if (TMove(Moves[I]).CellFrom.Player = Player) and 492 (TMove(Moves[I]).CountOnce = 0) and (TMove(Moves[I]).CountRepeat = 0) then begin 493 TMove(Moves[I]).CellFrom.MovesFrom.Remove(TMove(Moves[I])); 494 TMove(Moves[I]).CellTo.MovesTo.Remove(TMove(Moves[I])); 552 (TMove(Moves[I]).CountOnce = 0) and (TMove(Moves[I]).CountRepeat = 0) then 495 553 Moves.Delete(I); 496 end;497 554 end; 498 555 … … 501 558 I: Integer; 502 559 begin 503 for I := Moves.Count - 1 to 0 do560 for I := Moves.Count - 1 downto 0 do 504 561 if TMove(Moves[I]).CellFrom = Cell then 505 562 Moves.Delete(I); … … 509 566 var 510 567 NewMove: TMove; 568 OldMove: TMove; 511 569 I: Integer; 512 570 CountOnce: Integer; 513 571 CountRepeat: Integer; 572 Confirm: Boolean; 514 573 begin 515 574 I := 0; 516 575 while (I < Moves.Count) and ((TMove(Moves[I]).CellFrom <> CellFrom) or 517 576 (TMove(Moves[I]).CellTo <> CellTo)) do Inc(I); 518 if I < Moves.Count then begin 519 CountOnce := TMove(Moves[I]).CountOnce; 520 CountRepeat := TMove(Moves[I]).CountRepeat; 577 if I < Moves.Count then OldMove := TMove(Moves[I]) 578 else OldMove := nil; 579 if Assigned(OldMove) then begin 580 CountOnce := OldMove.CountOnce; 581 CountRepeat := OldMove.CountRepeat; 521 582 if Assigned(CurrentPlayer) and (CurrentPlayer.Mode = pmHuman) and 522 Assigned(FOnMove) then FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, True );583 Assigned(FOnMove) then FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, True, Confirm); 523 584 end else begin 524 585 CountOnce := Power; 525 586 CountRepeat := 0; 526 587 if Assigned(CurrentPlayer) and (CurrentPlayer.Mode = pmHuman) and 527 Assigned(FOnMove) then FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, False); 528 end; 529 if I < Moves.Count then begin 588 Assigned(FOnMove) then FOnMove(CellFrom, CellTo, CountOnce, CountRepeat, False, Confirm); 589 end; 590 if Confirm then begin 591 if Assigned(OldMove) then begin 530 592 // Already have such move 531 593 if (CountOnce = 0) and (CountRepeat = 0) then Moves.Delete(I) … … 538 600 if (CountOnce > 0) or (CountRepeat > 0) then begin 539 601 NewMove := TMove(Moves[Moves.Add(TMove.Create)]); 602 NewMove.List := Moves; 540 603 NewMove.CellFrom := CellFrom; 541 604 NewMove.CellTo := CellTo; 542 605 NewMove.CountOnce := CountOnce; 543 606 NewMove.CountRepeat := CountRepeat; 544 CellFrom.MovesFrom.Add(NewMove); 545 CellTo.MovesTo.Add(NewMove); 546 end; 607 end; 608 end; 547 609 end; 548 610 end; … … 630 692 Player: TPlayer; 631 693 begin 694 Moves := TObjectList.Create; 695 Map := THexMap.Create; 696 Players := TPlayers.Create; 697 632 698 Randomize; 633 699 634 Players := TPlayers.Create;635 700 Player := TPlayer.Create; 636 701 Player.Name := 'Player 1'; … … 648 713 VoidPercentage := 20; 649 714 650 Map := THexMap.Create;651 715 Map.Game := Self; 652 Map.Size := Point(20, 16); 653 Moves := TObjectList.Create; 716 Map.Size := Point(3, 3); 654 717 end; 655 718 … … 671 734 TurnCounter := 1; 672 735 Moves.Clear; 673 Map.ClearCellMoves;674 736 for Y := 0 to Map.Size.Y - 1 do 675 737 for X := 0 to Map.Size.X - 1 do … … 859 921 with Canvas, View do try 860 922 Lock; 861 ClearCellMoves;862 // Update moves in cells863 for I := 0 to Game.Moves.Count - 1 do864 with TMove(Game.Moves[I]) do begin865 CellFrom.MovesFrom.Add(TMove(Game.Moves[I]));866 CellTo.MovesTo.Add(TMove(Game.Moves[I]));867 end;868 869 923 for CY := Trunc(SourceRect.Top / CellSize.Y) to Trunc(SourceRect.Bottom / CellSize.Y) + 1 do 870 924 for CX := Trunc(SourceRect.Left / CellSize.X) to Trunc(SourceRect.Right / CellSize.X) + 1 do begin … … 932 986 end; 933 987 934 procedure THexMap.ClearCellMoves;935 var936 X, Y: Integer;937 begin938 for Y := 0 to Size.Y - 1 do939 for X := 0 to Size.X - 1 do begin940 Cells[Y, X].MovesFrom.Clear;941 Cells[Y, X].MovesTo.Clear;942 end;943 end;944 945 988 procedure THexMap.ComputePlayerStats; 946 989 var -
trunk/xtactics.lpi
r29 r32 168 168 <MsgFileName Value=""/> 169 169 </CompilerMessages> 170 <CustomOptions Value="-dDEBUG"/> 170 171 <CompilerPath Value="$(CompPath)"/> 171 172 </Other> -
trunk/xtactics.lpr
r29 r32 9 9 Interfaces, // this includes the LCL widgetset 10 10 Forms, UFormMain, UGame, UFormNew, UFormMove, UCore, UFormPlayer 11 { you can add units after this }; 11 { you can add units after this }, 12 SysUtils; 12 13 13 14 {$R *.res} 14 15 16 {$IFDEF DEBUG} 17 const 18 HeapTraceLog = 'heaptrclog.trc'; 19 {$ENDIF} 20 21 15 22 begin 23 {$IFDEF DEBUG} 24 // Heap trace 25 DeleteFile(ExtractFilePath(ParamStr(0)) + HeapTraceLog); 26 SetHeapTraceOutput(ExtractFilePath(ParamStr(0)) + HeapTraceLog); 27 {$ENDIF} 28 16 29 RequireDerivedFormResource := True; 17 30 Application.Initialize;
Note:
See TracChangeset
for help on using the changeset viewer.