(* * CDDL HEADER START * * The contents of this file are subject to the terms of the * Common Development and Distribution License, Version 1.0 only * (the "License"). You may not use this file except in compliance * with the License. * * You can obtain a copy of the license at * http://www.opensource.org/licenses/cddl1.php. * See the License for the specific language governing permissions * and limitations under the License. * * When distributing Covered Code, include this CDDL HEADER in each * file and include the License file at * http://www.opensource.org/licenses/cddl1.php. If applicable, * add the following below this CDDL HEADER, with the fields enclosed * by brackets "[]" replaced with your own identifying * information: * Portions Copyright [yyyy] [name of copyright owner] * * CDDL HEADER END * * * Portions Copyright 2022 Andreas Schneider *) unit UActions; {$mode ObjFPC}{$H+} interface uses Classes, SysUtils, fgl, UWorldItem, UStatics, UMap, UPacket, ULandscape; type TPacketList = specialize TFPGObjectList; TIdList = specialize TFPGList; { TBaseEditAction } TBaseEditAction = class(TObject) private FLandscape: TLandscape; FMapTiles: TMapCellList; FStaticTiles: TStaticItemList; public constructor Create(ALandscape: TLandscape); destructor Destroy; override; public property MapTiles: TMapCellList read FMapTiles; property StaticTiles: TStaticItemList read FStaticTiles; procedure StartSelection(ATile: TWorldItem); virtual; abstract; procedure AddSelection(ATile: TWorldItem); virtual; abstract; function IsHighlighted(ATile: TWorldItem): Boolean; virtual; abstract; procedure Execute(AScreenBuffer: TScreenBuffer; out AForwardActions, AReverseActions: TPacketList); virtual; end; { TRectangleEditAction } TRectangleEditAction = class(TBaseEditAction) private FFirstTile: TWorldItem; FLastTile: TWorldItem; FRect: TRect; public constructor Create(ALandscape: TLandscape); procedure StartSelection(ATile: TWorldItem); override; procedure AddSelection(ATile: TWorldItem); override; function IsHighlighted(ATile: TWorldItem): Boolean; override; private procedure UpdateArea; virtual; function IsEditableTile(AWorldItem: TWorldItem): Boolean; inline; function IsEditableStaticTile(AWorldItem: TWorldItem): Boolean; inline; end; { TDrawAction } TDrawAction = class(TRectangleEditAction) private FTileIds: TIdList; FForceZ: Boolean; FForceZValue: ShortInt; FRandomZ: Boolean; FRandomZValue: Byte; FHue: Word; public property TileIds: TIdList read FTileIds; property ForceZ: Boolean read FForceZ write FForceZ; property ForceZValue: ShortInt read FForceZValue write FForceZValue; property RandomZ: Boolean read FRandomZ write FRandomZ; property RandomZValue: Byte read FRandomZValue write FRandomZValue; constructor Create(ALandscape: TLandscape); function IsHighlighted(ATile: TWorldItem): Boolean; override; procedure Execute(AScreenBuffer: TScreenBuffer; out AForwardActions, AReverseActions: TPacketList); override; private procedure UpdateArea; override; end; { TMoveAction } TMoveAction = class(TRectangleEditAction) private FOffsetX: Integer; FOffsetY: Integer; public property OffsetX: Integer read FOffsetX write FOffsetX; property OffsetY: Integer read FOffsetY write FOffsetY; procedure Execute(AScreenBuffer: TScreenBuffer; out AForwardActions, AReverseActions: TPacketList); override; end; { TElevateAction } TElevateAction = class(TRectangleEditAction) public type TMode = (emSet, emRaise, emLower); private FMode: TMode; FZ: ShortInt; FRandomZ: Boolean; FRandomZValue: Byte; public property Mode: TMode read FMode write FMode; property Z: ShortInt read FZ write FZ; procedure Execute(AScreenBuffer: TScreenBuffer; out AForwardActions, AReverseActions: TPacketList); override; end; { TDeleteAction } TDeleteAction = class(TRectangleEditAction) public procedure Execute(AScreenBuffer: TScreenBuffer; out AForwardActions, AReverseActions: TPacketList); override; end; { THueAction } THueAction = class(TRectangleEditAction) private FHue: Word; public property Hue: Word read FHue write FHue; procedure Execute(AScreenBuffer: TScreenBuffer; out AForwardActions, AReverseActions: TPacketList); override; end; implementation uses Math, UGameResources, UPackets; { TBaseEditAction } constructor TBaseEditAction.Create(ALandscape: TLandscape); begin FLandscape := ALandscape; FMapTiles := TMapCellList.Create; FStaticTiles := TStaticItemList.Create; end; destructor TBaseEditAction.Destroy; begin FMapTiles.Free; FStaticTiles.Free; inherited Destroy; end; procedure TBaseEditAction.Execute(AScreenBuffer: TScreenBuffer; out AForwardActions, AReverseActions: TPacketList); begin AForwardActions := TPacketList.Create; AReverseActions := TPacketList.Create; end; { TRectangleEditAction } constructor TRectangleEditAction.Create(ALandscape: TLandscape); begin inherited Create(ALandscape); FRect.Left := -1; FRect.Top := -1; FRect.Bottom := -1; FRect.Right := -1; end; procedure TRectangleEditAction.StartSelection(ATile: TWorldItem); begin FFirstTile := ATile; FLastTile := ATile; UpdateArea; end; procedure TRectangleEditAction.AddSelection(ATile: TWorldItem); begin FLastTile := ATile; UpdateArea; end; function TRectangleEditAction.IsHighlighted(ATile: TWorldItem): Boolean; begin Result := ((FFirstTile = FLastTile) and (FFirsttile = ATile)) or FRect.Contains(TPoint.Create(ATile.X, ATile.Y)); end; procedure TRectangleEditAction.UpdateArea; begin if FFirstTile = FLastTile then begin FRect.Left := -1; FRect.Top := -1; FRect.Bottom := -1; FRect.Right := -1; end else begin FRect.Left := Min(FFirstTile.X, FLastTile.X); FRect.Top := Min(FFirstTile.Y, FLastTile.Y); FRect.Right := Max(FFirstTile.X, FLastTile.X); FRect.Bottom := Max(FFirstTile.Y, FLastTile.Y); end; end; function TRectangleEditAction.IsEditableTile(AWorldItem: TWorldItem): Boolean; begin if not AWorldItem.CanBeEdited then Exit(False); if FFirstTile = FLastTile then begin if AWorldItem <> FFirstTile then Exit(False); end else begin if not FRect.Contains(TPoint.Create(AWorldItem.X, AWorldItem.Y)) then Exit(False); end; Result := True; end; function TRectangleEditAction.IsEditableStaticTile(AWorldItem: TWorldItem): Boolean; begin if not IsEditableTile(AWorldItem) then Exit(False); if not (AWorldItem is TStaticItem) then Exit(False); Result := True; end; { TDrawAction } constructor TDrawAction.Create(ALandscape: TLandscape); begin inherited Create(ALandscape); FTileIds := TIdList.Create; end; function TDrawAction.IsHighlighted(ATile: TWorldItem): Boolean; begin // Since we add new tiles, we don't need to highlight any existing // tiles. Result := False; end; procedure TDrawAction.Execute(AScreenBuffer: TScreenBuffer; out AForwardActions, AReverseActions: TPacketList); var staticTile: TStaticItem; mapTile, previousMapTile: TMapCell; begin inherited Execute(AScreenBuffer, AForwardActions, AReverseActions); if FTileIds.Count < 1 then Exit; for mapTile in FMapTiles do begin previousMapTile := FLandscape.MapCell[mapTile.X, mapTile.Y]; AForwardActions.Add(TDrawMapPacket.Create(mapTile.X, mapTile.Y, mapTile.Z, mapTile.TileID)); AReverseActions.Add(TDrawMapPacket.Create(previousMapTile.X, previousMapTile.Y, previousMapTile.Z, previousMapTile.TileID)); end; for staticTile in FStaticTiles do begin AForwardActions.Add(TInsertStaticPacket.Create(staticTile)); AReverseActions.Add(TDeleteStaticPacket.Create(staticTile)); end; end; procedure TDrawAction.UpdateArea; var targetArea: TRect; tileX, tileY: Word; tileId: Word; mapCell: TMapCell; staticItem: TStaticItem; worldItem: TWorldItem; begin inherited UpdateArea; FMapTiles.Clear; FStaticTiles.Clear; // TODO Only update relevant section of the tile lists. if FFirstTile = nil then Exit; targetArea.Left := Min(FFirstTile.X, FLastTile.X); targetArea.Top := Min(FFirstTile.Y, FLastTile.Y); targetArea.Right := Max(FFirstTile.X, FLastTile.X); targetArea.Bottom := Max(FFirstTile.Y, FLastTile.Y); for tileX := targetArea.Left to targetArea.Right do for tileY := targetArea.Top to targetArea.Bottom do begin tileId := FTileIds[Random(FTileIds.Count)]; if tileId < $4000 then begin // Map Tile mapCell := FLandscape.MapCell[tileX, tileY].Clone; mapCell.TileID := tileId; worldItem := mapCell; FMapTiles.Add(mapCell); end else begin // Static Tile staticItem := TStaticItem.Create(nil, nil, 0, 0); staticItem.TileID := tileId - $4000; staticItem.Hue := FHue; if not FForceZ then begin staticItem.Z := FFirstTile.Z; if FFirstTile is TStaticItem then staticItem.Z := staticItem.Z + ResMan.Tiledata.StaticTiles[FFirstTile.TileID].Height; end; worldItem := staticItem; FStaticTiles.Add(staticItem); end; worldItem.X := tileX; worldItem.Y := tileY; if FForceZ then worldItem.Z := FForceZValue; if FRandomZ then worldItem.Z := worldItem.Z + Random(FRandomZValue); end; end; { TDeleteAction } procedure TDeleteAction.Execute(AScreenBuffer: TScreenBuffer; out AForwardActions, AReverseActions: TPacketList); var item: TWorldItem; begin inherited Execute(AScreenBuffer, AForwardActions, AReverseActions); for item in AScreenBuffer do begin if not IsEditableStaticTile(item) then Continue; AForwardActions.Add(TDeleteStaticPacket.Create(TStaticItem(item))); AReverseActions.Add(TInsertStaticPacket.Create(TStaticItem(item))); end; end; { TMoveAction } procedure TMoveAction.Execute(AScreenBuffer: TScreenBuffer; out AForwardActions, AReverseActions: TPacketList); var newX, newY: Word; item: TWorldItem; begin inherited Execute(AScreenBuffer, AForwardActions, AReverseActions); for item in AScreenBuffer do begin if not IsEditableStaticTile(item) then Continue; newX := EnsureRange(item.X + FOffsetX, 0, FLandscape.CellWidth - 1); newY := EnsureRange(item.Y + FOffsetY, 0, FLandscape.CellHeight - 1); AForwardActions.Add(TMoveStaticPacket.Create(TStaticItem(item), newX, newY)); AReverseActions.Add(TMoveStaticPacket.Create(TStaticItem(item), item.X, item.Y)); end; end; { TElevateAction } procedure TElevateAction.Execute(AScreenBuffer: TScreenBuffer; out AForwardActions, AReverseActions: TPacketList); var item: TWorldItem; newZ: Integer; begin inherited Execute(AScreenBuffer, AForwardActions, AReverseActions); for item in AScreenBuffer do begin if not IsEditableTile(item) then Continue; newZ := FZ; if FRandomZ then newZ := newZ + Random(FRandomZValue); case FMode of emRaise: newZ := item.Z + FZ; emLower: newZ := item.Z - FZ; end; newZ := EnsureRange(newZ, -128, 127); if item is TMapCell then begin AForwardActions.Add(TDrawMapPacket.Create(item.X, item.Y, newZ, item.TileID)); AReverseActions.Add(TDrawMapPacket.Create(item.X, item.Y, item.Z, item.TileID)); end else if item is TStaticItem then begin AForwardActions.Add(TElevateStaticPacket.Create(TStaticItem(item), newZ)); AReverseActions.Add(TElevateStaticPacket.Create(TStaticItem(item), item.Z)); end; end; end; { THueAction } procedure THueAction.Execute(AScreenBuffer: TScreenBuffer; out AForwardActions, AReverseActions: TPacketList); var item: TWorldItem; begin inherited Execute(AScreenBuffer, AForwardActions, AReverseActions); for item in AScreenBuffer do begin if not IsEditableStaticTile(item) then Continue; if TStaticItem(item).Hue = FHue then Continue; AForwardActions.Add(THueStaticPacket.Create(TStaticItem(item), FHue)); AReverseActions.Add(THueStaticPacket.Create(TStaticItem(item), TStaticItem(item).Hue)); end; end; end.