Simba/Projects/SAMufasaGUI/colourhistory.pas

{
	This file is part of the Mufasa Macro Library (MML)
	Copyright (c) 2009 by Raymond van Venetië and Merlijn Wajer

    MML is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    MML is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with MML.  If not, see <http://www.gnu.org/licenses/>.

	See the file COPYING, included in this distribution,
	for details about the copyright.

    Colour History window for Mufasa Macro Library
}
unit colourhistory;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,MufasaBase,
  ComCtrls, StdCtrls, ExtCtrls, Menus,  DOM, XMLWrite, XMLRead;

type
  TColourPickerObject = class(TObject)
          constructor Create(C: Integer; P: TPoint; N: String);
          destructor Destroy; override;

        public
          Colour: Integer;
          Pos: TPoint;
          Name: String;
  end;

  { TColourHistoryForm }

  TColourHistoryForm = class(TForm)
    CH_RGB_Label: TLabel;
    CHImages: TImageList;
    CHMainMenu: TMainMenu;
    CHFile: TMenuItem;
    CHHelp: TMenuItem;
    CHClear: TMenuItem;
    CHLoad: TMenuItem;
    CHSave: TMenuItem;
    CHAbout: TMenuItem;
    OkButton: TButton;
    ColourValue: TEdit;
    CoordValue: TLabel;
    ColourImage: TImage;
    CHOpenDialog: TOpenDialog;
    PickNewColourButton: TButton;
    DeleteButton: TButton;
    CHSaveDialog: TSaveDialog;
    SelectionName: TEdit;
    ColourTree: TTreeView;
    procedure CHAboutClick(Sender: TObject);
    procedure ChangeName(Sender: TObject);
    procedure CHClearClick(Sender: TObject);
    procedure CHLoadClick(Sender: TObject);
    procedure ColourTreeChange(Sender: TObject; Node: TTreeNode);
    procedure ColourTreeDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure ColourTreeDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure DeleteSelected(Sender: TObject);
    procedure AddColObj(c: TColourPickerObject; autoName: Boolean);


    procedure CHSaveClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure OkButtonClick(Sender: TObject);
    procedure SelectionNameKeyPress(Sender: TObject; var Key: char);
    procedure SetCHShowMenu(Sender: TObject);
    procedure UnSetCHShowMenu(Sender: TObject);
  private
    TreeChanged: Boolean;
    { private declarations }
  protected
    procedure AddColObj(c: TColourPickerObject);
    procedure SetNodeBitmap(N: TTreeNode);
    procedure SaveToXML(s: String);
    procedure XML2Tree(XMLDoc: TXMLDocument);
  public
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
  public
    IndexSelected: Integer;
    { public declarations }
  end; 



var
  ColourHistoryForm: TColourHistoryForm;

implementation
uses
  colour_conv, TestUnit, lclintf, lcltype;

constructor TColourPickerObject.Create(C: Integer; P: TPoint; N: String);
begin
  inherited Create;
  Self.Colour := C;
  Self.Pos := P;
  Self.Name:= N;
end;

destructor TColourPickerObject.Destroy;
begin

  inherited Destroy;
end;

{ TColourHistoryForm }

procedure TColourHistoryForm.AddColObj(c: TColourPickerObject; autoName: Boolean);
begin
  if autoName then
  begin
    // TODO: Proper name
    c.Name := IntToStr(c.Colour);
  end;
  Self.AddColObj(c);
end;

procedure TColourHistoryForm.SetNodeBitmap(N: TTreeNode);
var
  bmp: TBitmap;
begin
  bmp:=TBitmap.Create;
  bmp.SetSize(16,16);
  if(Assigned(n.Data)) then
    bmp.Canvas.Brush.Color:=TColourPickerObject(n.Data).Colour;
  bmp.Canvas.Rectangle(0,0,16,16);

  n.ImageIndex:=CHImages.Add(bmp, nil);
  n.SelectedIndex:=n.ImageIndex;

  bmp.Free;
end;

procedure TColourHistoryForm.AddColObj(c: TColourPickerObject);

var
   it: TTreeNode;

begin
  TreeChanged:=True;
  it := ColourTree.Items.Add(nil, c.Name);
  it.Data := c;
  ColourTree.Selected := it;
  SetNodeBitmap(it);
end;

procedure WalkDeleteTree(Node: TTreeNode; Img: TImageList);
var
   N: TTreeNode;

begin
  N := Node.GetFirstChild;

  while assigned(n) do
  begin
    If Assigned(N.Data) then
      TColourPickerObject(N.Data).Free;
    mDebugLn('Deleting ImageIndex: ' + IntToStr(n.ImageIndex) + '; Text: ' + N.Text);

    // yeah....
    try
      if n.ImageIndex <> -1 Then
        Img.Delete(n.ImageIndex);
    except end;

    WalkDeleteTree(n, img);
    n := n.GetNextSibling;
  end;
end;

procedure TColourHistoryForm.DeleteSelected(Sender: TObject);

var
   e: TTreeNodesEnumerator;

begin
  if (Assigned(ColourTree.Selected)) then
  begin
    if Assigned(ColourTree.Selected.Data) then
      TColourPickerObject(ColourTree.Selected.Data).Free;

    WalkDeleteTree(ColourTree.Selected, CHImages);

    mDebugLn('Deleting ImageIndex: ' + IntToStr(ColourTree.Selected.ImageIndex) + '; Text: ' + ColourTree.Selected.Text);
    if ColourTree.Selected.ImageIndex <> -1 then
      CHImages.Delete(ColourTree.Selected.ImageIndex);

    ColourTree.Selected.Delete;
    TreeChanged := True;

    { Now, we have to recreate all images and their indices... Since the TImageList
      fiddles with it's indices if one is deleted... Wtf? }
    CHImages.Clear;

    e := ColourTree.Items.GetEnumerator;
    while e.MoveNext do
      SetNodeBitmap(e.Current);
  end;
end;

procedure WriteXMLData(n: TTreeNode;
                       XMLNode: TDOMNode; XMLDoc: TXMLDocument;
                       var XMLChild: TDOMNode; var C: Integer);

var
   DDataNode, DataNode, Data: TDOMNode;

begin
  XMLChild := XMLDoc.CreateElement('Item' + IntToStr(C));
  Inc(C);
  XMLNode.AppendChild(XMLChild);


  DDataNode := XMLDoc.CreateElement('Data');
  XMLChild.AppendChild(DDataNode);

  DataNode := XMLDoc.CreateElement('Name');
  DDataNode.AppendChild(DataNode);
  Data := XMLDoc.CreateTextNode(TColourPickerObject(n.Data).Name);
  DataNode.AppendChild(Data);
  DataNode := XMLDoc.CreateElement('Colour');
  DDataNode.AppendChild(DataNode);
  Data := XMLDoc.CreateTextNode(IntToStr(TColourPickerObject(n.Data).Colour));
  DataNode.AppendChild(Data);

  DataNode := XMLDoc.CreateElement('CoordX');
  DDataNode.AppendChild(DataNode);
  Data := XMLDoc.CreateTextNode(IntToStr(TColourPickerObject(n.Data).Pos.X));
  DataNode.AppendChild(Data);
  DataNode := XMLDoc.CreateElement('CoordY');
  DDataNode.AppendChild(DataNode);
  Data := XMLDoc.CreateTextNode(IntToStr(TColourPickerObject(n.Data).Pos.Y));
  DataNode.AppendChild(Data);
end;

procedure WalkTree(Node: TTreeNode; XMLNode: TDOMNode; XMLDoc: TXMLDocument;
                   var C: Integer);
var
   N: TTreeNode;
   XMLChild, DDataNode, DataNode, Data: TDOMNode;

begin
  N := Node.GetFirstChild;

  while assigned(n) do
  begin
    WriteXMLData(n, XMLNode, XMLDoc, XMLChild, C);

    WalkTree(n, XMLChild, XMLDoc, C);
    n := n.GetNextSibling;
  end;
end;

procedure TColourHistoryForm.SaveToXML(s: String);
var
   XMLDoc: TXMLDocument;
   RootNode, XMLChild: TDOMNode;
   C, i: Integer;

begin
  XMLDoc := TXMLDocument.Create;

  RootNode := XMLDoc.CreateElement('Tree');
  XMLDoc.AppendChild(RootNode);

  RootNode := XMLDoc.DocumentElement;

  C := 0;

  mDebugLn(inttostr(Colourtree.Items.TopLvlCount));
  for i := 0 to Colourtree.Items.TopLvlCount -1 do
  begin
    WriteXMLData(ColourTree.Items.TopLvlItems[i], RootNode, XMLDoc, XMLChild, C);
    WalkTree(ColourTree.Items.TopLvlItems[i], XMLChild, XMLDoc, C);
  end;

  WriteXMLFile(XMLDoc, s);

  XMLDoc.Free;
end;

procedure TColourHistoryForm.ColourTreeChange(Sender: TObject; Node: TTreeNode);
var
   r,g,b:integer;
begin
  if not Assigned(Node) then
    exit;
  if not Node.Selected then
    exit;

  { This only occurs when we have manually added an item with the Form Editor }
  if not Assigned(Node.Data) then
    exit;

  colour_conv.ColorToRGB(TColourPickerObject(Node.Data).Colour, r, g, b);

  { Change Form Text / Values }
  ColourValue.Caption := IntToStr(TColourPickerObject(Node.Data).Colour);
  CoordValue.Caption := 'Coords: ' + IntToStr(TColourPickerObject(Node.Data).Pos.X) +
                        ', ' + IntToStr(TColourPickerObject(Node.Data).Pos.Y);
  SelectionName.Text := TColourPickerObject(Node.Data).Name;

  CH_RGB_Label.Caption:=Format('RGB:%d,%d,%d', [r,g,b]);

  { Draw the Image }
  ColourImage.Canvas.Brush.Color := TColourPickerObject(Node.Data).Colour;
  ColourImage.Canvas.Rectangle(0,0,ColourImage.Width, ColourImage.Height);

  if Self.Visible then
  begin
    try
      SelectionName.SetFocus;
    finally
    end;
  end;
end;

procedure TColourHistoryForm.ColourTreeDragDrop(Sender, Source: TObject; X,
  Y: Integer);
Var
   Node: TTreeNode;

begin
  if Sender <> ColourTree then
    Exit;
  Node := ColourTree.GetNodeAt(X, Y);
  if not assigned(ColourTree.Selected) then
  begin
    mDebugLn('No valid node is currently selected');
    exit;
  end;

  if not assigned(Node) then
  begin
    ColourTree.Selected.MoveTo(nil, naAdd);
    TreeChanged:=True;
    exit;
  end;
  ColourTree.Selected.MoveTo(Node, naAddChild);
  TreeChanged:=True;
  mDebugLn('Dragging from: ' + ColourTree.Selected.Text);
  mDebugLn('Dragging to: ' + Node.Text);
end;

procedure TColourHistoryForm.ColourTreeDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);

begin
  Accept:=True;
end;

procedure TColourHistoryForm.ChangeName(Sender: TObject);
begin
  if not Assigned(ColourTree.Selected) then
  begin
    mDebugLn('We double clicked but have nothing Selected?');
    exit;
  end;
  ColourTree.Selected.Text := SelectionName.Text;
  TColourPickerObject(ColourTree.Selected.Data).Name := SelectionName.Text;
end;

procedure TColourHistoryForm.CHClearClick(Sender: TObject);
begin
  TreeChanged:=False;
  ColourTree.BeginUpdate;
    ColourTree.Items.Clear;
    CHImages.Clear;
  ColourTree.EndUpdate;
end;

//heavily modded from http://wiki.lazarus.freepascal.org/XML_Tutorial
procedure TColourHistoryForm.XML2Tree(XMLDoc: TXMLDocument);
var
  iNode: TDOMNode;

  procedure ProcessNode(Node: TDOMNode; TreeNode: TTreeNode);
  var
    cNode, dNode: TDOMNode;
    OP: TColourPickerObject;
    pos: TPoint;
    Colour: Integer;
    Name: String;

  begin
    if Node = nil then Exit;

    If Node.NodeName = 'Data' Then
      exit;

    TreeNode := ColourTree.Items.AddChild(TreeNode, 'ERROR');
    mDebugLn(Node.NodeName);
    cNode := Node.FindNode('Data');
    if Assigned(cNode) then
    begin
      dNode := cNode.FindNode('Name');
      if assigned(dNode) then
        Name := dNode.TextContent
      else
        Name := 'Error';
      dNode := cNode.FindNode('Colour');
      if assigned(dNode) then
        Colour := StrToIntDef(dNode.TextContent, -1);

      dNode := cNode.FindNode('CoordX');
      if assigned(dNode) then
        Pos.X := StrToIntDef(dNode.TextContent, -1);

      dNode := cNode.FindNode('CoordY');
      if assigned(dNode) then
        Pos.Y := StrToIntDef(dNode.TextContent, -1);

      OP := TColourPickerObject.Create(Colour, Pos, Name);
      TreeNode.Text := Name;
      TreeNode.Data := Pointer(OP);

      SetNodeBitmap(TreeNode);
    end;

    // Goes to the child node
    cNode := Node.FirstChild;

    // Processes all child nodes
    while cNode <> nil do
    begin
      ProcessNode(cNode, TreeNode);
      cNode := cNode.NextSibling;
    end;
  end;

begin
  iNode := XMLDoc.DocumentElement.FirstChild;
  while iNode <> nil do
  begin
    ProcessNode(iNode, nil); // Recursive
    iNode := iNode.NextSibling;
  end;
end;


procedure TColourHistoryForm.CHLoadClick(Sender: TObject);

var
   XMLDoc: TXMLDocument;

begin
  if TreeChanged then
  begin
    case MessageBox(0,pchar('Do you want to save the colours?'), Pchar('Colours have been modified.'),
                    MB_YESNOCANCEL or MB_ICONQUESTION) of
        IDCANCEL :
              Exit;
        IDYES :
            begin
              if CHSaveDialog.Execute then
                ColourTree.SaveToFile(CHSaveDialog.FileName)
              else
                Exit;
            end;
    end;
  end;

  if CHOpenDialog.Execute then
    if FileExists(CHOpenDialog.FileName) then
    begin
      ReadXMLFile(XMLDoc, CHOpenDialog.FileName);

      // Clear Tree and Images
      ColourTree.BeginUpdate;
        ColourTree.Items.Clear;
        CHImages.Clear;
        XML2Tree(XMLDoc);
      ColourTree.EndUpdate;
      TreeChanged:=False;
      XMLDoc.Free;
    end;
end;

procedure TColourHistoryForm.CHAboutClick(Sender: TObject);
begin

end;

constructor TColourHistoryForm.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);

  PickNewColourButton.OnClick:= @Form1.ButtonPickClick;
end;

destructor TColourHistoryForm.Destroy;
begin
  PickNewColourButton.OnClick := nil;

  inherited Destroy;
end;

procedure TColourHistoryForm.CHSaveClick(Sender: TObject);

begin
   if CHSaveDialog.Execute then
  begin
    SaveToXML(CHSaveDialog.FileName);
    TreeChanged:=False;
  end;
end;

procedure TColourHistoryForm.FormCreate(Sender: TObject);
begin
  TreeChanged:=False;
end;

procedure TColourHistoryForm.OkButtonClick(Sender: TObject);
begin
  Self.Close;
end;

procedure TColourHistoryForm.SelectionNameKeyPress(Sender: TObject;
  var Key: char);
begin
  if key = #13 then
  begin
    key := #0;
    Self.close;
  end;
end;

procedure TColourHistoryForm.SetCHShowMenu(Sender: TObject);
begin
  Form1.MenuItemColourHistory.Checked := True;
end;

procedure TColourHistoryForm.UnSetCHShowMenu(Sender: TObject);
begin
  Form1.MenuItemColourHistory.Checked := False;
end;

initialization
  {$R *.lfm}

end.