World of Shareware - Software Farm 2/wosw_2.zip/wosw_2/CPROG/DDJ1289.ZIP/KIENLE.LST

File List | 1989-10-30 | 19KB | 713 lines

_NETWORK GRAPHS IN OBJECT PASCAL_
by Steven Kienle


[LISTING ONE]

TYPE
    GraphNode =
        OBJECT(TObject)
            Next: GraphNode;
            HotRegion: RgnHandle;

            PROCEDURE Initialize;
                { Drawing Methods }
            PROCEDURE Draw;
            PROCEDURE DrawAll;
            PROCEDURE Erase;
            PROCEDURE EraseAll;
                { Location Methods }
            PROCEDURE SetRegion;
            FUNCTION PtInNode(Where: Point): Boolean;
            FUNCTION FindNode(Where: Point): GraphNode;
            FUNCTION Connected(Which: GraphNode): Boolean;
            FUNCTION FindConnected(Which: GraphNode): GraphNode;
                { Freeing Methods }
            PROCEDURE Free; OVERRIDE;
            PROCEDURE FreeAll;
        END;

    GraphList =
        OBJECT(TObject)
            FirstNode: GraphNode;
            PROCEDURE Initialize;
                { Drawing Methods }
            PROCEDURE Erase;
            PROCEDURE Draw;
                { GraphList Manipulation Methods }
            PROCEDURE AddNode(Which: GraphNode);
            PROCEDURE RemoveNode(Which: GraphNode);
                { Location Methods }
            FUNCTION FindNode(Where: Point): GraphNode;
            FUNCTION FindConnected(Which: GraphNode): GraphNode;
                { Freeing Methods }
            PROCEDURE Free; OVERRIDE;
        END;

    Vertex =
        OBJECT(GraphNode)
            Center: Point; { Location of Vertex }
            PROCEDURE Initialize; OVERRIDE;
                { Drawing Methods }
            PROCEDURE Draw; OVERRIDE;
            PROCEDURE Erase; OVERRIDE;
                { Location Methods }
            PROCEDURE SetRegion; OVERRIDE;
            PROCEDURE SetCenter(thePoint: Point);
        END;

    Edge =
        OBJECT(GraphNode)
            FromVertex: Vertex; { End Points of Edge }
            ToVertex: Vertex;
            PROCEDURE Initialize; OVERRIDE;
                { Drawing Methods }
            PROCEDURE Draw; OVERRIDE;
            PROCEDURE Erase; OVERRIDE;
                { Location Methods }
            PROCEDURE SetRegion; OVERRIDE;
            FUNCTION Connected(Which: GraphNode): Boolean;
OVERRIDE;
            PROCEDURE Edge.SetFrom(Which: Vertex);
            PROCEDURE Edge.SetTo(Which: Vertex);
        END;

    Graph =
        OBJECT(TObject)
            VertexList: GraphList;
            EdgeList: GraphList;
            PROCEDURE Initialize;
                { Drawing Methods }
            PROCEDURE Draw;
            PROCEDURE Erase;
                { Manipulation Routines }
            PROCEDURE AddVertex(Where: Point);
            PROCEDURE AddEdge(FromWhich, ToWhich: Vertex);
            PROCEDURE RemoveVertex(Where: Point);
            PROCEDURE RemoveEdge(Where: Point);
            PROCEDURE SetVertexCenter
                      (Which: Vertex; Where: Point);
                { Macintosh Support Routines }
            PROCEDURE MoveVertex(Start: Point);
            PROCEDURE LinkVertices(Start: Point);
                { Freeing Method }
            PROCEDURE Free; OVERRIDE;
        END;

{ -------------- GraphNode Methods -------------- }
PROCEDURE GraphNode.Initialize;
    BEGIN
        SELF.Next := NIL;
        SELF.HotRegion := NIL;
    END;

PROCEDURE GraphNode.Draw;
    BEGIN
    END;

PROCEDURE GraphNode.DrawAll;
    BEGIN
        IF SELF.Next <> NIL THEN
            SELF.Next.DrawAll; { Draw next GraphNode }
        SELF.Draw; { Draw this GraphNode }
    END;

PROCEDURE GraphNode.Erase;
    BEGIN
    END;

PROCEDURE GraphNode.EraseAll;
    BEGIN
        IF SELF.Next <> NIL THEN
            SELF.Next.EraseAll; { Erase next GraphNode }
        SELF.Erase; { Erase this GraphNode }
    END;

PROCEDURE GraphNode.SetRegion;
    BEGIN
        IF SELF.HotRegion <> NIL THEN { Drop old Region }
            DisposeRgn(SELF.HotRegion);
        SELF.HotRegion := NewRgn; { Allocate a new one }
    END;

FUNCTION GraphNode.PtInNode(Where: Point): Boolean;
    BEGIN
        IF PtInRgn(Where, SELF.HotRegion) THEN
            PtInNode := True
        ELSE
            PtInNode := False;
    END;

FUNCTION GraphNode.FindNode(Where: Point): GraphNode;
    BEGIN
        IF SELF.PtInNode(Where) THEN { It's here }
            FindNode := SELF
        ELSE IF SELF.Next = NIL THEN { There are none }
            FindNode := NIL
        ELSE { Try the Next }
            FindNode := SELF.Next.FindNode(Where);
    END;

FUNCTION GraphNode.Connected(Which: GraphNode): Boolean;
    BEGIN
        Connected := False;
    END;

FUNCTION GraphNode.FindConnected(Which: GraphNode): GraphNode;
    BEGIN
        IF SELF.Connected(Which) THEN { Is this connected }
            FindConnected := SELF
        ELSE IF SELF.Next = NIL THEN { There are none }
            FindConnected := NIL
        ELSE { Try the Next }
            FindConnected := SELF.Next.FindConnected(Which);
    END;

PROCEDURE GraphNode.Free;
    BEGIN
        IF SELF.HotRegion <> NIL THEN { Free Region Space }
            DisposeRgn(SELF.HotRegion);
        SELF.Erase; { Erase then Free }
        INHERITED Free;
    END;

PROCEDURE GraphNode.FreeAll;
    BEGIN
        IF SELF.Next <> NIL THEN { Free the next GraphNode }
            SELF.Next.FreeAll;
        SELF.Free; { Then Free this GraphNode }
    END;

{ -------------- GraphList Methods -------------- }
PROCEDURE GraphList.Initialize;
    BEGIN
        SELF.FirstNode := NIL;
    END;

PROCEDURE GraphList.Erase;
    BEGIN
        IF SELF.FirstNode <> NIL THEN
            SELF.FirstNode.EraseAll; { Erase the GraphList }
    END;

PROCEDURE GraphList.Draw;
    BEGIN
        IF SELF.FirstNode <> NIL THEN
            SELF.FirstNode.DrawAll; { Draw the GraphList }
    END;

PROCEDURE GraphList.AddNode(Which: GraphNode);
    BEGIN
        Which.Next := SELF.FirstNode; { Link Which in GraphList }
        SELF.FirstNode := Which;
    END;

PROCEDURE GraphList.RemoveNode(Which: GraphNode);
    VAR
        Check: GraphNode;
    BEGIN
        { If it is the head GraphNode, relink the Head }
        IF SELF.FirstNode = Which THEN
            SELF.FirstNode := Which.Next
        ELSE BEGIN
            { Otherwise look for Which GraphNode }
            Check := SELF.FirstNode;
            WHILE (Check <> NIL) DO BEGIN
                { If Which is found, remove it from GraphList }
                IF Check.Next = Which THEN
                    Check.Next := Which.Next;
                Check := Check.Next;
            END;
        END;

        Which.Free; { Free this node }
    END;

FUNCTION GraphList.FindNode(Where: Point): GraphNode;
    BEGIN { Find the Node at this location }
        IF SELF.FirstNode <> NIL THEN
            FindNode := SELF.FirstNode.FindNode(Where)
        ELSE
            FindNode := NIL;
    END;

FUNCTION GraphList.FindConnected(Which: GraphNode): GraphNode;
    BEGIN { Find the Node connected to this one }
        IF SELF.FirstNode <> NIL THEN
            FindConnected := SELF.FirstNode.FindConnected(Which)
        ELSE
            FindConnected := NIL;
    END;

PROCEDURE GraphList.Free;
    BEGIN
        IF SELF.FirstNode <> NIL THEN
            SELF.FirstNode.FreeAll; { Free the Nodes }
        INHERITED Free; { Free GraphList }
    END;

{ -------------- Vertex Methods -------------- }
PROCEDURE Vertex.Initialize;
    BEGIN
        INHERITED Initialize;
        SELF.Center.h := 0;
        SELF.Center.v := 0;
    END;

PROCEDURE Vertex.Draw;
    VAR
        theRect: Rect;
    BEGIN
        SELF.Erase; { Erase Vertex Area }
        { Set up Rectangle }
        theRect.top := SELF.Center.v - 10;
        theRect.left := SELF.Center.h - 10;
        theRect.bottom := SELF.Center.v + 10;
        theRect.right := SELF.Center.h + 10;
        { Draw Vertex }
        FrameOval(theRect);
    END;

PROCEDURE Vertex.Erase;
    VAR
        theRect: Rect;
    BEGIN
        { Set up Rectangle }
        theRect.top := SELF.Center.v - 10;
        theRect.left := SELF.Center.h - 10;
        theRect.bottom := SELF.Center.v + 10;
        theRect.right := SELF.Center.h + 10;
        { Erase Vertex }
        EraseOval(theRect);
    END;

PROCEDURE Vertex.SetRegion;
    BEGIN
        INHERITED SetRegion; { Do default processing }
        OpenRgn; { Create new region area }
        SELF.Draw;
        CloseRgn(SELF.HotRegion);
    END;

PROCEDURE Vertex.SetCenter(thePoint: Point);
    BEGIN
        SELF.Erase; { Erase Vertex at old Center }
        SELF.Center := thePoint; { Set the Center }
        SELF.Draw; { Draw Vertex at new Center }
        SELF.SetRegion; { Reset HotRegion }
    END;

{ -------------- Edge Methods -------------- }
PROCEDURE Edge.Initialize;
    BEGIN
        INHERITED Initialize;
        FromVertex := NIL;
        ToVertex := NIL;
    END;

PROCEDURE Edge.Draw;
    VAR
        Where: Point;
    BEGIN
        IF (SELF.FromVertex <> NIL) AND (SELF.ToVertex <> NIL) THEN
BEGIN
            { Start in center of FromVertex }
            Where := SELF.FromVertex.Center;
            MoveTo(Where.h, Where.v);
            { Draw line to center of ToVertex }
            Where := SELF.ToVertex.Center;
            LineTo(Where.h, Where.v);
        END;
    END;

PROCEDURE Edge.Erase;
    VAR
        pnState: PenState;
    BEGIN
        GetPenState(pnState); { Save current settings }
        PenPat(white); { Set color & Draw to erase }
        SELF.Draw;
        SetPenState(pnState); { Reset settings }
        SELF.FromVertex.Draw; { Redraw affected Vertices }
        SELF.ToVertex.Draw;
    END;

PROCEDURE Edge.SetRegion;
    BEGIN
        INHERITED SetRegion; { Do default processing }
        OpenRgn; { Create new region area }
            MoveTo(SELF.FromVertex.Center.h + 4,
SELF.FromVertex.Center.v + 4);
        LineTo(SELF.ToVertex.Center.h + 4, SELF.ToVertex.Center.v + 4);
        LineTo(SELF.ToVertex.Center.h - 4, SELF.ToVertex.Center.v - 4);
            LineTo(SELF.FromVertex.Center.h - 4,
SELF.FromVertex.Center.v - 4);
            LineTo(SELF.FromVertex.Center.h + 4,
SELF.FromVertex.Center.v + 4);
        CloseRgn(SELF.HotRegion);
    END;

FUNCTION Edge.Connected(Which: GraphNode): Boolean;
    BEGIN
        IF (SELF.FromVertex = Which) OR (SELF.ToVertex = Which) THEN
            Connected := True
        ELSE
            Connected := False;
    END;

PROCEDURE Edge.SetFrom(Which: Vertex);
    BEGIN
        IF (SELF.FromVertex <> NIL) AND (SELF.ToVertex <> NIL) THEN
BEGIN
            { Erase old edge and redraw unlinked Vertex }
            SELF.Erase;
            SELF.FromVertex.Draw;
        END;
        SELF.FromVertex := Which;
        IF (SELF.FromVertex <> NIL) AND (SELF.ToVertex <> NIL) THEN
BEGIN
            { Draw new edge and redraw linked Vertices }
            SELF.Draw;
            SELF.FromVertex.Draw;
            SELF.ToVertex.Draw;
            SELF.SetRegion; { Reset HotRegion }
        END;
    END;

PROCEDURE Edge.SetTo(Which: Vertex);
    BEGIN
        IF (SELF.FromVertex <> NIL) AND (SELF.ToVertex <> NIL) THEN
BEGIN
            { Erase old edge and redraw unlinked Vertex }
            SELF.Erase;
            SELF.ToVertex.Draw;
        END;
        SELF.ToVertex := Which;
        IF (SELF.FromVertex <> NIL) AND (SELF.ToVertex <> NIL) THEN
BEGIN
            { Draw new edge and redraw linked Vertices }
            SELF.Draw;
            SELF.FromVertex.Draw;
            SELF.ToVertex.Draw;
            SELF.SetRegion; { Reset HotRegion }
        END;
    END;

{ -------------- Graph Methods -------------- }
PROCEDURE Graph.Initialize;
    BEGIN
        New(SELF.VertexList);
        SELF.VertexList.Initialize;
        New(SELF.EdgeList);
        SELF.EdgeList.Initialize;
    END;

PROCEDURE Graph.Draw;
    BEGIN
        IF SELF.EdgeList <> NIL THEN
            SELF.EdgeList.Draw;
        IF SELF.VertexList <> NIL THEN
            SELF.VertexList.Draw;
    END;

PROCEDURE Graph.Erase;
    BEGIN
        SELF.EdgeList.Erase;
        SELF.VertexList.Erase;
    END;

PROCEDURE Graph.AddVertex(Where: Point);
    VAR
        NewVertex: Vertex;
    BEGIN
        { Create and initialize a new Vertex at Where }
        New(NewVertex);
        NewVertex.Initialize;
        NewVertex.SetCenter(Where);
        { Add new vertex to list, typecasting is required }
        SELF.VertexList.AddNode(GraphNode(NewVertex));
    END;

PROCEDURE Graph.RemoveVertex(Where: Point);
    VAR
        WhichEdge: GraphNode;
        WhichVertex: GraphNode;
    BEGIN
        { Find the appropriate Node }
        WhichVertex := SELF.VertexList.FindNode(Where);
        { If it exists... }
        IF WhichVertex <> NIL THEN BEGIN
            REPEAT
                { Find Edges Connected to the Vertex }
                WhichEdge :=
SELF.EdgeList.FindConnected(WhichVertex);
                { If an Edge exists, remove it }
                IF WhichEdge <> NIL THEN
                    SELF.EdgeList.RemoveNode(WhichEdge);
            UNTIL (WhichEdge = NIL);
            { Finally, remove the Vertex }
            SELF.VertexList.RemoveNode(WhichVertex);
        END;
    END;

PROCEDURE Graph.AddEdge(FromWhich, ToWhich: Vertex);
    VAR
        NewEdge: Edge;
    BEGIN
        { Create and initialize a new Vertex at Where }
        New(NewEdge);
        NewEdge.Initialize;
        NewEdge.SetFrom(FromWhich);
        NewEdge.SetTo(ToWhich);
        { Add new vertex to list, typecasting is required }
        SELF.EdgeList.AddNode(GraphNode(NewEdge));
    END;

PROCEDURE Graph.RemoveEdge(Where: Point);
    VAR
        WhichEdge: GraphNode;
    BEGIN
        { Find the appropriate Node }
        WhichEdge := SELF.EdgeList.FindNode(Where);
        { If it exists, remove it }
        IF WhichEdge <> NIL THEN
            SELF.EdgeList.RemoveNode(WhichEdge);
    END;

PROCEDURE Graph.SetVertexCenter(Which: Vertex; Where: Point);
    VAR
        anEdge: Edge;
    BEGIN
        { Move through the EdgeList finding Connected Instances}
        anEdge := Edge(SELF.EdgeList.FindConnected(GraphNode(Which)));
        WHILE (anEdge <> NIL) DO BEGIN
            anEdge.Erase; { Erase them and move on }
            IF anEdge.Next <> NIL THEN
                anEdge :=
Edge(anEdge.Next.FindConnected(GraphNode(Which)))
            ELSE
                anEdge := NIL;
        END;
        Which.SetCenter(Where); { Set the Vertex instance's center }
        { Move through the EdgeList finding Connected Instances}
        anEdge := Edge(SELF.EdgeList.FindConnected(GraphNode(Which)));
        WHILE (anEdge <> NIL) DO BEGIN
            anEdge.Draw; { Draw them and their vertices; move on }
            anEdge.FromVertex.Draw;
            anEdge.ToVertex.Draw;
            IF anEdge.Next <> NIL THEN
                anEdge :=
Edge(anEdge.Next.FindConnected(GraphNode(Which)))
            ELSE
                anEdge := NIL;
        END;
    END;

PROCEDURE Graph.MoveVertex(Start: Point);
    VAR
        Displacement: Point;
        NewCenter: Point;
        WhichVertex: Vertex;
    BEGIN
        WhichVertex := Vertex(SELF.VertexList.FindNode(Start));
            { If the vertex is moved, find the new center and
                 place the Vertex and redraw affected Edges }
        IF WhichVertex <> NIL THEN
            IF DragRegion(WhichVertex.HotRegion, Start, Displacement.h,
                          Displacement.v) THEN BEGIN
                NewCenter := WhichVertex.Center;
                AddPt(Displacement, NewCenter);
                SELF.SetVertexCenter(WhichVertex, NewCenter);
            END;
    END;

PROCEDURE Graph.LinkVertices(Start: Point);
    VAR
        FirstVertex: Vertex;
        LastVertex: Vertex;
        Stop: Point;
    BEGIN
        { Find the FromVertex }
        FirstVertex := Vertex(SELF.VertexList.FindNode(Start));
        IF FirstVertex <> NIL THEN BEGIN
                    DragGrayLine(Start, Stop); { Drag a line around }
            { Find the ToVertex }
            LastVertex := Vertex(SELF.VertexList.FindNode(Stop));
            IF (LastVertex <> NIL) AND (FirstVertex <> LastVertex) THEN
                SELF.AddEdge(FirstVertex, LastVertex);
        END;
    END;

PROCEDURE Graph.Free;
    BEGIN
        SELF.EdgeList.Free;
        SELF.VertexList.Free;
        INHERITED Free;
    END;


[LISTING TWO]


Type
    Circle = Object (TObject)        { The Circle class declaration }
            { Instance Variables }
        Center : Point ;        { The Center of the Circle }
        Radius : Integer ;        { The Radius of the Circle }
            { Methods }
        Procedure Draw ;        { Draw the Circle }
        Procedure Erase ;        { Erase the Circle }
    end ;
Procedure Circle.Draw ;
    Var
        theRect : Rect ;        { Rectangular area of the Circle }
    Begin
            { Set up the Rectangle }
        theRect.top := SELF.Center.v - SELF.Radius ;
        theRect.left := SELF.Center.h - SELF.Radius ;
        theRect.bottom := SELF.Center.v + SELF.Radius ;
        theRect.right := SELF.Cener.h + SELF.Radius ;
        FrameOval (theRect) ;        { Draw it }
    End ;
Procedure Circle.Erase ;
    Var
        theRect : Rect ;       { Rectangular area of the Circle }
    Begin
            { Set up the Rectangle }
        theRect.top := SELF.Center.v - SELF.Radius ;
        theRect.left := SELF.Center.h - SELF.Radius ;
        theRect.bottom := SELF.Center.v + SELF.Radius ;
        theRect.right := SELF.Cener.h + SELF.Radius ;

        EraseOval (theRect) ;            { Erase it }
    End ;




[LISTING THREE]

Program DrawtheCircle ;

< Circle's type declaration >
Var
    aCircle : Circle ;

< Circle's method definitions >
Begin
    new(aCircle) ;                { Get a new instance }

    aCircle.Center.h := 50 ;        { Set up instance variables }
    aCircle.Center.v := 50 ;
    aCirlce.Radius := 50 ;

    aCircle.Draw ;            {Draw it and free it }
    aCircle.Free ;
End.

[LISTING FOUR]

Type
    Circle = Object (TObject)       { The Circle class declaration }
            { Instance Variables }
        Center : Point ;        { The Center of the Circle }
        Radius : Integer ;        { The Radius of the Circle }
            { Methods }
        Procedure Draw ;        { Draw the Circle }
        Procedure Erase ;        { Erase the Circle }
        Procedure Free ; Override ; { The Free method needs changes }
    end ;

Procedure Circle.Draw ;
    as before
Procedure Circle.Erase ;
    as before
Procedure Cirlce.Free ;
    Begin
        SELF.Erase ;
        Inherited Free ;
    End ;


[LISTING FIVE]
[Listing Four]

Type
    DrawObject = Object (TObject)    { The DrawObject class declaration }
            { Instance Variables }
         Location : Point ;        { The location of the Object }
            { Methods }
         Procedure Draw ;            { Draw the Object }
         Procedure Erase ;            { Erase the Object }
         Procedure Offset (dh, dv : Integer) ; { Offset Object by dh, dv }
         Procedure Free ; Override ;     { The Free method needs changes }
    end ;
    Circle = Object (DrawObject)          { The Circle class declaration }
            { Instance Variables }
        Radius : Integer ;              { The Radius of the Circle }
            { Methods }
        Procedure Draw ; Override ;        { Draw the Circle }
        Procedure Erase ; Override ;        { Erase the Circle }
    end ;
    Rectangle = Object (DrawObject)    { The Rectangle class declaration }
            { Instance Variables }
        horSize : Integer ;   { The Horizontal Size of the Rectangle }
        verSize : Integer ;      { The Verical Size of the Rectangle }
            { Methods }
        Procedure Draw ; Override ;        { Draw the Rectangle }
        Procedure Erase ; Override ;        { Erase the Rectangle }
    end ;

{ --------------- The DrawObject Methods --------------- }
Procedure DrawObject .Draw ;
    Begin
    End ;
Procedure DrawObject .Erase ;
    Begin
    End ;
Procedure DrawObject .Offset (dh, dv : Integer) ; { Offset Object by dh, dv }
    Begin
        SELF.Erase ;         { Erase Object at its present location }
            { Change the location of the Object }
        SELF.Location.h := SELF.Location.h + dh ;
        SELF.Location.v := SELF.Location.v + dv ;
        SELF.Draw ;        { Draw Object at its new location }
    End ;
Procedure DrawObject.Free ;
    Begin
        SELF.Erase ;
        Inherited Free ;
    End ;

{ --------------- The Circle Methods --------------- }
Procedure Circle.Draw ;
    as before
Procedure Circle.Erase ;
    as before

{ --------------- The Rectangle Methods --------------- }
Procedure Rectangle .Draw ;
    Var
        theRect : Rect ;    { Rectangular area of the Circle }
    Begin
            { Set up the Rectangle }
        theRect.top := SELF.Location.v ;
        theRect.left := SELF.Location.h ;
        theRect.bottom := SELF.Location.v + SELF.verSize ;
        theRect.right := SELF.Location.h + SELF.horSize ;
        FrameRect (theRect) ;        { Draw it }
    End ;
Procedure Circle.Erase ;
    Var
        theRect : Rect ;        { Rectangular area of the Circle }
    Begin
            { Set up the Rectangle }
        theRect.top := SELF.Location.v ;
        theRect.left := SELF.Location.h ;
        theRect.bottom := SELF.Location.v + SELF.verSize ;
        theRect.right := SELF.Location.h + SELF.horSize ;
        EraseRect (theRect) ;        { Draw it }
    End ;