1/* struct::graph - critcl - layer 1 declarations
2 * (b) Node operations.
3 */
4
5#include <arc.h>
6#include <node.h>
7#include <util.h>
8
9/* .................................................. */
10
11GN*
12gn_new (G* g, const char* name)
13{
14    GN* n;
15    int	new;
16
17    if (Tcl_FindHashEntry (g->nodes.map, name) != NULL) {
18	Tcl_Panic ("struct::graph(c) gn_new - tried to use duplicate name for new node");
19    }
20
21    n = ALLOC (GN);
22
23    gc_setup ((GC*) n, &g->nodes, name, g);
24    gc_add   ((GC*) n, &g->nodes);
25
26    gn_shimmer_self (n);
27
28    n->in.first    = NULL;    n->in.n   = 0;
29    n->out.first   = NULL;    n->out.n  = 0;
30
31    return n;
32}
33
34void
35gn_delete (GN* n)
36{
37    /* We assume that the node may still have incoming and outgoing arcs. They
38     * are deleted recursively.
39     */
40
41    gc_remove ((GC*) n, &n->base.graph->nodes);
42    gc_delete ((GC*) n);
43
44    while (n->in.first)  { ga_delete (n->in.first->a);  }
45    while (n->out.first) { ga_delete (n->out.first->a); }
46
47    n->in.first   = NULL;    n->in.n  = 0;
48    n->out.first  = NULL;    n->out.n = 0;
49
50    ckfree ((char*) n);
51}
52
53/* .................................................. */
54
55void
56gn_err_duplicate (Tcl_Interp* interp, Tcl_Obj* n, Tcl_Obj* g)
57{
58    Tcl_Obj* err = Tcl_NewObj ();
59
60    Tcl_AppendToObj    (err, "node \"", -1);
61    Tcl_AppendObjToObj (err, n);
62    Tcl_AppendToObj    (err, "\" already exists in graph \"", -1);
63    Tcl_AppendObjToObj (err, g);
64    Tcl_AppendToObj    (err, "\"", -1);
65
66    Tcl_SetObjResult (interp, err);
67}
68
69void
70gn_err_missing (Tcl_Interp* interp, Tcl_Obj* n, Tcl_Obj* g)
71{
72    Tcl_Obj* err = Tcl_NewObj ();
73
74    /* Keep any prefix ... */
75    Tcl_AppendObjToObj (err, Tcl_GetObjResult (interp));
76    Tcl_AppendToObj    (err, "node \"", -1);
77    Tcl_AppendObjToObj (err, n);
78    Tcl_AppendToObj    (err, "\" does not exist in graph \"", -1);
79    Tcl_AppendObjToObj (err, g);
80    Tcl_AppendToObj    (err, "\"", -1);
81
82    Tcl_SetObjResult (interp, err);
83}
84
85/* .................................................. */
86
87Tcl_Obj*
88gn_serial_arcs (GN* n, Tcl_Obj* empty, Tcl_HashTable* cn)
89{
90    int       lc;
91    Tcl_Obj** lv;
92    Tcl_Obj*  arcs;
93    GL*       il;
94    GA*       a;
95    int       i, id;
96    Tcl_HashEntry* he;
97
98    /* Quick return if node has no outgoing arcs */
99
100    if (!n->out.n) return empty;
101
102    lc = n->out.n;
103    lv = NALLOC (lc, Tcl_Obj*);
104
105    for (i=0, il = n->out.first;
106	 il != NULL;
107	 il = il->next) {
108	a = il->a;
109	he = Tcl_FindHashEntry (cn, (char*) a->end->n);
110
111	/* Ignore arcs which lead out of the subgraph spanned up by the nodes
112	 * in 'cn'.
113	 */
114
115	if (!he) continue;
116	ASSERT_BOUNDS(i, lc);
117	id = (int) Tcl_GetHashValue (he);
118	lv [i] = ga_serial (a, empty, id);
119	i++;
120    }
121    lc = i;
122
123    arcs = Tcl_NewListObj (lc, lv);
124    ckfree ((char*) lv);
125    return arcs;
126}
127
128/* .................................................. */
129
130/*
131 * Local Variables:
132 * mode: c
133 * c-basic-offset: 4
134 * fill-column: 78
135 * End:
136 */
137