unit Main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, PNGImage, Vcl.StdCtrls, Math, Vcl.ComCtrls, TypInfo, CustomObject,
  Vcl.ExtCtrls, IniFiles, Vcl.Grids, Vcl.ValEdit, System.IOUtils;

type
  TTypeBrush = (
    tbNone = 0,
    tbJoin = 1,
    tbEdit = 2,
    tbFieldType = 3,
    tbObjectType = 4
  );

  TFieldType = (
    ftNone = 0,
    ftStone = 1,
    ftWall = 2,
    ftTree = 3,
    ftFloor = 4,
    ftGlass = 5
  );

  PField = ^TField;
  TField = record
    X, Y: Integer;
    FieldType: TFieldType;
    ID: Word;
    ObjectType: TObjectType;
    Obj: TCustomObject;
  end;

  TfMain = class(TForm)
    pLeft: TPanel;
    Panel2: TPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Tree: TTreeView;
    StatusBar: TStatusBar;
    ValueListEditor: TValueListEditor;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Panel1: TPanel;
    bDelParents: TButton;
    bDelChilds: TButton;
    Memo: TMemo;
    procedure FormPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormClick(Sender: TObject);
    procedure ValueListEditorValidate(Sender: TObject; ACol, ARow: Integer;
      const KeyName, KeyValue: string);
    procedure FormMouseLeave(Sender: TObject);
    procedure bDelChildsClick(Sender: TObject);
    procedure bDelParentsClick(Sender: TObject);
    procedure MemoChange(Sender: TObject);
  private
    FFields: array of array of TField;
    FWidth: Integer;
    FHeight: Integer;
    FFieldSize: Integer;
    FCamera: TPoint;
    FMouseField: TPoint;
    FMouseDown: array[TMouseButton] of Boolean;
    FOldMousePosition: TPoint;
    FJoinObj: TCustomObject;
    FSelectedObj: TCustomObject;
    function GetTypeBrush: TTypeBrush;
    function GetBrush: Integer;
    procedure CreateObject(APoint: TPoint; AID: Word = 0);
    procedure SetBrushToField;
    procedure SetSelectedObj(ASelectedObj: TCustomObject);
  public
    procedure New;
    procedure Load(const AFileName: WideString);
    procedure Save(const AFileName: WideString);
    property TypeBrush: TTypeBrush read GetTypeBrush;
    property Brush: Integer read GetBrush;
  end;

var
  fMain: TfMain;

implementation

{$R *.dfm}

procedure TfMain.Button1Click(Sender: TObject);
begin
  New;
end;

procedure TfMain.Button2Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    Load(Copy(OpenDialog1.FileName, 1, Length(OpenDialog1.FileName) - 4));
end;

procedure TfMain.Button3Click(Sender: TObject);
begin
  if SaveDialog1.Execute then
    Save(SaveDialog1.FileName);
end;

procedure TfMain.CreateObject(APoint: TPoint; AID: Word = 0);
begin
  if FFields[APoint.X, APoint.Y].ObjectType <> otNone then
    FFields[APoint.X, APoint.Y].Obj := TCustomObject.Create(FFields[APoint.X, APoint.Y].ObjectType, APoint, AID)
  else
    FFields[APoint.X, APoint.Y].Obj := nil;
end;

procedure TfMain.bDelParentsClick(Sender: TObject);
var
  i: Integer;
begin
  if Assigned(FSelectedObj) then
  begin
    for i := 0 to FSelectedObj.ParentList.Count - 1 do
      FSelectedObj.ParentList[i].ChildList.Remove(FSelectedObj);

    FSelectedObj.ParentList.Clear;
    Repaint;
  end;
end;

procedure TfMain.bDelChildsClick(Sender: TObject);
var
  i: Integer;
begin
  if Assigned(FSelectedObj) then
  begin
    for i := 0 to FSelectedObj.ChildList.Count - 1 do
      FSelectedObj.ChildList[i].ParentList.Remove(FSelectedObj);
    FSelectedObj.ChildList.Clear;
    Repaint;
  end;
end;

procedure TfMain.FormClick(Sender: TObject);
begin
  if (FMouseField.X < 0) or (FMouseField.Y < 0) or (FMouseField.X >= FWidth) or (FMouseField.Y >= FHeight) then
    Exit;
  SetBrushToField;
end;

procedure TfMain.FormCreate(Sender: TObject);
var
  Node: TTreeNode;
  FieldType: TFieldType;
  ObjectType: TObjectType;
begin
  FillChar(FMouseDown, Length(FMouseDown), 0);
  FJoinObj := nil;
  FCamera := Point(0, 0);
  FFieldSize := 16;

  Node := Tree.Items.AddChild(nil, 'Join');
  Node := Tree.Items.AddChild(nil, 'Edit');

  Node := Tree.Items.AddChild(nil, 'FieldType');
  for FieldType := Low(TFieldType) to High(TFieldType) do
    Tree.Items.AddChild(Node, GetEnumName(TypeInfo(TFieldType), Integer(FieldType)));

  Node := Tree.Items.AddChild(nil, 'ObjectType');
  for ObjectType := Low(TObjectType) to High(TObjectType) do
    Tree.Items.AddChild(Node, GetEnumName(TypeInfo(TObjectType), Integer(ObjectType)));
  Tree.FullExpand;

  New;
end;

procedure TfMain.New;
var
  X, Y: Integer;
begin
  FWidth := 512;
  FHeight := 512;

  SetLength(FFields, FWidth);
  for X := 0 to FWidth - 1 do
    SetLength(FFields[X], FHeight);

  for Y := 0 to FHeight - 1 do
    for X := 0 to FWidth - 1 do
    begin
      FFields[X, Y].X := X;
      FFields[X, Y].Y := Y;
      FFields[X, Y].ID := 0;
      FFields[X, Y].FieldType := ftNone;
      FFields[X, Y].ObjectType := otNone;
      FFields[X, Y].Obj := nil;
    end;
  Invalidate;
end;

procedure TfMain.SetSelectedObj(ASelectedObj: TCustomObject);
begin
  if FSelectedObj <> ASelectedObj then
  begin
    ValueListEditor.Strings.Clear;
    Memo.Clear;
    if Assigned(ASelectedObj) then
    begin
      ASelectedObj.LoadEditList(ValueListEditor);
      Memo.Lines.AddStrings(ASelectedObj.Talks);
    end;

    ValueListEditor.Enabled := ValueListEditor.Strings.Count > 0;
    bDelParents.Enabled := ValueListEditor.Enabled;
    bDelChilds.Enabled := ValueListEditor.Enabled;
    Memo.Enabled := ValueListEditor.Enabled;
  end;
  FSelectedObj := ASelectedObj;
end;

procedure TfMain.ValueListEditorValidate(Sender: TObject; ACol, ARow: Integer; const KeyName, KeyValue: string);
begin
  if Assigned(FSelectedObj) then
  begin
    FSelectedObj.SaveEditList(KeyName, KeyValue);
    Repaint;
  end;
end;

procedure TfMain.MemoChange(Sender: TObject);
begin
  if Assigned(FSelectedObj) then
  begin
    FSelectedObj.Talks.Clear;
    FSelectedObj.Talks.AddStrings(Memo.Lines);
  end;
end;

procedure TfMain.SetBrushToField;
begin
  case TypeBrush of
    tbEdit: SetSelectedObj(FFields[FMouseField.X, FMouseField.Y].Obj);
    tbFieldType:
      if (Brush >= 0) and (FFields[FMouseField.X, FMouseField.Y].FieldType <> TFieldType(Brush)) then
        FFields[FMouseField.X, FMouseField.Y].FieldType := TFieldType(Brush);
    tbObjectType:
      if (Brush >= 0) and (FFields[FMouseField.X, FMouseField.Y].ObjectType <> TObjectType(Brush)) then
      begin
        if Assigned(FFields[FMouseField.X, FMouseField.Y].Obj) then
          FFields[FMouseField.X, FMouseField.Y].Obj.Free;

        FFields[FMouseField.X, FMouseField.Y].ObjectType := TObjectType(Brush);
        CreateObject(FMouseField);
        SetSelectedObj(FFields[FMouseField.X, FMouseField.Y].Obj);
      end;
  end;
  Repaint;
end;

procedure TfMain.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (FMouseField.X < 0) or (FMouseField.Y < 0) or (FMouseField.X >= FWidth) or (FMouseField.Y >= FHeight) then
    Exit;
  FMouseDown[Button] := True;
  if (TypeBrush = tbJoin) and Assigned(FFields[FMouseField.X, FMouseField.Y].Obj) then
    FJoinObj := FFields[FMouseField.X, FMouseField.Y].Obj;

end;

procedure TfMain.FormMouseLeave(Sender: TObject);
begin
  FillChar(FMouseDown, Length(FMouseDown), 0);
end;

procedure TfMain.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (FMouseField.X < 0) or (FMouseField.Y < 0) or (FMouseField.X >= FWidth) or (FMouseField.Y >= FHeight) then
    Exit;
  FMouseDown[Button] := False;
  if Assigned(FJoinObj) and Assigned(FFields[FMouseField.X, FMouseField.Y].Obj)
    and (FJoinObj.ParentList.IndexOf(FFields[FMouseField.X, FMouseField.Y].Obj) < 0)
    and (FFields[FMouseField.X, FMouseField.Y].Obj.ChildList.IndexOf(FJoinObj) < 0) then
  begin
    FJoinObj.ParentAdd(FFields[FMouseField.X, FMouseField.Y].Obj);
    FFields[FMouseField.X, FMouseField.Y].Obj.ChildAdd(FJoinObj);
    FJoinObj := nil;
    Repaint;
  end;
end;

procedure TfMain.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  FMouseField := Point((X - FCamera.X) div FFieldSize, (Y - FCamera.Y) div FFieldSize);
  if (FMouseField.X < 0) or (FMouseField.Y < 0) or (FMouseField.X >= FWidth) or (FMouseField.Y >= FHeight) then
    Exit;

  if (FMouseField.X > 0) and (FMouseField.Y > 0) then
    if Assigned(FFields[FMouseField.X, FMouseField.Y].Obj) then
      StatusBar.Panels[0].Text := IntToStr(FFields[FMouseField.X, FMouseField.Y].Obj.ID);

  if FMouseDown[mbLeft] then
  begin
    SetBrushToField;
  end;

  if FMouseDown[mbRight] then
  begin
    FCamera.X := FCamera.X + X - FOldMousePosition.X;
    FCamera.Y := FCamera.Y + Y - FOldMousePosition.Y;
    Repaint;
  end;
  FOldMousePosition := Point(X, Y);
end;

procedure TfMain.Save(const AFileName: WideString);
var
  png: TPngImage;
  X, Y, i: Integer;
  ColorLine: PRGBLine;
  AlphaLine: PByteArray;
  ini: TIniFile;
  Strings: TStringList;
begin
  ini := TIniFile.Create(ExtractFilePath(AFileName) + TPath.GetFileNameWithoutExtension(AFileName) + '.ini');
  Strings := TStringList.Create;
  ini.ReadSections(Strings);
  for i := 0 to Strings.Count - 1 do
    ini.EraseSection(Strings.Strings[i]);
  Strings.Free;
  png := TPngImage.CreateBlank(COLOR_RGBALPHA, 8, FWidth, FHeight);
  try
    for Y := 0 to FHeight - 1 do
    begin
      ColorLine := PRGBLine(png.Scanline[Y]);
      AlphaLine := PByteArray(png.AlphaScanline[Y]);
      for X := 0 to FWidth - 1 do
      begin
        AlphaLine[X] := 0;
        ColorLine[X].rgbtRed := 0;
        ColorLine[X].rgbtGreen := Byte(FFields[X, Y].FieldType);
        ColorLine[X].rgbtBlue := Byte(FFields[X, Y].ObjectType);
        if Assigned(FFields[X, Y].Obj) then
        begin
          AlphaLine[X] := FFields[X, Y].Obj.ID div 256;
          ColorLine[X].rgbtRed := FFields[X, Y].Obj.ID mod 256;
          FFields[X, Y].Obj.Save(ini);
        end;
      end;
    end;
    png.SaveToFile(ExtractFilePath(AFileName) + TPath.GetFileNameWithoutExtension(AFileName) + '.png');
  finally
    png.Free;
    ini.Free;
  end;
end;

procedure TfMain.Load(const AFileName: WideString);
var
  png: TPngImage;
  X, Y, i: Integer;
  ColorLine: PRGBLine;
  AlphaLine: PByteArray;
  F: TFileStream;
  ini: TIniFile;
begin
  if not FileExists(AFileName + '.png') then
  begin
    ShowMessage('Файл "' + AFileName + '.png" не найден!');
    Exit;
  end;
  New;

  png := TPngImage.Create;
  try
    png.LoadFromFile(AFileName + '.png');

    FWidth := png.Width;
    FHeight := png.Height;
    SetLength(FFields, FWidth);
    for X := 0 to FWidth - 1 do
      SetLength(FFields[X], FHeight);

    for Y := 0 to FHeight - 1 do
    begin
      ColorLine := PRGBLine(png.Scanline[Y]);
      AlphaLine := PByteArray(png.AlphaScanline[Y]);
      for X := 0 to FWidth - 1 do
      begin
        FFields[X, Y].X := X;
        FFields[X, Y].Y := Y;
        FFields[X, Y].ObjectType := TObjectType(ColorLine[X].rgbtBlue);
        if FFields[X, Y].ObjectType <> otNone then
          FFields[X, Y].ID := AlphaLine[X] * 256 + ColorLine[X].rgbtRed
        else
          FFields[X, Y].ID := 0;
        FFields[X, Y].FieldType := TFieldType(ColorLine[X].rgbtGreen);
        CreateObject(Point(X, Y), FFields[X, Y].ID);
      end;
    end;

    if FileExists(AFileName + '.ini') then
    begin
      ini := TIniFile.Create(AFileName + '.ini');
      try
        for i := 0 to TCustomObject.ObjectList.Count - 1 do
          TCustomObject.ObjectList[i].Load(ini);
      finally
        ini.Free;
      end;
    end;

  finally
    png.Free;
  end;
  Repaint;
end;

procedure TfMain.FormPaint(Sender: TObject);
var
  X, Y, i, j: Integer;
  Str: String;
  Obj: TCustomObject;
begin
  Canvas.Brush.Color := clBtnFace;
  Canvas.Brush.Style := bsSolid;
  Canvas.Pen.Style := psClear;
  Canvas.Rectangle(0, 0, ClientWidth, ClientHeight);
  Canvas.Brush.Style := bsClear;
  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Color := clBlack;
  Canvas.Font.Name := 'Arial';
  Canvas.Font.Size := 13;

  Canvas.Pen.Color := clSilver;
  for Y := 0 to FHeight - 1 do
  begin
    Canvas.MoveTo(Max(0, FCamera.X), FCamera.Y + FFieldSize * Y);
    Canvas.LineTo(ClientWidth, FCamera.Y + FFieldSize * Y);
  end;
  for X := 0 to FWidth - 1 do
  begin
    Canvas.MoveTo(FCamera.X + FFieldSize * X, Max(0, FCamera.Y));
    Canvas.LineTo(FCamera.X + FFieldSize * X, ClientHeight);
  end;
  Canvas.Pen.Color := clBlack;

  Canvas.Rectangle(FCamera.X, FCamera.Y, FCamera.X + FFieldSize * FWidth, FCamera.Y + FFieldSize * FHeight);
  for Y := 0 to FHeight - 1 do
    for X := 0 to FWidth - 1 do
    begin
      case FFields[X, Y].FieldType of
        ftStone: Canvas.Ellipse(FCamera.X + FFieldSize * X, FCamera.Y + FFieldSize * Y, FCamera.X + FFieldSize + FFieldSize * X, FCamera.Y + FFieldSize + FFieldSize * Y);
        ftWall: Canvas.Rectangle(FCamera.X + FFieldSize * X, FCamera.Y + FFieldSize * Y, FCamera.X + FFieldSize + FFieldSize * X, FCamera.Y + FFieldSize + FFieldSize * Y);
        ftTree:
          begin
            Canvas.MoveTo(FCamera.X + FFieldSize * X + 3, FCamera.Y + FFieldSize * Y + 3);
            Canvas.LineTo(FCamera.X + FFieldSize + FFieldSize * X - 2, FCamera.Y + FFieldSize + FFieldSize * Y - 2);
            Canvas.MoveTo(FCamera.X + FFieldSize + FFieldSize * X - 3, FCamera.Y + FFieldSize * Y + 3);
            Canvas.LineTo(FCamera.X + FFieldSize * X + 2, FCamera.Y + FFieldSize + FFieldSize * Y - 2);
          end;
        ftFloor:
          begin
            Canvas.MoveTo(FCamera.X + FFieldSize * X, FCamera.Y + FFieldSize * Y);
            Canvas.LineTo(FCamera.X + FFieldSize + FFieldSize * X, FCamera.Y + FFieldSize + FFieldSize * Y);
          end;
        ftGlass:
          begin
            Canvas.MoveTo(FCamera.X + FFieldSize * X, FCamera.Y + FFieldSize * Y + FFieldSize div 2);
            Canvas.LineTo(FCamera.X + FFieldSize + FFieldSize * X, FCamera.Y + FFieldSize * Y + FFieldSize div 2);
          end;
      end;
    end;

  for i := 0 to TCustomObject.ObjectList.Count - 1 do
  begin
    Obj := TCustomObject.ObjectList[i];
    if Obj = FSelectedObj then
    begin
      Canvas.Font.Color := clRed;
      Canvas.Pen.Color := clRed;
    end
    else
    begin
      Canvas.Font.Color := clBlack;
      Canvas.Pen.Color := clBlack;
    end;

    if FFields[Obj.Position.X, Obj.Position.Y].ObjectType <> otNone then
    begin
      case FFields[Obj.Position.X, Obj.Position.Y].ObjectType of
        otStartPoint: Str := '☺';
        otButton: Str := '◙';
        otSwitch: Str := '■';
        otDoorClosed: Str := '▓';
        otDoorOpened: Str := '░';
        otSubject: Str := '₪';
        otTimer: Str := ' ҉';
        otNot: Str := '≠';
        otConsole: Str := '۩';
        otTrap: Str := '†';
        otLight: Str := '☼';
        otActionRegion:
          begin
            Canvas.Brush.Style := bsClear;
            Canvas.Pen.Style := psDot;
            Canvas.Rectangle(
              FCamera.X + FFieldSize * Obj.Position.X + FFieldSize * Obj.GetValue('Left') + 2,
              FCamera.Y + FFieldSize * Obj.Position.Y + FFieldSize * Obj.GetValue('Top') + 2,
              FCamera.X + FFieldSize * Obj.Position.X + FFieldSize * Obj.GetValue('Left') + FFieldSize * Obj.GetValue('Width') - 2,
              FCamera.Y + FFieldSize * Obj.Position.Y + FFieldSize * Obj.GetValue('Top') + FFieldSize * Obj.GetValue('height') - 2
            );
            Str := '◻';
          end;
        otIPADConsole: Str := '۩1';
        otMonster: Str := '☢';
        otCapacitor: Str := 'Tr';
        otOr: Str := 'Or';
        otDamageRegion:
          begin
            Canvas.Brush.Style := bsClear;
            Canvas.Pen.Style := psDash;
            Canvas.Rectangle(
              FCamera.X + FFieldSize * Obj.Position.X + FFieldSize * Obj.GetValue('Left') + 2,
              FCamera.Y + FFieldSize * Obj.Position.Y + FFieldSize * Obj.GetValue('Top') + 2,
              FCamera.X + FFieldSize * Obj.Position.X + FFieldSize * Obj.GetValue('Left') + FFieldSize * Obj.GetValue('Width') - 2,
              FCamera.Y + FFieldSize * Obj.Position.Y + FFieldSize * Obj.GetValue('Top') + FFieldSize * Obj.GetValue('height') - 2
            );
            Str := 'Dm';
          end;
      end;
      Canvas.TextOut(FCamera.X + FFieldSize * Obj.Position.X, FCamera.Y + FFieldSize * Obj.Position.Y, Str);
      for j := 0 to Obj.ParentList.Count - 1 do
      begin
        Canvas.MoveTo(
          FCamera.X + FFieldSize * Obj.Position.X + FFieldSize div 2,
          FCamera.Y + FFieldSize * Obj.Position.Y + FFieldSize div 2
        );
        Canvas.LineTo(
          FCamera.X + FFieldSize * Obj.ParentList[j].Position.X + FFieldSize div 2,
          FCamera.Y + FFieldSize * Obj.ParentList[j].Position.Y + FFieldSize div 2
        );
      end;
    end;
  end;
end;

function TfMain.GetTypeBrush: TTypeBrush;
begin
  if not Assigned(Tree.Selected) then
    Exit(tbNone);

  if Tree.Selected.Level = 1 then
    Result := TTypeBrush(Tree.Selected.Parent.Index + 1)
  else
    if Tree.Selected.Index = 0 then
      Result := tbJoin
    else
      if Tree.Selected.Index = 1 then
        Result := tbEdit
      else
        Result := tbNone;
end;

function TfMain.GetBrush: Integer;
begin
  if Assigned(Tree.Selected) and (Tree.Selected.Level = 1) then
    Result := Tree.Selected.Index
  else
    Result := -1;
end;

end.
