Rainbow-Editor/frames/effectlistframeunit.pas

unit effectlistframeunit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, StdCtrls, Menus, database, fpjson,
  LCLTranslator;

type

  { TEffectListFrame }

  TEffectListFrame = class(TFrame)
    CopyEffectMenuItem: TMenuItem;
    CutEffectMenuItem: TMenuItem;
    DeleteEffectMenuItem: TMenuItem;
    EditEffectMenuItem: TMenuItem;
    EffectListBox: TListBox;
    PasteEffectMenuItem: TMenuItem;
    EffectPopupMenu: TPopupMenu;
    procedure CopyEffectMenuItemClick(Sender: TObject);
    procedure CutEffectMenuItemClick(Sender: TObject);
    procedure DeleteEffectMenuItemClick(Sender: TObject);
    procedure EditEffectMenuItemClick(Sender: TObject);
    procedure EffectListBoxDblClick(Sender: TObject);
    procedure EffectListBoxKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure EffectListBoxMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure PasteEffectMenuItemClick(Sender: TObject);
  private
    { This is handled never disposed, handled by outer object. }
    Db: TDatabase;
    { This is disposed by the JSON object in the database, it's NOT handled
      by TEffectListFrame }
    EffectList: TJSONArray;
    procedure UpdateEffects;
    function EffectToText(Effect: TJSONObject): String;
    function IsRealEffectSelected: Boolean;
    procedure AddNewEffect;
    procedure EditSelectedEffect;
    procedure ShowPopupMenu;
    procedure PasteFromClipboard;
    procedure CopySelectedToClipboard;
    procedure DeleteSelectedEffects;
  public
    procedure SetDatabase(ADb: TDatabase);
    procedure SetEffectList(AEffectList: TJSONArray);
  end;

resourcestring
  AddNewEffectStr = '<Add new effect>';
  EffectRecoverHp = 'Recover HP: ';
  EffectRecoverMp = 'Recover MP: ';
  EffectGainTp = 'Gain TP: ';
  EffectAddState = 'Add state: ';
  EffectRemoveState = 'Remove state: ';
  EffectAddBuff = 'Add buff: ';
  EffectAddDebuff = 'Add debuff: ';
  EffectRemoveBuff = 'Remove buff: ';
  DurationTurns = ' turns'; {TODO: add correct language-dependent form}
  EffectRemoveDebuff = 'Remove debuff: ';
  EffectSpecialEscape = 'Escape from battle';
  EffectSpecialUnknown = 'Special: (unknown)';
  EffectGrow = 'Increase param: ';
  EffectLearnSkill = 'Learn skill: ';
  EffectCommonEvent = 'Common event: ';
  EffectUnknownEffect = '(Unknown effect)';

  EditEffectMenuItemStr = 'Edit';
  AddNewEffectMenuItemStr = 'Add new effect';

implementation

uses
  effectselector, clipboardhelper, listboxhelper, LCLType;

{$R *.lfm}

{ TEffectListFrame }

procedure TEffectListFrame.EffectListBoxDblClick(Sender: TObject);
begin
  if not IsRealEffectSelected then
    AddNewEffect
  else
    EditSelectedEffect
end;

procedure TEffectListFrame.EffectListBoxKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  begin
    if Key = VK_DELETE then
      DeleteSelectedEffects;

    if Key = VK_RETURN then
      EffectListBoxDblClick(Sender);
  end;
end;

procedure TEffectListFrame.EditEffectMenuItemClick(Sender: TObject);
begin
  if not IsRealEffectSelected then
    AddNewEffect
  else
    EditSelectedEffect
end;

procedure TEffectListFrame.CutEffectMenuItemClick(Sender: TObject);
begin
  CopySelectedToClipboard;
  DeleteSelectedEffects
end;

procedure TEffectListFrame.DeleteEffectMenuItemClick(Sender: TObject);
begin
  DeleteSelectedEffects
end;

procedure TEffectListFrame.CopyEffectMenuItemClick(Sender: TObject);
begin
  CopySelectedToClipboard
end;

procedure TEffectListFrame.EffectListBoxMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbRight then begin
    ShowPopupMenu;
  end;
end;

procedure TEffectListFrame.PasteEffectMenuItemClick(Sender: TObject);
begin
  PasteFromClipboard
end;

procedure TEffectListFrame.UpdateEffects;
var
  I: Integer;
begin
  Assert(Db <> nil, 'Database must be set before setting effect list!');

  with EffectListBox.Items do begin
    BeginUpdate;
    Clear;

    if EffectList <> nil then begin
      for I := 0 to EffectList.Count -1 do begin
        EffectListBox.Items.Add(EffectToText(EffectList.Objects[I]));
      end;
    end;
    Add(AddNewEffectStr);
    EndUpdate;
  end;
end;

function TEffectListFrame.EffectToText(Effect: TJSONObject): String;
var
  Code: Integer = 0;
  DataId: Integer = 0;
  Value1: Double = 0;
  Value2: Double = 0;
  CodeJson, DataIdJson, Value1Json, Value2Json: TJSONNumber;

  function PercentsPlusConst: String;
  var
    Percents, ConstVal: Integer;
  begin
    Percents := Round(Value1 * 100);
    ConstVal := Round(Value2);

    if (Percents <> 0) and (ConstVal <> 0) then
      PercentsPlusConst := Format('%d%% + %d', [Percents, ConstVal])
    else if (Percents <> 0) then
      PercentsPlusConst := IntToStr(Percents) + '%'
    else
      PercentsPlusConst := IntToStr(ConstVal)
  end;

begin
  if (Effect <> nil) and Effect.Find('code', CodeJson) then
    Code := CodeJson.AsInteger;
  if (Effect <> nil) and Effect.Find('dataId', DataIdJson) then
    DataId := DataIdJson.AsInteger;
  if (Effect <> nil) and Effect.Find('value1', Value1Json) then
    Value1 := Value1Json.AsFloat;
  if (Effect <> nil) and Effect.Find('value2', Value2Json) then
    Value2 := Value2Json.AsFloat;

  case Code of
    EFFECT_RECOVER_HP:
      EffectToText := EffectRecoverHp + PercentsPlusConst;
    EFFECT_RECOVER_MP:
      EffectToText := EffectRecoverMp + PercentsPlusConst;
    EFFECT_GAIN_TP:
      EffectToText := EffectGainTp + IntToStr(Round(Value1));
    EFFECT_ADD_STATE:
      EffectToText := EffectAddState + Db.GetStateName(DataId) + ' '
                                     + IntToStr(Round(Value1 * 100)) + '%';
    EFFECT_REMOVE_STATE:
      EffectToText := EffectRemoveState + Db.GetStateName(DataId) + ' '
                                        + IntToStr(Round(Value1 * 100)) + '%';
    EFFECT_ADD_BUFF:
      EffectToText := EffectAddBuff + Db.GetParamName(DataId) + ' '
                                    + IntToStr(Round(Value1)) + DurationTurns;
    EFFECT_ADD_DEBUFF:
      EffectToText := EffectAddDebuff + Db.GetParamName(DataId) + ' '
                                      + IntToStr(Round(Value1)) + DurationTurns;
    EFFECT_REMOVE_BUFF:
      EffectToText := EffectRemoveBuff + Db.GetParamName(DataId);
    EFFECT_REMOVE_DEBUFF:
      EffectToText := EffectRemoveDebuff + Db.GetParamName(DataId);
    EFFECT_SPECIAL:
      if dataId = SPECIAL_EFFECT_ESCAPE then
        EffectToText := EffectSpecialEscape
      else
        EffectToText := EffectSpecialUnknown;
    EFFECT_GROW:
      EffectToText := EffectGrow + Db.GetParamName(DataId) + ' +'
                                 + IntToStr(Round(Value1));
    EFFECT_LEARN_SKILL:
      EffectToText := EffectLearnSkill + Db.GetSkillName(DataId);
    EFFECT_COMMON_EVENT:
      EffectToText := EffectCommonEvent + Db.GetCommonEventName(DataId);
    else
      EffectToText := EffectUnknownEffect;
  end;
end;

function TEffectListFrame.IsRealEffectSelected: Boolean;
var
  LastIsSelected, NoneSelected: Boolean;
begin
  LastIsSelected := EffectListBox.ItemIndex = EffectListBox.Items.Count - 1;
  NoneSelected := EffectListBox.ItemIndex < 0;

  IsRealEffectSelected := not LastIsSelected and not NoneSelected;
end;

procedure TEffectListFrame.AddNewEffect;
var
  NewEffect: TJSONObject;
begin
  if EffectSelectorForm.ShowEffectSelection(Db) then begin
    NewEffect := TJSONObject.Create;
    NewEffect.Add('code', EffectSelectorForm.SelectedCode);
    NewEffect.Add('dataId', EffectSelectorForm.SelectedDataId);
    NewEffect.Add('value1', EffectSelectorForm.SelectedValue1);
    NewEffect.Add('value2', EffectSelectorForm.SelectedValue2);

    EffectList.Add(NewEffect);

    with EffectListBox do begin
      Items.BeginUpdate;
      Items[Items.Count -1] := EffectToText(NewEffect);
      Items.Add(AddNewEffectStr);
      Items.EndUpdate;
    end;
  end;
end;

procedure TEffectListFrame.EditSelectedEffect;
var
  Effect: TJSONObject;
  CodeJson, DataIdJson, Value1Json, Value2Json: TJSONNumber;
  Code: Integer = 0;
  DataId: Integer = 0;
  Value1: Double = 0;
  Value2: Double = 0;
begin
  Effect := EffectList.Objects[EffectListBox.ItemIndex];
  if Effect.Find('code', CodeJson) then
    Code := CodeJson.AsInteger;
  if Effect.Find('dataId', DataIdJson) then
    DataId := DataIdJson.AsInteger;
  if Effect.Find('value1', Value1Json) then
    Value1 := Value1Json.AsFloat;
  if Effect.Find('value2', Value2Json) then
    Value2 := Value2Json.AsFloat;

  if EffectSelectorForm.ShowEffectSelection(Db, Code, DataId, Value1, Value2) then begin
    Effect.Integers['code'] := EffectSelectorForm.SelectedCode;
    Effect.Integers['dataId'] := EffectSelectorForm.SelectedDataId;
    Effect.Floats['value1'] := EffectSelectorForm.SelectedValue1;
    Effect.Floats['value2'] := EffectSelectorForm.SelectedValue2;
    EffectListBox.Items[EffectListBox.ItemIndex] := EffectToText(Effect);
  end
end;

procedure TEffectListFrame.ShowPopupMenu;
var
  IsForRealEffect: Boolean;
begin
  IsForRealEffect := IsRealEffectSelected;

  DeleteEffectMenuItem.Enabled := ListboxSelectionNotEmpty(EffectListBox);

  if IsForRealEffect then
    EditEffectMenuItem.Caption := EditEffectMenuItemStr
  else
    EditEffectMenuItem.Caption := AddNewEffectMenuItemStr;

  EffectPopupMenu.PopUp;
end;

procedure TEffectListFrame.PasteFromClipboard;
var
  PastedArray: TJSONArray;
  I: Integer;
  StartId: Integer;
begin
  StartId := EffectListBox.ItemIndex;

  PastedArray := GetJsonArrayFromClipboard('application/rpgmv-effects');
  if PastedArray = nil then
    Exit;

  try
    for I := 0 to PastedArray.Count -1 do begin
      if PastedArray[I].JSONType = jtObject then begin
        EffectList.Insert(StartId + I, PastedArray.Objects[I].Clone as TJSONObject);
      end;
    end;
  finally
    PastedArray.Free;
  end;

  UpdateEffects;
end;

procedure TEffectListFrame.CopySelectedToClipboard;
var
  ArrSrl: TClipboardArraySerializer;
  I, NumCopied: Integer;
begin
  ArrSrl := TClipboardArraySerializer.Create(DataTypeIds[DATA_TYPE_ID_EFFECTS]);
  try
    NumCopied := 0;
    for I := 0 to EffectListBox.Count -1 do begin
      if EffectListBox.Selected[I] then begin
        ArrSrl.AddItem(EffectList.Objects[I]);
        Inc(NumCopied)
      end
    end;

    if NumCopied > 0 then
      ArrSrl.CopyToClipboard
  finally
    ArrSrl.Free;
  end;
end;

procedure TEffectListFrame.DeleteSelectedEffects;
var
  I: Integer;
begin
  for I := EffectListBox.Count -1 downto 0 do begin
    if EffectListBox.Selected[I] then begin
      EffectList.Delete(I);
    end
  end;

  UpdateEffects
end;

procedure TEffectListFrame.SetDatabase(ADb: TDatabase);
begin
  Db := ADb;
end;

procedure TEffectListFrame.SetEffectList(AEffectList: TJSONArray);
begin
  EffectList := AEffectList;
  UpdateEffects
end;

end.