udiagramautolayout.pas

DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen

{  JADD - Just Another DelphiDoc: Documentation from Delphi Source Code

Copyright (C) 2004-2008   Gerold Veith
The original Sugiyama Layout was adopted from ESS-Model:
Copyright (C) 2002        Eldean AB, Peter S鰀erman, Ville Krumlinde

This file is part of JADD - Just Another DelphiDoc.

DelphiDoc is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License version 3 as
published by the Free Software Foundation.

DelphiDoc 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 this program.  If not, see <http://www.gnu.org/licenses/>.
}

unit UDiagramAutoLayout;

{Contains four classes to automatically lay-out diagrams. }

interface

uses Windows, Classes,
     UDiagram;



type


  { * * *  ***  * * *  ***   TSugiyamaLayouter   ***  * * *  ***  * * *  }


  {This class can layout diagrams. The layout is mainly based on an algorithm
   by K. Sugiyama. A good explanation of it and similar layouts can be found at
   ~[linkExtern http://www.csi.uottawa.ca/ordal/papers/sander/main.html].~[br]
   This class is based on the Sugiyama-Layout in
   ~[linkExtern http://essmodel.sourceforge.net/ ESS-Model]. }
  TSugiyamaLayouter = class(TDiagramLayouter)
  private
    //the list of nodes to sort; type ~[link PSortNode]
    FNodes: TList;
    //the list of nodes to sort; type TList of ~[link PSortNode]
    FLayers: TList;




    //Extracts the boxes of the diagram to nodes in a graph to sort it.
    procedure ExtractNodes(Boxes: TBoxList);




    //first phase: creating layers

    //Makes the graph acyclic to be used by this algorithm.
    procedure RemoveCycles;
    //Topologically orders the nodes so that all dependancies point forward in
    //the list.
    procedure TopologicalOrder;
    //Orders the nodes with a topological sort algorithm and ranks them.
    procedure InitialRanking;
    //Inserts dummy-nodes so that each edge is of length one.
    procedure MakeProper;
    //Creates layers and assign each node to a layer.
    procedure LayeringPhase;



    //second phase: sorting within layers

    //Calculates the number of crossings of edges between two adjacent layers.
    function CalcCrossingsTwoLayers(Layer1, Layer2: TList): Integer;
    //Calculates the number of crossings of edges between all layers.
    function CalcCrossings: Integer;
    //Sorts the nodes within each layer to generate minimal crossings of edges.
    procedure OrderingPhase;



    //third phase: positioning

    //Calculates the vertical positions of all layers.
    procedure SetYPositions;

    //Optimizes the horizontal positions of the nodes.
    function OptimizeHorizontalPositions(Spacing: Integer): Integer;
    //Calculates horizontal positions of the boxes within the layers.
    procedure SetXPositions;




    //Assigns the new layout by setting the boxes to their new positions.
    procedure ApplyNodes;



  public
    //Creates the object to layout the diagram.
    constructor Create(Diagram: TDiagram); override;
    //Frees the object and internal lists.
    destructor Destroy; override;


    //Lay-outs the diagram.
    procedure Execute(Boxes: TBoxList); override;
  end;







  { * * *  ***  * * *  ***   TSimpleClassLayouter   ***  * * *  ***  * * *  }

  {This class can layout diagrams of classes. The layout is very simple. }
  TSimpleClassLayouter = class(TDiagramLayouter)
  protected
    //margin (i.e. horizontal and vertical spacing) between boxes when placing
    //them
    FMargin: TPoint;

    //Checks whether the box (class) has no parent.
    function NoParent(Box: TBox): Boolean;

    //Checks whether the box (class) has no sub-classes.
    function NoChildren(Box: TBox): Boolean;

    //Gets all sub-classes of the box (class).
    procedure GetChildren(Box: TBox; ChildrenList: TList);

    //Positions all boxes in the diagram recursively.
    procedure SetPositionTree(Boxes: TList; var XPos: Integer; YPos: Integer;
                              MinWidth: Integer);


    //Returns, if the column should be wrapped at that box.
    function VerticalBreakAtBox(Box: TBox): Boolean; virtual;
    //Post-processes the simple lay-out to optimize it.
    procedure PostProcess(BaseClasses: TList); virtual;
  public
    //Lay-outs the diagram of classes.
    procedure Execute(Boxes: TBoxList); override;
  end;


  { * * *  **  * * *  **  TPostOptimizingClassLayouter  **  * * *  **  * * *  }

  {This class can layout diagrams of classes. The layout is very simple but
   tries to optimize it. }
  TPostOptimizingClassLayouter = class(TSimpleClassLayouter)
  private
    //the list of the boxes (of classes) where a vertical breaks of the columns
    //should occur
    FVerticalBreaks: TList;


    //width of the whole diagram
    FWidth: Integer;
    //height of the diagram only with boxes with children, i.e. the minimal
    //height of the diagram
    FParentsHeight: Integer;
    //height of the diagram
    FNoChildrenHeight: Integer;
    //maximum top position of all boxes
    FMaximalBoxHeight: Integer;


    //Acquires different maximum values of all boxes.
    procedure CheckPositions(Boxes: TList);
    //Calculates the vertical column-breaks.
    procedure AddColumnBreaks(Boxes: TList);

    //Post-optimizes the layout of the diagram of classes by calculating
    //vertical column-breaks.
    function CalculateVerticalBreaks(BaseClassBoxes: TList): Boolean;
  protected
    //Returns, if the column should be wrapped at that box.
    function VerticalBreakAtBox(Box: TBox): Boolean; override;
    //Post-processes the simple lay-out to optimize it.
    procedure PostProcess(BaseClasses: TList); override;
  public
  end;




  { * * *  ***  * * *  ***   TSimpleFileLayouter   ***  * * *  ***  * * *  }

  {This class can layout diagrams of files. The layout is very simple. }
  TSimpleFileLayouter = class(TDiagramLayouter)
  private
    //the list of boxes of files
    FBoxes: TBoxList;
    //scores of boxes to determine the position (level) in the layout
    FScore: array of Integer;
    //mark for boxes on same level; for the last box on a level this is true
    FBreaks: array of Boolean;
    //the list of files sorted by their score
    FSorted: array of TBox;

    //Gets the index of a box.
    function GetBoxIndex(Box: TBox): Integer;
    //Calculates the scores of the files.
    procedure CalculateScore;
    //Sorts the files by their scores and calculates the files tro break to the
    //next level.
    procedure SortAndCalculateLevelBreaks;
    //Calculates the maximum needed width of the levels.
    function CalculateMaximalLevelWidth: Integer;
    //Sets the new lay-out of the diagram.
    procedure SetNewLayout(MaxWidth: Integer);

  public
    //Lay-outs the diagram of files.
    procedure Execute(Boxes: TBoxList); override;
  end;





implementation

uses SysUtils, Math,
     UPascalConsts;




   {   ******************     SugiyamaLayout     ******************   }





  { * * *  ***  * * *  ***   TSortNode   ***  * * *  ***  * * *  }

      //width of internal nodes to insert horizontal space
const DummyWidth = 50;

type

  //pointer to a node (of a box) in the layout
  PSortNode = ^TSortNode;

  //the data of a node (a box) in the diagram while layouting it
  TSortNode = object
    //the box the node is about; may be nil for dummy nodes
    Box: TBox;

    //list of other nodes that are associated with this node
    InEdges: TList;
    //list of other nodes this node is associated with
    OutEdges: TList;

    //rank for topoligical order
    TopoOrderLabel: Integer;

    //index in nodes-list, must be updated when node changes position
    //(after re-sort)
    Id: Integer;

    //rank (for layers, vertical) of the node, depending on the number of
    //associations to this node, and the rank of the other boxes
    Rank: Integer;
    //order of the node inside its layer
    Order: Integer;
    //order of the node inside its layer to minimize crossings of association
    //arrows
    COrder: Integer;
    //weight to order the nodes inside their layer to minimize crossings of
    //association arrows
    Weight: Double;

    //calculated position of the box
    X, Y: Integer;

    //Returns the width of the box (checks whether it is a dummy box).
    function GetWidth: Integer;
    //Frees this node.
    procedure FreeNode;
  end;

//Creates a new entry for a node.
function CreateNewNode: PSortNode; forward;















  { * * *  ***  * * *  ***   TSortNode   ***  * * *  ***  * * *  }


{Creates a new entry for a node.
~result the new node }
function CreateNewNode: PSortNode;
begin
 New(Result);                             //create the new node
 try
   FillChar(Result^, SizeOf(Result^), 0); //initialize it
   try
     Result.InEdges := TList.Create;      //create both lists for edges
     Result.OutEdges := TList.Create;
   except;
     Result.InEdges.Free;
     Result.OutEdges.Free;
     raise;
   end;
 except;
   Dispose(Result);
   raise;
 end;
end;




{Returns the width of the box (checks whether it is a dummy box).
~result the width of the box or a default value for dummies }
function TSortNode.GetWidth: Integer;
begin
 if assigned(Box) then          //node of a box in the diagram?
  Result := Box.Size.x            //return its width
 else
  Result := DummyWidth;           //return the width of a dummy node
end;

{Frees this node. }
procedure TSortNode.FreeNode;
begin
 InEdges.Free;                    //free both lists for edges
 OutEdges.Free;

 Dispose(@Self);                  //free this object
end;












  { * * *  ***  * * *  ***   TSugiyamaLayouter   ***  * * *  ***  * * *  }


{Creates the object to layout the diagram.
~param Diagram the diagram to layout }
constructor TSugiyamaLayouter.Create(Diagram: TDiagram);
begin
 inherited Create(Diagram);      //create the object

 FNodes := TList.Create;         //create lists for nodes and layers
 FLayers := TList.Create;
end;


{Frees the object and internal lists. }
destructor TSugiyamaLayouter.Destroy;
var        i              :Integer;    //counter through the lists
begin
 if assigned(FNodes) then
  for i := 0 to FNodes.Count - 1 do      //for each node
   PSortNode(FNodes[i]).FreeNode;          //free it
 FNodes.Free;                          //free the list

 if assigned(FLayers) then
  for i := 0 to FLayers.Count - 1 do     //for each layer
   TList(FLayers[i]).Free;                 //free it
 FLayers.Free;                         //free the list