unit Trav2C;
//*******************************************************
// N-ary tree class.
//*******************************************************
// Copyright (C) 1998 John Wiley & Sons, Inc.
// All rights reserved. See additional copyright
// information in Readme.txt.
//*******************************************************

interface

uses
    Windows, Graphics, Math, Classes;

type
    String10 = String[10];
    PTrav2NodeArray = ^TTrav2NodeArray;
    TTrav2Node = class(TObject)
        private
        public
            Id                    : String10;
            ParentNode            : TTrav2Node;
            NumChildren           : Integer;
            Children              : PTrav2NodeArray;
            Position              : TPoint;

            destructor Destroy; override;
            procedure SetPosition(var xmin : Integer; ymin : Integer);
            procedure DrawNode(cvs : TCanvas; selected : TTrav2Node);
            procedure DrawSubtree(cvs : TCanvas; selected : TTrav2Node);
            function NodeAtPoint(X, Y : Integer) : TTrav2Node;
            procedure AddChild(new_parent : TTrav2Node; new_id : String);
            procedure RemoveChild(target : TTrav2Node);
            function NumNodes : Integer;
            function PreorderTraverse : String;
            function InorderTraverse : String;
            function PostorderTraverse : String;
            function BreadthFirstTraverse : String;
    end;
    TTrav2NodeArray = array [1..100000000] of TTrav2Node;

implementation

const
    WID = 40;
    HGT = 16;
    HGAP = 2;
    VGAP = 6;

// Free any children.
destructor TTrav2Node.Destroy;
var
    i : Integer;
begin
    for i := 1 to NumChildren do Children^[i].Free;
    inherited Destroy;
end;

// Set the position for the node and its descendants.
// Update xmin so it indicates the rightmost position
// used by the node and its descendants.
procedure TTrav2Node.SetPosition(var xmin : Integer; ymin : Integer);
var
    i : Integer;
begin
    Position.Y := ymin;

    if (NumChildren < 1) then begin
        // Place the node at (xmin, ymin).
        Position.X := xmin;
        xmin := xmin + WID;
    end else begin
        // Position the children.
        for i := 1 to NumChildren do
        begin
            Children^[i].SetPosition(xmin, ymin + HGT + VGAP);
            if (i < NumChildren) then xmin := xmin + HGAP;
        end;

        // Center the node over its children.
        Position.X := (
            Children^[1].Position.X +
            Children^[NumChildren].Position.X) div 2;
    end;
end;

// Draw this node.
procedure TTrav2Node.DrawNode(cvs : TCanvas; selected : TTrav2Node);
var
    rect      : TRect;
    text_size : TSize;
begin
    // Select appropriate colors.
    if (selected = Self) then
    begin
        cvs.Font.Color := clWhite;
        cvs.Brush.Color := clBlack;
    end else begin
        cvs.Font.Color := clBlack;
        cvs.Brush.Color := clWhite;
    end;

    // Erase the spot and draw a box around it.
    rect.Left   := Position.X;
    rect.Right  := Position.X + WID;
    rect.Top    := Position.Y;
    rect.Bottom := Position.Y + HGT;
    cvs.FillRect(rect);
    cvs.Rectangle(rect.Left, rect.Top, rect.Right, rect.Bottom);

    // Draw the label.
    text_size := cvs.TextExtent(Id);
    cvs.TextOut(
        (rect.Left + rect.Right - text_size.cx) div 2,
        (rect.Top + rect.Bottom - text_size.cy) div 2,
        Id);
end;

// Draw the subtree rooted at this node.
procedure TTrav2Node.DrawSubtree(cvs : TCanvas; selected : TTrav2Node);
var
    i : Integer;
begin
    // Draw this node.
    DrawNode(cvs, selected);

    // Draw the children.
    for i := 1 to NumChildren do
    begin
        Children^[i].DrawSubtree(cvs, selected);
        cvs.MoveTo(
            Position.X + WID div 2,
            Position.Y + HGT);
        cvs.LineTo(
            Children^[i].Position.X + WID div 2,
            Children^[i].Position.Y);
    end;
end;

// Find the descendant node containing this point.
// Note that this is not a very sophisticated method.
// A quadtree would be much faster.
function TTrav2Node.NodeAtPoint(X, Y : Integer) : TTrav2Node;
var
    i : Integer;
begin
    Result := nil;

    // Check this node.
    if ((Position.X <= X) and (X <= Position.X + WID) and
        (Position.Y <= Y) and (Y <= Position.Y + HGT))
    then
        Result := Self
    else begin
        // Check the children.
        for i := 1 to NumChildren do
        begin
            Result := Children^[i].NodeAtPoint(X, Y);
            if (Result <> nil) then break;
        end;
    end;
end;

// Add a child to this node.
procedure TTrav2Node.AddChild(new_parent : TTrav2Node; new_id : String);
var
    new_array : PTrav2NodeArray;
    i         : Integer;
begin
    // Make room for the new child.
    // Create the new array.
    GetMem(new_array, (NumChildren + 1) * SizeOf(TTrav2Node));

    // Copy the children into the new array.
    for i := 1 to NumChildren do
        new_array^[i] := Children^[i];

    // Free the previously allocated memory.
    if (NumChildren > 0) then FreeMem(Children);
    Children := new_array;

    // Create the new child.
    NumChildren := NumChildren + 1;
    Children^[NumChildren] := TTrav2Node.Create;
    Children^[NumChildren].Id := new_id;
    Children^[NumChildren].ParentNode := new_parent;
end;

// Remove a child from this node.
procedure TTrav2Node.RemoveChild(target : TTrav2Node);
var
    num, i : Integer;
begin
    // Find the child.
    for num := 1 to NumChildren do
    begin
        if (Children^[num] = target) then break;
    end;

    if (num > NumChildren) then
        raise EInvalidOperation.Create(
            'The target is not a child of this node.');

    // Free the child.
    Children^[num].Free;

    // Move the remaining children over to fill the hole.
    for i := num + 1 to NumChildren do
         Children^[i - 1] := Children^[i];
    Children^[NumChildren] := nil;
    NumChildren := NumChildren - 1;
end;

// Return the number of nodes below this point in the tree.
function TTrav2Node.NumNodes : Integer;
var
    i : Integer;
begin
    Result := 1;
    for i := 1 to NumChildren do
        Result := Result + Children^[i].NumNodes;
end;

// Perform a preorder traversal of the tree.
function TTrav2Node.PreorderTraverse : String;
var
    i : Integer;
begin
    Result := '';
    Result := Result + ' ' + Id;
    for i := 1 to NumChildren do
        Result := Result + Children^[i].PreorderTraverse;
end;

// Perform an inorder traversal of the tree.
function TTrav2Node.InorderTraverse : String;
var
    i, mid : Integer;
begin
    Result := '';

    // Visit the first half of the children.
    mid := (NumChildren + 1) div 2;
    for i := 1 to mid do
        Result := Result + Children^[i].InorderTraverse;

    // Visit the node.
    Result := Result + ' ' + Id;

    // Visit the rest of the children.
    for i := mid + 1 to NumChildren do
        Result := Result + Children^[i].InorderTraverse;
end;

// Perform a postorder traversal of the tree.
function TTrav2Node.PostorderTraverse : String;
var
    i : Integer;
begin
    Result := '';
    for i := 1 to NumChildren do
        Result := Result + Children^[i].PostorderTraverse;
    Result := Result + ' ' + Id;
end;

// Perform a breadth first traversal of the tree.
function TTrav2Node.BreadthFirstTraverse : String;
var
    i, oldest, next_spot : Integer;
    queue                : PTrav2NodeArray;
begin
    Result := '';

    // Make the queue array big enough to hold every
    // node in the tree.
    GetMem(queue, NumNodes * SizeOf(TTrav2Node));

    // Start with this node in the queue.
    queue^[1] := TTrav2Node.Create;
    queue^[1] := Self;
    oldest := 1;
    next_spot := 2;

    // Repeatedly process the oldest item in the queue
    // until the queue is empty.
    while (oldest < next_spot) do
    begin
        with queue^[oldest] do
        begin
            // Visit the oldest node.
            Result := Result + Id + ' ';

            // Add the node's children to the queue.
            for i := 1 to NumChildren do
            begin
                queue^[next_spot] := Children^[i];
                next_spot := next_spot + 1;
            end;
        end; // End with queue^[oldest]^ do...
        oldest := oldest + 1;
    end;

    FreeMem(queue);
end;

end.
