ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/JDesigner/uNetwork.pas
Revision: 1.1.1.1 (vendor branch)
Committed: Mon Dec 10 19:29:13 2001 UTC (14 years, 6 months ago) by hsauro
Branch: MAIN, hsauro
CVS Tags: V10, HEAD_NEW, HEAD
Changes since 1.1: +0 -0 lines
Log Message:
no message

Line File contents
1 unit uNetwork;
2
3 // The algorithms and much of the code for the visual designer were taken
4 // directly from Talis.
5
6 interface
7
8 Uses Windows, Classes, SysUtils, Graphics, uNetUtils, uNodeList,
9 uEdgeList, uNetObjList, Dialogs, contnrs;
10
11 const
12 NetworkSignature: array[1..4] of Char = 'ns02';
13 NL = #13#10;
14
15 type
16 TDynArray = array of array of integer;
17
18 ENetworkException = class (Exception);
19
20 TNetwork = class (TComponent)
21 private
22 FName : string;
23 FBackGroundColor : TColor;
24
25 FOnBackgroundChange : TNotifyEvent;
26 FOnGlobalArcColorChange : TNotifyEvent;
27 FOnGlobalFloatingNodeColorChange : TNotifyEvent;
28 FOnGlobalBoundaryNodeColorChange : TNotifyEvent;
29 FOnArcColorChange : TNotifyEvent;
30 FOnNodeColorChange : TNotifyEvent;
31 FOnFontChange : TNotifyEvent;
32 FOnUndoAction : TNotifyEvent;
33
34 NetworkStack : TStack;
35
36 procedure SetupDefaultColours;
37
38 function GetNode (Index : integer) : TNode;
39 function GetnNodes : integer;
40 function GetnEdges : integer;
41 procedure WriteString (s : TStream; str : string);
42 procedure WriteSpecies (s : TStream; Node : TNode; stoich : integer);
43
44 function WriteOutControlPoint (pt : TPoint) : string;
45 function WriteOutArcSeg (cp : TArcSeg) : string;
46
47 function WriteOutListOfCompartments : string;
48 function WriteOutListOfSpecies (SpeciesList : TNodeList; Annotate : boolean) : string;
49 function WriteOutListOfParameters : string;
50 function WriteOutListOfReactants (Edge : TEdge; Annotate : boolean) : string;
51 function WriteOutListOfProducts (Edge : TEdge; Annotate : boolean) : string;
52 function WriteOutListOfReactions (Annotate : boolean) : string;
53 function GetAnnotatedXMLString : string;
54
55 procedure SetBackgroundColor (c : TColor);
56 function GetBackGroundColor : TColor;
57
58 procedure SetGlobalArcColor (c : TColor);
59 function GetGlobalArcColor : TColor;
60
61 procedure SetArcColor (Index : integer; c : TColor);
62 function GetArcColor (Index : integer) : TColor;
63
64 procedure SetGlobalFloatingNodeColor (c : TColor);
65 function GetGlobalFloatingNodeColor : TColor;
66
67 procedure SetGlobalBoundaryNodeColor (c : TColor);
68 function GetGlobalBoundaryNodeColor : TColor;
69
70 procedure SetNodeColor (Index : integer; c : TColor);
71 function GetNodeColor (Index : integer) : TColor;
72
73 procedure FixUpConnectedEdges;
74 public
75 Canvas : TCanvas;
76 NodeList : TNodeList;
77 EdgeList : TEdgeList;
78 ObjectList : TNetObjList; // Things like text, shapes etc.
79 procedure UnSelect;
80 procedure Paint (const Origin : TPoint; const Width, Height : integer);
81 function IsOnNode (x, y : integer; var SubNode : TSubNode) : boolean; overload;
82
83 function IsOnEdge (x, y : integer; var Index : integer) : boolean; overload;
84 function IsOnEdge (x, y : integer; var Edge : TEdge) : boolean; overload;
85
86 function IsOnNetObject (x, y : integer; var NetObj : TNetObj) : Boolean;
87
88 function AddNode (Name : string) : integer; overload;
89 function AddNode (Name : string; x, y : integer) : integer; overload;
90 function AddNode (Name : string; x, y, w, h : integer) : integer; overload;
91 procedure AddUniUniEdge (SrcSubNode, DestSubNode : TSubNode);
92 procedure AddBiUniEdge (SrcNode1, SrcNode2, DestNode : TSubNode);
93 procedure AddUniBiEdge (SrcNode1, DestNode1, DestNode2 : TSubNode);
94 procedure AddBiBiEdge (SrcNode1, SrcNode2, DestNode1, DestNode2 : TSubNode);
95 function FindNode (Node : TNode) : integer; overload;
96 function FindNode (Name : string) : integer; overload;
97 function FindEdge (Name : string) : integer;
98 procedure DeleteNode (Node : TNode);
99 procedure DeleteSubNode (SubNode : TSubNode);
100 procedure DeleteEdge (Edge : TEdge);
101 function GetnFixed : integer;
102 function GetnFloat : integer;
103 property nNodes : integer read GetnNodes;
104 property nEdges : integer read GetnEdges;
105 constructor Create (Owner : TComponent); override;
106 destructor Destroy; override;
107
108 procedure Clear;
109 procedure ReIdObjects;
110 procedure FixUpObjectRefs;
111 procedure ReadSignature (s : TStream);
112 procedure WriteSignature (s : TStream);
113 procedure Save (s : TStream);
114 procedure Read (Canvas : TCanvas; s : TStream);
115 procedure Undo;
116 procedure PrepareUndo;
117 function UndoStackEmpty : boolean;
118 procedure EmptyUndoStack;
119
120 property Items [Index : integer] : TNode read GetNode; default;
121
122 procedure GetAdjacencyMatrix (var m : TDynArray);
123 function GetUniqueNodeName : string;
124 procedure GetJarnacScript (s : TStream; ModuleName, ModelName, ModelTitle : string);
125 procedure GetSBML (var str : PChar);
126 function GetXMLString : string;
127 procedure GetAnnotatedSBML (var str : PChar);
128 property ArcColor[Index : integer] : TColor read GetArcColor write SetArcColor;
129 property NodeColor[Index : integer] : TColor read GetNodeColor write SetNodeColor;
130
131 procedure SetGlobalFont (FontName : PChar; FontSize, FontColor : integer);
132 procedure SetFont (Index : integer; FontName : PChar; FontSize, FontColor : integer);
133 published
134 property NetworkName : string read FName write FName;
135 property BackGroundColor : TColor read GetBackGroundColor write SetBackGroundColor;
136 property GlobalArcColor : TColor read GetGlobalArcColor write SetGlobalArcColor;
137 property GlobalFloatingNodeColor : TColor read GetGlobalFloatingNodeColor write SetGlobalFloatingNodeColor;
138 property GlobalBoundaryNodeColor : TColor read GetGlobalBoundaryNodeColor write SetGlobalBoundaryNodeColor;
139
140 property OnBackgroundChange : TNotifyEvent read FOnBackgroundChange write FOnBackgroundChange;
141 property OnGlobalArcColorChange : TNotifyEvent read FOnGlobalArcColorChange write FOnGlobalArcColorChange;
142 property OnGlobalFloatingNodeColorChange : TNotifyEvent read FOnGlobalFloatingNodeColorChange write FOnGlobalFloatingNodeColorChange;
143 property OnGlobalBoundaryNodeColorChange : TNotifyEvent read FOnGlobalBoundaryNodeColorChange write FOnGlobalBoundaryNodeColorChange;
144 property OnArcColorChange : TNotifyEvent read FOnArcColorChange write FOnArcColorChange;
145 property OnNodeColorChange : TNotifyEvent read FOnNodeColorChange write FOnNodeColorChange;
146 property OnFontChange : TNotifyEvent read FOnFontChange write FOnFontChange;
147 property OnUndoAction : TNOtifyEvent read FOnUndoAction write FOnUndoAction;
148 end;
149
150 procedure Register;
151
152 implementation
153
154 const
155 DEFAULT_BACKGROUND_COLOR = clWhite;
156
157
158 // -------------------------------------------------------------------------
159
160
161 constructor TNetwork.Create (Owner : TComponent);
162 begin
163 inherited Create (Owner);
164 NetworkName := 'untitled';
165 NodeList := TNodeList.Create;
166 EdgeList := TEdgeList.Create;
167 ObjectList := TNetObjList.Create;
168 ComputeBezierBlendingFuncs;
169 SetupDefaultColours;
170 NetworkStack := TStack.Create;
171 end;
172
173
174 destructor TNetwork.Destroy;
175 begin
176 // Clear any entries in the undo stack
177 while NetworkStack.Count > 0 do
178 TNetwork (NetworkStack.Pop).Free;
179 NodeList.Free;
180 EdgeList.Free;
181 ObjectList.Free;
182 inherited Destroy;
183 end;
184
185
186 procedure TNetwork.SetupDefaultColours;
187 begin
188 FBackGroundColor := DEFAULT_BACKGROUND_COLOR;
189 end;
190
191
192 procedure TNetwork.SetBackgroundColor (c : TColor);
193 begin
194 // Background color attribute is stored in Network object
195 if FBackGroundColor <> c then
196 begin
197 FBackGroundColor := c;
198 if Assigned (FOnBackgroundChange) then
199 OnBackgroundChange (Self);
200 end;
201 end;
202
203
204 function TNetwork.GetBackGroundColor : TColor;
205 begin
206 result := FBackGroundColor;
207 end;
208
209
210 procedure TNetwork.SetGlobalArcColor (c : TColor);
211 begin
212 if EdgeList.GetGlobalArcColor <> c then
213 begin
214 EdgeList.SetGlobalArcColor (c);
215 if Assigned (FOnGlobalArcColorChange) then
216 OnGlobalArcColorChange (Self);
217 end;
218 end;
219
220
221 function TNetwork.GetGlobalArcColor : TColor;
222 begin
223 result := EdgeList.GetGlobalArcColor;
224 end;
225
226
227 procedure TNetwork.SetArcColor (Index : integer; c : TColor);
228 begin
229 if (Index >= 0) and (Index < EdgeList.Count) then
230 begin
231 if EdgeList[Index].GetArcColor <> c then
232 begin
233 EdgeList[Index].SetArcColor (c);
234 if Assigned (FOnArcColorCHange) then
235 OnArcColorChange (Self);
236 end;
237 end;
238 end;
239
240
241 function TNetwork.GetArcColor (Index : integer) : TColor;
242 begin
243 if (Index >= 0) and (Index < EdgeList.Count) then
244 result := EdgeList[Index].GetArcColor;
245 end;
246
247
248 procedure TNetwork.SetGlobalFloatingNodeColor (c : TColor);
249 begin
250 if NodeList.GetGlobalFloatingNodeColor <> c then
251 begin
252 NodeList.SetGlobalFloatingNodeColor (c);
253 if Assigned (FOnGlobalFloatingNodeColorChange) then
254 OnGlobalFloatingNodeColorChange (Self);
255 end;
256 end;
257
258
259 function TNetwork.GetGlobalFloatingNodeColor : TColor;
260 begin
261 result := NodeList.GetGlobalFloatingNodeColor;
262 end;
263
264
265 procedure TNetwork.SetGlobalBoundaryNodeColor (c : TColor);
266 begin
267 if NodeList.GetGlobalBoundaryNodeColor <> c then
268 begin
269 NodeList.SetGlobalBoundaryNodeColor (c);
270 if Assigned (FOnGlobalBoundaryNodeColorChange) then
271 OnGlobalBoundaryNodeColorChange (Self);
272 end;
273 end;
274
275
276 function TNetwork.GetGlobalBoundaryNodeColor : TColor;
277 begin
278 result := NodeList.GetGlobalBoundaryNodeColor;
279 end;
280
281 procedure TNetwork.SetNodeColor (Index : integer; c : TColor);
282 begin
283 if (Index >= 0) and (Index < NodeList.Count) then
284 begin
285 if NodeList[Index].GetNodeColor <> c then
286 begin
287 NodeList[Index].SetNodeColor (c);
288 if Assigned (FOnNodeColorCHange) then
289 OnNodeColorChange (Self);
290 end;
291 end;
292 end;
293
294
295 function TNetwork.GetNodeColor (Index : integer) : TColor;
296 begin
297 if (Index >= 0) and (Index < NodeList.Count) then
298 result := NodeList[Index].GetNodeColor;
299 end;
300
301
302 procedure TNetwork.SetGlobalFont (FontName : PChar; FontSize, FontColor : integer);
303 var i : integer;
304 begin
305 NodeList.SetGlobalTextColor (FontColor);
306 for i := 0 to NodeList.Count - 1 do
307 begin
308 NodeList[i].Font.Name := string (FontName);
309 NodeList[i].Font.Size := FontSize;
310 NodeList[i].Font.Color := FontColor;
311 NodeList[i].SetBoundingBox (NodeList[i].SubList[0]);
312 end;
313 if Assigned (FOnFontCHange) then
314 OnFontChange (Self);
315 end;
316
317
318 procedure TNetwork.SetFont (Index : integer; FontName : PChar; FontSize, FontColor : integer);
319 begin
320 if (Index >= 0) and (Index < NodeList.Count) then
321 begin
322 NodeList[Index].Font.Name := string (FontName);
323 NodeList[Index].Font.Size := FontSize;
324 NodeList[Index].Font.Color := FontColor;
325 end;
326 if Assigned (FOnFontCHange) then
327 OnFontChange (Self);
328 end;
329
330
331 // Private Method
332 function TNetWork.GetNode (Index : integer) : TNode;
333 begin
334 result := NodeList[Index] as TNode;
335 end;
336
337
338 // Private Method
339 function TNetwork.GetnNodes : integer;
340 begin
341 Result := NodeList.Count;
342 end;
343
344
345 // Private Method
346 function TNetwork.GetnEdges : integer;
347 begin
348 Result := EdgeList.Count;
349 end;
350
351
352 // Public Methods
353
354 function TNetwork.AddNode (Name : string) : integer;
355 var Node : TNode;
356 begin
357 Node := TNode.Create (Canvas, Name);
358 Node.Font.Color := NodeList.GetGlobalTextColor;
359 Node.EdgeColor := NodeList.GetGlobalFloatingNodeColor;
360 result := NodeList.Add (Node);
361 end;
362
363
364 function TNetwork.AddNode (Name : string; x, y : integer) : integer;
365 var Node : TNode;
366 begin
367 Node := TNode.Create (Canvas, Name, x, y);
368 Node.Font.Color := NodeList.GetGlobalTextColor;
369 Node.EdgeColor := NodeList.GetGlobalFloatingNodeColor;
370 result := NodeList.Add (Node);
371 end;
372
373
374 function TNetwork.AddNode (Name : string; x, y, w, h : integer) : integer;
375 var Node : TNode;
376 begin
377 Node := TNode.Create (Canvas, Name, x, y, w, h);
378 Node.Font.Color := NodeList.GetGlobalTextColor;
379 Node.EdgeColor := NodeList.GetGlobalFloatingNodeColor;
380 result := NodeList.Add (Node);
381 end;
382
383
384 // Returns true if x,y coords are positioned over node
385 function TNetwork.IsOnNode (x, y : integer; var SubNode : TSubNode) : boolean;
386 var Index : integer;
387 begin
388 result := False;
389 if NodeList.FindNode (x, y, SubNode) then
390 result := True;
391 end;
392
393
394 function TNetwork.IsOnEdge (x, y : integer; var Index : integer) : boolean;
395 var Edge : TEdge;
396 begin
397 result := False;
398 if EdgeList.FindEdge (x, y, Edge, Index) then
399 result := True;
400 end;
401
402
403 function TNetwork.IsOnEdge (x, y : integer; var Edge : TEdge) : boolean;
404 var Index : integer;
405 begin
406 result := False;
407 if EdgeList.FindEdge (x, y, Edge, Index) then
408 result := True;
409 end;
410
411
412 function TNetwork.IsOnNetObject (x, y : integer; var NetObj : TNetObj) : Boolean;
413 var Index : integer;
414 begin
415 Result := False;
416 if ObjectList.FindObj (x, y, NetObj, Index) then
417 Result := True;
418 end;
419
420
421 // -----------------------------------------------------------------
422
423
424 // Connect Node src to Node Dest
425 procedure TNetwork.AddUniUniEdge (SrcSubNode, DestSubNode : TSubNode);
426 var NewEdge : TEdge; StartPt, EndPt : TPoint; EdgeIndex : integer;
427 tx, ty : integer;
428 ConnectedNode : TConnectedNode;
429 begin
430 // Get the two nodes we're going to connect
431 NewEdge := TEdge.Create (Canvas);
432 NewEdge.EdgeType := eUniUni;
433
434 NewEdge.LineColor := EdgeList.GetGlobalArcColor;
435 NewEdge.ArrowColor := EdgeList.GetGlobalArcColor;;
436
437 NewEdge.srcConnectedNodeList.Add (TConnectedNode.Create (SrcSubNode, -1));
438 NewEdge.destConnectedNodeList.Add (TConnectedNode.Create (DestSubNode, 1));
439
440 EdgeIndex := EdgeList.Add (NewEdge);
441 NewEdge.Name := 'J' + inttostr (EdgeIndex);
442
443 // Update the linking nodes with information on what edges they are connected
444 // to. This information is required when Nodes are moved so that we can
445 // adjust surrounding beziers nicely
446 SrcSubNode.ConnectedEdgeList.Add (TConnectedEdge.Create (NewEdge));
447 destSubNode.ConnectedEdgeList.Add (TConnectedEdge.Create (NewEdge));
448
449 // Next compute the visible starting point for the edge and the visible ending point
450 tx := DestSubNode.x;
451 ty := DestSubNode.y;
452
453 StartPt := SrcSubNode.ParentNode.ComputeLaunchPoint (SrcSubNode, point (tx, ty));
454
455 tx := SrcSubNode.x;
456 ty := SrcSubNode.y;
457
458 EndPt := DestSubNode.ParentNode.ComputeLaunchPoint (DestSubNode, point (tx, ty));
459
460 // From the start and end pt info we can compute the control point coords
461 NewEdge.SubArcs[1].h1.x := StartPt.x + (EndPt.x - StartPt.x) div 2;
462 NewEdge.SubArcs[1].h1.y := StartPt.y + (EndPt.y - StartPt.y) div 2;
463 NewEdge.SubArcs[1].h2 := NewEdge.SubArcs[1].h1;
464
465 // It is possible for control points to be merged so that they move as one
466 NewEdge.SubArcs[1].Merged := False;
467 end;
468
469
470 procedure TNetwork.AddBiUniEdge (SrcNode1, SrcNode2, DestNode : TSubNode);
471 var NewEdge : TEdge; cx, cy: integer; StartPt, Centre : TPoint;
472 SrcCentre1, SrcCentre2 : TPoint; EdgeIndex : integer;
473 begin
474 NewEdge := TEdge.Create (Canvas);
475 NewEdge.LineColor := EdgeList.GetGlobalArcColor;
476 NewEdge.ArrowColor := EdgeList.GetGlobalArcColor;;
477 NewEdge.EdgeType := eBiUni;
478
479 NewEdge.srcConnectedNodeList.Add (TConnectedNode.Create (SrcNode1, -1));
480 NewEdge.srcConnectedNodeList.Add (TConnectedNode.Create (SrcNode2, -1));
481 NewEdge.destConnectedNodeList.Add (TConnectedNode.Create (DestNode, 1));
482
483 EdgeIndex := EdgeList.Add (NewEdge);
484 NewEdge.Name := 'J' + inttostr (EdgeIndex);
485
486 // Update Node to inform it which edges it is connected to, required when
487 // Nodes are moved so that we can adjust surrounding beziers nicely
488 SrcNode1.ConnectedEdgeList.Add (TConnectedEdge.Create (NewEdge));
489 SrcNode2.ConnectedEdgeList.Add (TConnectedEdge.Create (NewEdge));
490 DestNode.ConnectedEdgeList.Add (TConnectedEdge.Create (NewEdge));
491
492 // Compute the default centre of the earc
493 NewEdge.ArcCentre := ComputeCentroid (NewEdge);
494 cx := NewEdge.ArcCentre.x; cy := NewEdge.ArcCentre.y;
495
496 SrcCentre1 := SrcNode1.GetCentrePt;
497 SrcCentre2 := SrcNode2.GetCentrePt;
498
499 // Initialise the control points for the BiUni Bezier arc
500
501 // Set up start handles on SubArcs 1 and 2
502 NewEdge.SubArcs[1].h1.x := SrcCentre1.x + (cx - SrcCentre1.x) div 2;
503 NewEdge.SubArcs[1].h1.y := SrcCentre1.y + (cy - SrcCentre1.y) div 2;
504 NewEdge.SubArcs[2].h1.x := SrcCentre2.x + (cx - SrcCentre2.x) div 2;
505 NewEdge.SubArcs[2].h1.y := SrcCentre2.y + (cy - SrcCentre2.y) div 2;
506
507 NewEdge.SubArcs[1].h2.x := SrcCentre1.x + (cx - SrcCentre1.x) div 2;
508 // Position handle halfway between src1 and src2
509 NewEdge.SubArcs[1].h2.y := abs(SrcCentre1.y - SrcCentre2.y) div 2;
510 if SrcCentre1.y > SrcCentre2.y then
511 inc (NewEdge.SubArcs[1].h2.y, SrcCentre2.y)
512 else
513 inc (NewEdge.SubArcs[1].h2.y, SrcCentre1.y);
514 NewEdge.SubArcs[2].h2 := NewEdge.SubArcs[1].h2;
515
516 // Make handle 1 on SubArc 3 colinear with handle 2 on SubArcs 1 and 2
517 NewEdge.SubArcs[3].h1.x := 2*cx - NewEdge.SubArcs[1].h2.x;
518 NewEdge.SubArcs[3].h1.y := 2*cy - NewEdge.SubArcs[1].h2.y;
519
520 // Set up the end handles for SubArcs 3
521 NewEdge.SubArcs[3].h2.x := cx + (DestNode.x - cx) div 2;
522 NewEdge.SubArcs[3].h2.y := cy + (DestNode.y - cy) div 2;
523
524 // Record fact that handles are merged
525 NewEdge.SubArcs[1].Merged := True;
526 NewEdge.SubArcs[2].Merged := True;
527 NewEdge.SubArcs[3].Merged := True;
528 end;
529
530
531 procedure TNetwork.AddUniBiEdge (SrcNode1, DestNode1, DestNode2 : TSubNode);
532 var NewEdge : TEdge; cx, cy : integer; StartPt, Centre : TPoint; EdgeIndex : integer;
533 begin
534 NewEdge := TEdge.Create (Canvas);
535 NewEdge.LineColor := EdgeList.GetGlobalArcColor;
536 NewEdge.ArrowColor := EdgeList.GetGlobalArcColor;;
537 NewEdge.EdgeType := eUniBi;
538
539 NewEdge.srcConnectedNodeList.Add (TConnectedNode.Create (SrcNode1, -1));
540 NewEdge.destConnectedNodeList.Add (TConnectedNode.Create (DestNode1, 1));
541 NewEdge.destConnectedNodeList.Add (TConnectedNode.Create (DestNode2, 1));
542
543 EdgeIndex := EdgeList.Add (NewEdge);
544 NewEdge.Name := 'J' + inttostr (EdgeIndex);
545
546 // Update Node to inform it which edges it is connected to, required when
547 // Nodes are moved so that we can adjust surrounding beziers nicely
548 SrcNode1.ConnectedEdgeList.Add (TConnectedEdge.Create (NewEdge));
549 DestNode1.ConnectedEdgeList.Add (TConnectedEdge.Create (NewEdge));
550 DestNode2.ConnectedEdgeList.Add (TConnectedEdge.Create (NewEdge));
551
552 NewEdge.ArcCentre := ComputeCentroid (NewEdge);
553 cx := NewEdge.ArcCentre.x; cy := NewEdge.ArcCentre.y;
554
555 // Next compute the visible starting point for the arc and the visible ending point
556 StartPt := SrcNode1.ParentNode.ComputeLaunchPoint (SrcNode1, point (cx, cy));
557
558 // Initialise the control points for the UniBi Bezier arc. The first control
559 // points are halfway between the node and the arc centroid
560 NewEdge.SubArcs[1].h1.x := StartPt.x + (cx - StartPt.x) div 2;
561 NewEdge.SubArcs[1].h1.y := StartPt.y + (cy - StartPt.y) div 2;
562 NewEdge.SubArcs[1].h2.x := NewEdge.SubArcs[1].h1.x;
563 NewEdge.SubArcs[1].h2.y := NewEdge.SubArcs[1].h1.y;
564
565 // Make h1 handles on SubArcs 2 and 3 colinear with h2 on SubArc 1
566 NewEdge.SubArcs[2].h1.x := 2*cx - NewEdge.SubArcs[1].h2.x;
567 NewEdge.SubArcs[2].h1.y := 2*cy - NewEdge.SubArcs[1].h2.y;
568 NewEdge.SubArcs[3].h1.x := 2*cx - NewEdge.SubArcs[1].h2.x;
569 NewEdge.SubArcs[3].h1.y := 2*cy - NewEdge.SubArcs[1].h2.y;
570
571 // Set up the end handles on SubArcs 2 and 3
572 StartPt := DestNode1.ParentNode.ComputeLaunchPoint (DestNode1, point (cx, cy));
573 NewEdge.SubArcs[2].h2.x := cx + (StartPt.x - cx) div 2;
574 NewEdge.SubArcs[2].h2.y := cy + (StartPt.y - cy) div 2;
575
576 StartPt := DestNode2.ParentNode.ComputeLaunchPoint (DestNode2, point (cx, cy));
577 NewEdge.SubArcs[3].h2.x := cx + (StartPt.x - cx) div 2;
578 NewEdge.SubArcs[3].h2.y := cy + (StartPt.y - cy) div 2;
579
580 // Record fact that handles are merged
581 NewEdge.SubArcs[1].Merged := True;
582 NewEdge.SubArcs[2].Merged := True;
583 NewEdge.SubArcs[3].Merged := True;
584 end;
585
586
587 procedure TNetwork.AddBiBiEdge (SrcNode1, SrcNode2, DestNode1, DestNode2 : TSubNode);
588 var NewEdge : TEdge; SrcCentre1, SrcCentre2, Centre : TPoint; cx, cy : integer;
589 EdgeIndex : integer;
590 begin
591 NewEdge := TEdge.Create (Canvas);
592 NewEdge.LineColor := EdgeList.GetGlobalArcColor;
593 NewEdge.ArrowColor := EdgeList.GetGlobalArcColor;;
594 NewEdge.EdgeType := eBiBi;
595
596 NewEdge.srcConnectedNodeList.Add (TConnectedNode.Create (SrcNode1, -1));
597 NewEdge.srcConnectedNodeList.Add (TConnectedNode.Create (SrcNode2, -1));
598 NewEdge.destConnectedNodeList.Add (TConnectedNode.Create (DestNode1, 1));
599 NewEdge.destConnectedNodeList.Add (TConnectedNode.Create (DestNode2, 1));
600
601 EdgeIndex := EdgeList.Add (NewEdge);
602 NewEdge.Name := 'J' + inttostr (EdgeIndex);
603
604 // Update Node to inform it which edges it is connected to, required when
605 // Nodes are moved so that we can adjust surrounding beziers nicely
606 SrcNode1.ConnectedEdgeList.Add (TConnectedEdge.Create (NewEdge));
607 SrcNode2.ConnectedEdgeList.Add (TConnectedEdge.Create (NewEdge));
608 DestNode1.ConnectedEdgeList.Add (TConnectedEdge.Create (NewEdge));
609 DestNode2.ConnectedEdgeList.Add (TConnectedEdge.Create (NewEdge));
610
611 NewEdge.ArcCentre := ComputeCentroid (NewEdge);
612 cx := NewEdge.ArcCentre.x; cy := NewEdge.ArcCentre.y;
613
614 { Initialise the control points for the BiBi Bezier arc (4 pairs) }
615
616 SrcCentre1 := SrcNode1.GetCentrePt;
617 SrcCentre2 := SrcNode2.GetCentrePt;
618
619 { First the start handles on SubArcs 1 and 2 }
620 NewEdge.SubArcs[1].h1.x := SrcCentre1.x + (cx - SrcNode1.x) div 2;
621 NewEdge.SubArcs[1].h1.y := SrcCentre1.y + (cy - SrcNode1.y) div 2;
622 NewEdge.SubArcs[2].h1.x := SrcCentre2.x + (cx - SrcNode2.x) div 2;
623 NewEdge.SubArcs[2].h1.y := SrcCentre2.y + (cy - SrcNode2.y) div 2;
624
625 NewEdge.SubArcs[1].h2.x := SrcCentre1.x + (cx - SrcCentre1.x) div 2;
626 { Position handle halfway between src1 and src2 }
627 NewEdge.SubArcs[1].h2.y := abs(SrcCentre1.y - SrcNode2.y) div 2;
628 if SrcCentre1.y > SrcCentre2.y then
629 inc (NewEdge.SubArcs[1].h2.y, SrcCentre2.y)
630 else
631 inc (NewEdge.SubArcs[1].h2.y, SrcCentre1.y);
632 NewEdge.SubArcs[2].h2 := NewEdge.SubArcs[1].h2;
633
634 { Make SubArcs 3 and 4 colinear with SubArcs 1 and 2 }
635 NewEdge.SubArcs[3].h1.x := 2*cx - NewEdge.SubArcs[2].h2.x;
636 NewEdge.SubArcs[3].h1.y := 2*cy - NewEdge.SubArcs[2].h2.y;
637 NewEdge.SubArcs[4].h1 := NewEdge.SubArcs[3].h1;
638
639 { Finally the end handles on SubArcs 3 and 4 }
640 NewEdge.SubArcs[3].h2.x := cx + (DestNode1.x - cx) div 2;
641 NewEdge.SubArcs[3].h2.y := cy + (DestNOde1.y - cy) div 2;
642 NewEdge.SubArcs[4].h2.x := cx + (DestNode2.x - cx) div 2;
643 NewEdge.SubArcs[4].h2.y := cy + (DestNode2.y - cy) div 2;
644
645 { Record fact that handles are merged }
646 NewEdge.SubArcs[1].Merged := True;
647 NewEdge.SubArcs[2].Merged := True;
648 NewEdge.SubArcs[3].Merged := True;
649 NewEdge.SubArcs[4].Merged := True;
650 end;
651
652
653 // Render the network on to the Canvas
654 procedure TNetwork.Paint (const Origin : TPoint; const Width, Height : integer);
655 begin
656 Canvas.Brush.Color := FBackGroundColor;
657 Canvas.FillRect (rect (0, 0, Width, Height));
658 EdgeList.Paint (Origin);
659 NodeList.Paint (Origin);
660 ObjectList.Paint (Origin);
661 end;
662
663
664 // Unselect all nodes and edges
665 procedure TNetwork.UnSelect;
666 var i : integer;
667 begin
668 for i := 0 to NodeList.Count - 1 do
669 (NodeList[i] as TNode).UnSelect;
670 for i := 0 to EdgeList.Count - 1 do
671 (EdgeList[i] as TEdge).Selected := False;
672 end;
673
674
675 // Search for node 'Node' and return its position in the nodelist
676 function TNetwork.FindNode (Node : TNode) : integer;
677 begin
678 result := NodeList.IndexOf (Node);
679 end;
680
681
682 // Search for node 'Node' and return its position in the nodelist
683 function TNetwork.FindNode (Name : string) : integer;
684 var i : integer;
685 begin
686 result := -1;
687 for i := 0 to NodeList.Count - 1 do
688 begin
689 if NodeList[i].Name = Name then
690 begin
691 result := i;
692 exit;
693 end;
694 end;
695 end;
696
697
698
699 function TNetwork.FindEdge (Name : string) : integer;
700 var i : integer;
701 begin
702 result := -1;
703 for i := 0 to EdgeList.Count - 1 do
704 begin
705 if EdgeList[i].Name = Name then
706 begin
707 result := i;
708 exit;
709 end;
710 end;
711 end;
712
713
714 //function TNetwork.FindEdge (Edge : TEdge) : integer;
715 //var i : integer;
716 //begin
717 //for i := 1 to NodeList.Count - 1 do
718 // result := (NodeList[i] as TNode).FindEdge (Edge);
719 //end;
720
721
722 procedure TNetwork.DeleteNode (Node : TNode);
723 var i : integer;
724 begin
725 for i := 1 to Node.SubList.Count - 1 do
726 DeleteSubNode (Node.SubList[i]);
727 DeleteSubNode (Node.SubList[0]);
728 for i := 0 to NodeList.Count - 1 do
729 if NodeList[i] = Node then
730 begin
731 NodeList[i] := nil;
732 Node.Free;
733 NodeList.Pack;
734 exit;
735 end;
736 end;
737
738
739 // Deletes a single subnode and all associated edges
740 procedure TNetwork.DeleteSubNode (SubNode : TSubNode);
741 var Edge : TEdge;
742 i, j, k : integer;
743 ConnectedNode : TSubNode;
744 Node : TNode;
745 begin
746 // This section is a bit complex, wish there was a way to simplify it. When a
747 // node is deleted we have to delete all connecting edges plus all references
748 // to these edges on the adjacent nodes
749
750 // Work our way through all the connected edges, find the nodes on the other
751 // end and remove their references to the edge
752 for i := 0 to SubNode.ConnectedEdgeList.Count - 1 do
753 begin
754 // Get edge i that is connected to the SubNode
755 Edge := SubNode.ConnectedEdgeList[i].Edge as TEdge;
756
757 // Using this edge work our way through all the connected nodes
758 for j := 0 to Edge.srcConnectedNodeList.Count - 1 do
759 begin
760 // Get the connecting SubNode
761 ConnectedNode := Edge.srcConnectedNodeList[j].SubNode;
762 // Only clear the reference is not the same as the SubNode that came in on the function call
763 if ConnectedNode <> SubNode then
764 begin
765 // Find references to Edge in the edge list of the connectednode
766 for k := 0 to ConnectedNode.ConnectedEdgeList.count - 1 do
767 if ConnectedNode.ConnectedEdgeList[k].Edge as TEdge = Edge then
768 ConnectedNode.ConnectedEdgeList[k] := nil;
769 ConnectedNode.ConnectedEdgeList.Pack;
770 end;
771 end;
772
773 for j := 0 to Edge.destConnectedNodeList.Count - 1 do
774 begin
775 ConnectedNode := Edge.destConnectedNodeList[j].SubNode;
776 if ConnectedNode <> SubNode then
777 begin
778 // Find refs to the Edge in this EdgeList, and remove the ref
779 for k := 0 to ConnectedNode.ConnectedEdgeList.count - 1 do
780 if ConnectedNode.ConnectedEdgeList[k].Edge as TEdge = Edge then
781 ConnectedNode.ConnectedEdgeList[k] := nil;
782 ConnectedNode.ConnectedEdgeList.Pack;
783 end;
784 end;
785
786 SubNode.ConnectedEdgeList[i] := nil;
787
788 // Clear the edge from the edge list and free the edge
789 for j := 0 to EdgeList.Count - 1 do
790 if EdgeList[j] = Edge then
791 begin
792 EdgeList[j] := nil;
793 Edge.Free;
794 end;
795 EdgeList.Pack;
796 end;
797 SubNode.ConnectedEdgeList.Pack;
798
799 Node := SubNode.ParentNode;
800 for i := 1 to Node.SubList.Count - 1 do
801 if Node.SubList[i] = SubNode then
802 begin
803 SubNode := Node.SubList[i];
804 Node.SubList[i] := nil;
805 SubNode.Free;
806 exit;
807 end;
808 Node.SubList.Pack;
809 end;
810
811
812 procedure TNetwork.DeleteEdge (Edge : TEdge);
813 var i, j : integer; ConnectedNode : TConnectedNode;
814 SubNode : TSubNode; ConnectedEdge : TEdge;
815 begin
816 // Another complex routine. Delete an edge but also we must clear
817 // all references to this edge on adjacent nodes
818
819 // Clear all the edge references on the adjacent nodes which point
820 // the the edge to be deleted.
821
822 // Scan through all adjacent src nodes
823 for i := 0 to Edge.srcConnectedNodeList.Count - 1 do
824 begin
825 // Get the node
826 SubNode := Edge.srcConnectedNodeList[i].SubNode;
827 // and locate the references on this node which point to the edge to
828 // delete, when we find them, clear the reference
829 for j := 0 to SubNode.ConnectedEdgeList.count - 1 do
830 begin
831 ConnectedEdge := SubNode.ConnectedEdgeList[j].Edge as TEdge;
832 if ConnectedEdge = Edge then
833 begin
834 SubNode.ConnectedEdgeList[j].Edge := nil;
835 SubNode.ConnectedEdgeList[j] := nil;
836 end;
837 end;
838 SubNode.ConnectedEdgeList.Pack;
839 end;
840
841 // Get the connecting dest nodes
842 for i := 0 to Edge.destConnectedNodeList.Count - 1 do
843 begin
844 SubNode := Edge.destConnectedNodeList[i].SubNode;
845 // From the connected nodes get the connected edges and remove their reference
846 for j := 0 to SubNode.ConnectedEdgeList.count - 1 do
847 begin
848 ConnectedEdge := SubNode.ConnectedEdgeList[j].Edge as TEdge;
849 if ConnectedEdge = Edge then
850 begin
851 SubNode.ConnectedEdgeList[j].Edge := nil;
852 SubNode.ConnectedEdgeList[j] := nil;
853 end;
854 end;
855 SubNode.ConnectedEdgeList.Pack;
856 end;
857
858 // Next thing to do is clear all the Node references from the
859 // edges that hang off this edge, we probably don't have to do
860 // this since the edge is going to be deleted anyway
861 for i := 0 to Edge.srcConnectedNodeList.Count - 1 do
862 begin
863 ConnectedNode := Edge.srcConnectedNodeList[i];
864 ConnectedNode.Free;
865 Edge.srcConnectedNodeList[i] := nil;
866 end;
867 Edge.srcConnectedNodeList.Pack;
868
869 for i := 0 to Edge.destConnectedNodeList.Count - 1 do
870 begin
871 ConnectedNode := Edge.destConnectedNodeList[i];
872 ConnectedNode.Free;
873 Edge.destConnectedNodeList[i] := nil;
874 end;
875 Edge.destConnectedNodeList.Pack;
876 EdgeList.Remove (Edge);
877 Edge.Free;
878 end;
879
880
881 function TNetwork.GetnFixed : integer;
882 var i : integer;
883 begin
884 result := 0;
885 for i := 0 to NodeList.Count - 1 do
886 if NodeList[i].Status = nsBoundary then
887 inc (result);
888 end;
889
890
891 function TNetwork.GetnFloat : integer;
892 var i : integer;
893 begin
894 result := 0;
895 for i := 0 to NodeList.Count - 1 do
896 if NodeList[i].Status = nsFloating then
897 inc (result);
898 end;
899
900
901 procedure TNetwork.Clear;
902 begin
903 NodeList.Free; NodeList := TNodeList.Create;
904 EdgeList.Free; EdgeList := TEdgeList.Create;
905 ObjectList.Free; ObjectList := TNetObjList.Create;
906 end;
907
908
909
910 // ConnectedEdge is found in the NodeList and indicates for each node what
911 // are the edges it is connected to.
912 procedure TNetwork.FixUpConnectedEdges;
913 var i, j, k : integer; Edge : TEdge;
914 begin
915 for i := 0 to NodeList.Count - 1 do
916 begin
917 for j := 0 to NodeList[i].SubList.Count - 1 do
918 begin
919 for k := 0 to NodeList[i].SubList[j].ConnectedEdgeList.Count - 1 do
920 begin
921 Edge := NodeList[i].SubList[j].ConnectedEdgeList[k].Edge as TEdge;
922 NodeList[i].SubList[j].ConnectedEdgeList[k].Edge := Edge;
923 end;
924 end;
925 end;
926 end;
927
928
929 // Load and Save routines coming up......
930
931 procedure TNetwork.ReIdObjects;
932 var i, j : integer;
933 begin
934 // Renumber all the node references
935 for i := 0 to NodeList.Count - 1 do
936 begin
937 NodeList[i].Id := i;
938 for j := 0 to NodeList[i].SubList.Count - 1 do
939 NodeList[i].SubList[j].Id := j
940 end;
941 for i := 0 to EdgeList.Count - 1 do
942 EdgeList[i].Id := i;
943 end;
944
945
946 procedure TNetwork.FixUpObjectRefs;
947 var i, j, k, NodeId, EdgeId, SubId : integer;
948 begin
949 for i := 0 to NodeList.Count - 1 do
950 begin
951 for j := 0 to NodeList[i].SubList.Count - 1 do
952 begin
953 for k := 0 to NodeList[i].SubList[j].ConnectedEdgeList.count - 1 do
954 begin
955 EdgeId := integer (NodeList[i].SubList[j].ConnectedEdgeList[k].Edge);
956 NodeList[i].SubList[j].ConnectedEdgeList[k].Edge := EdgeList[EdgeId];
957 end;
958 end;
959 end;
960
961 for i := 0 to EdgeList.Count - 1 do
962 begin
963 for j := 0 to EdgeList[i].srcConnectedNodeList.Count - 1 do
964 begin
965 // Very important that the following is carried out in the given order
966 NodeId := integer (EdgeList[i].srcConnectedNodeList[j].NodeId);
967 SubId := integer (EdgeList[i].srcConnectedNodeList[j].SubNode);
968 EdgeList[i].srcConnectedNodeList[j].SubNode := NodeList[NodeId].SubList[SubId];
969 EdgeList[i].srcConnectedNodeList[j].SubNode.ParentNode := NodeList[NodeId];
970 end;
971 for j := 0 to EdgeList[i].destConnectedNodeList.Count - 1 do
972 begin
973 NodeId := integer (EdgeList[i].destConnectedNodeList[j].NodeId);
974 SubId := integer (EdgeList[i].destConnectedNodeList[j].SubNode);
975 EdgeList[i].destConnectedNodeList[j].SubNode := NodeList[NodeId].SubList[SubId];
976 EdgeList[i].destConnectedNodeList[j].SubNode.ParentNode := NodeList[NodeId];
977 end;
978 end;
979 end;
980
981
982 procedure TNetwork.ReadSignature (s : TStream);
983 var Signature: Longint;
984 begin
985 s.Read (Signature, SizeOf(Signature));
986 if Signature <> Longint(NetworkSignature) then
987 raise ENetworkException.Create ('Data input stream is either: 1) not a network or'#10#13 +
988 '2) you are attempting to read an old and incompatible data format');
989 end;
990
991
992 procedure TNetWork.WriteSignature (s : TStream);
993 begin
994 s.Write (NetworkSignature, SizeOf(NetworkSignature));
995 end;
996
997
998 procedure TNetwork.Save (s : TStream);
999 begin
1000 WriteSignature (s);
1001 s.Write (FBackGroundColor, sizeof (FBackGroundColor));
1002 ReIdObjects;
1003 NodeList.Save (s);
1004 EdgeList.Save (s);
1005 ObjectList.Save (s);
1006 end;
1007
1008
1009 procedure TNetwork.Read (Canvas : TCanvas; s : TStream);
1010 begin
1011 ReadSignature (s);
1012 s.Read (FBackGroundColor, sizeof (FBackGroundColor));
1013 NodeList.Read (s, Canvas);
1014 EdgeList.Read (s, Canvas, NodeList);
1015 FixUpObjectRefs;
1016 ObjectList.Read (s, Canvas);
1017 end;
1018
1019
1020 procedure TNetwork.PrepareUndo;
1021 var NetworkCopy : TMemoryStream;
1022 begin
1023 NetworkCopy := TMemoryStream.Create;
1024 Save (NetworkCopy);
1025 NetworkCopy.position := 0;
1026 NetworkStack.Push (NetworkCopy);
1027 //lblStackSpace.caption := inttostr (MemoryUsed);
1028 if Assigned (OnUndoAction) then
1029 OnUndoAction (Self);
1030 end;
1031
1032
1033 procedure TNetwork.Undo;
1034 var ANetwork : TStream;
1035 begin
1036 // Just a safety measure
1037 if NetworkStack.Count > 0 then
1038 begin
1039 Clear;
1040 ANetwork := NetworkStack.Pop;
1041 Read (Canvas, ANetwork);
1042 //lblStackSpace.caption := inttostr (MemoryUsed);
1043 UnSelect;
1044 end;
1045 if Assigned (OnUndoAction) then
1046 OnUndoAction (Self);
1047 end;
1048
1049
1050 function TNetwork.UndoStackEmpty : boolean;
1051 begin
1052 result := NetworkStack.Count = 0;
1053 end;
1054
1055
1056 procedure TNetwork.EmptyUndoStack;
1057 begin
1058 while not UndoStackEmpty do
1059 TNetwork (NetworkStack.Pop).Free;
1060 if Assigned (OnUndoAction) then
1061 OnUndoAction (Self);
1062 end;
1063
1064
1065 // Returns the stoichiometriy matrix for the current network
1066 procedure TNetwork.GetAdjacencyMatrix (var m : TDynArray);
1067 var nNodes, nEdges, i, j, n : integer;
1068 begin
1069 nNodes := NodeList.Count;
1070 nEdges := EdgeList.Count;
1071
1072 SetLength (m, nNodes, nEdges);
1073 for i := 0 to nNodes - 1 do
1074 for j := 0 to nEdges - 1 do
1075 m[i,j] := 0;
1076
1077 for i := 0 to nEdges - 1 do
1078 begin
1079 for j := 0 to EdgeList[i].srcConnectedNodeList.Count - 1 do
1080 begin
1081 n := FindNode (EdgeList[i].srcConnectedNodeList[j].SubNode.ParentNode);
1082 m[n,i] := EdgeList[i].srcConnectedNodeList[j].Stoich;
1083 end;
1084 for j := 0 to EdgeList[i].destConnectedNodeList.Count - 1 do
1085 begin
1086 n := FindNode (EdgeList[i].destConnectedNodeList[j].SubNode.ParentNode);
1087 m[n,i] := EdgeList[i].destConnectedNodeList[j].Stoich;
1088 end;
1089 end;
1090 end;
1091
1092
1093 procedure TNetwork.WriteString (s : TStream; str : string);
1094 var i : integer;
1095 begin
1096 for i := 1 to Length (str) do
1097 s.Write (str[i], 1);
1098 end;
1099
1100
1101 procedure TNetwork.WriteSpecies (s : TStream; Node : TNode; stoich : integer);
1102 var Name : string;
1103 begin
1104 if Node.Status = nsBoundary then
1105 Name := '$' + Node.Name
1106 else Name := Node.Name;
1107
1108 stoich := abs (stoich);
1109 if stoich = 1 then
1110 WriteString (s, Name)
1111 else WriteString (s, IntToStr (stoich) + ' ' + Name);
1112 end;
1113
1114
1115 procedure TNetwork.GetJarnacScript (s : TStream; ModuleName, ModelName, ModelTitle : string);
1116 var i, j : integer;
1117 begin
1118 if ModuleName <> '' then
1119 WriteString (s, 'Module ' + ModuleName + ';'#13#10#13#10);
1120
1121 WriteString (s, '// Export File Generated by Network Editor'#13#10);
1122 WriteString (s, '// Dated: ' + DateTimeToStr (Now) + #13#10);
1123 WriteString (s, ''#13#10);
1124 if ModelName = '' then
1125 WriteString (s, ' DefaultModel ' + ModelTitle + #13#10)
1126 else WriteString (s, ' ' + ModelName + ' = defn ' + ModelTitle + #13#10);
1127 for i := 0 to EdgeList.Count - 1 do
1128 begin
1129 WriteString (s, ' ');
1130 if EdgeList[i].Name <> '' then
1131 WriteString (s, '[' + EdgeList[i].Name + '] ');
1132 WriteSpecies (s, EdgeList[i].srcConnectedNodeList[0].SubNode.ParentNode, EdgeList[i].srcConnectedNodeList[0].Stoich);
1133 for j := 1 to EdgeList[i].srcConnectedNodeList.Count - 1 do
1134 begin
1135 WriteString (s, ' + ');
1136 WriteSpecies (s, EdgeList[i].srcConnectedNodeList[j].SubNode.ParentNode, EdgeList[i].srcConnectedNodeList[j].Stoich);
1137 end;
1138 WriteString (s, ' -> ');
1139
1140 WriteSpecies (s, EdgeList[i].destConnectedNodeList[0].SubNode.ParentNode, EdgeList[i].destConnectedNodeList[0].Stoich);
1141 for j := 1 to EdgeList[i].destConnectedNodeList.Count - 1 do
1142 begin
1143 WriteString (s, ' + ');
1144 WriteSpecies (s, EdgeList[i].destConnectedNodeList[j].SubNode.ParentNode, EdgeList[i].destConnectedNodeList[j].Stoich);
1145 end;
1146 WriteString (s, '; ' + EdgeList[i].RateLaw + ' ;'#13#10);
1147
1148 end;
1149 WriteString (s, ' end;'#13#10);
1150
1151 if ModuleName <> '' then
1152 WriteString (s, #13#10'end');
1153 end;
1154
1155
1156 procedure TNetwork.GetSBML (var str : PChar);
1157 var sstr : string; l : integer;
1158 begin
1159 // The use of StrNew here is very important. Since GetXMLString returns
1160 // a reference counted string, the string space will be freed the moment
1161 // it goes out of scope, that is, when the function returns, hence the receiver
1162 // will get a bad pointer. Instead, we make a copy which we can use safely but
1163 // which must be freed explicitly when we've finished with it.
1164 sstr := GetXMLString;
1165 l := length (sstr);
1166 str := AllocMem (l+1);
1167 Move (sstr[1], str^, l);
1168 end;
1169
1170
1171 procedure TNetwork.GetAnnotatedSBML (var str : PChar);
1172 begin
1173 // The use of StrNew here is very important. Since GetAnnotatedXMLString returns
1174 // a reference counted string, the string space will be freed the moment
1175 // it goes out of scope, that is when the function returns, hence the receiver
1176 // will get a bad pointer. Instead, we make a copy which we can use safely but
1177 // which must be freed explicitly when we've finished with it.
1178 str := StrNew(PChar(GetAnnotatedXMLString));
1179 end;
1180
1181
1182 function TNetwork.GetUniqueNodeName : string;
1183 var Id : integer;
1184 begin
1185 //if nNodes = 0 then
1186 // Id := 0
1187 //else Id := nNodes;
1188 Result := 'Node' + IntToStr (nNodes);
1189 end;
1190
1191
1192 function TNetwork.WriteOutListOfCompartments : string;
1193 begin
1194 Result := ' <listOfCompartments>' + NL;
1195 Result := Result + ' <compartment name="uVol" volume="1.0"/>' + NL;
1196 Result := Result + ' </listOfCompartments>' + NL + NL;
1197 end;
1198
1199
1200 function TNetwork.WriteOutListOfSpecies (SpeciesList : TNodeList; Annotate : boolean) : string;
1201 var i : integer;
1202 begin
1203 Result := '';
1204 for i := 0 to SpeciesList.Count - 1 do
1205 begin
1206 Result := Result + ' <specie name="' + SpeciesList[i].Name + '" ';
1207 if SpeciesList[i].Status = nsBoundary then
1208 Result := Result + 'boundaryCondition="true" '
1209 else Result := Result + 'boundaryCondition="false"';
1210 Result := Result + ' initialAmount="' + floattostr (SpeciesList[i].Value) + '"';
1211 Result := Result + ' compartment="uVol"';
1212
1213 if Annotate then
1214 begin
1215 result := result + NL;
1216 result := result + ' <annotation> ' + NL;
1217 result := result + ' <JDesigner xmlns=''jdesigner'' ';
1218 // ##############
1219 //result := result + 'x="' + inttostr (SpeciesList[i].x) + '" ';
1220 //result := result + 'y="' + inttostr (SpeciesList[i].y) + '" ';
1221 result := result + '/>' + NL;
1222 result := result + ' </annotation> </specie>' + NL;
1223 end
1224 else result := result + ' />' + NL;
1225 //Result := Result + 'initialAmount="' + FloatToStr (SpeciesList[i].Value) +
1226 end;
1227 end;
1228
1229
1230 function TNetwork.WriteOutListOfParameters : string;
1231 var i, j : integer; Edge : TEdge;
1232 begin
1233 Result := ' <listOfParameters>' + NL;
1234 for i := 0 to EdgeList.Count - 1 do
1235 begin
1236 Edge := EdgeList[i];
1237 //for j := 0 to Edge.RateLaw.ParameterList.Count - 1 do
1238 // result := result + ' <parameter name="' + Reaction.RateLaw.ParameterList[j].Name + '" value="' +
1239 // FloatToStr (Reaction.RateLaw.ParameterList[j].Value) + '"/>' + NL;
1240 end;
1241 Result := Result + ' </listOfParameters>' + NL + NL;
1242 end;
1243
1244
1245 function TNetwork.WriteOutControlPoint (pt : TPoint) : string;
1246 begin
1247 result := '<pt> x="' + inttostr (pt.x) + '" y="' + inttostr (pt.y) + '" </pt>';
1248 end;
1249
1250
1251 function TNetwork.WriteOutArcSeg (cp : TArcSeg) : string;
1252 begin
1253 result := '<ArcSeg>' + NL;
1254 result := result + ' ' + WriteOutControlPoint (cp.h1) + NL;
1255 result := result + ' ' + WriteOutControlPoint (cp.h2) + NL;
1256 result := result + ' </ArcSeg>';
1257 end;
1258
1259
1260 function TNetwork.WriteOutListOfReactants (Edge : TEdge; Annotate : boolean) : string;
1261 var i, j : integer; Species : TNode; SpeciesName : string;
1262 begin
1263 result := '';
1264 for i := 0 to Edge.srcConnectedNodeList.Count -1 do
1265 begin
1266 Species := Edge.srcConnectedNodeList[i].SubNode.ParentNode;
1267 SpeciesName := Species.Name;
1268 Result := Result + ' <specieReference specie="' + SpeciesName + '" stoichiometry="' +
1269 IntToStr (abs (Edge.srcConnectedNodeList[i].Stoich)) + '"';
1270 if Annotate then
1271 begin
1272 result := result + NL;
1273 result := result + ' <annotation>' + NL;
1274 // Note that SubArc indexing starts at ONE !
1275 result := result + ' ' + WriteOutArcSeg (Edge.SubArcs[i+1]) + NL;
1276 result := result + ' </annotation>' + NL;
1277 result := result + ' </speciesRef>' + NL;
1278 end
1279 else result := result + '/>' + NL;
1280 end;
1281 end;
1282
1283
1284 function TNetwork.WriteOutListOfProducts (Edge : TEdge; Annotate : boolean) : string;
1285 var i, j : integer; Species : TNode; SpeciesName : string;
1286 begin
1287 result := '';
1288 for i := 0 to Edge.destConnectedNodeList.Count -1 do
1289 begin
1290 Species := Edge.destConnectedNodeList[i].SubNode.ParentNode;
1291 SpeciesName := Species.Name;
1292 Result := Result + ' <specieReference specie="' + SpeciesName + '" stoichiometry="' +
1293 IntToStr (Edge.destConnectedNodeList[i].Stoich) + '"';
1294
1295 // If the edge is not a UniUni reaction then the product side will have
1296 // separate arcs which need saving
1297 if Edge.EdgeType <> eUniUni then
1298 begin
1299 if Annotate then
1300 begin
1301 result := result + NL;
1302 result := result + ' <annotation>' + NL;
1303 // Note that SubArc indexing starts at ONE !
1304 result := result + ' ' + WriteOutArcSeg (Edge.SubArcs[i+1]) + NL;
1305 result := result + ' </annotation>' + NL;
1306 result := result + ' </speciesRef>' + NL;
1307 end
1308 else result := result + '/>' + NL;
1309 end
1310 else result := result + '/>' + NL;
1311 end;
1312 end;
1313
1314
1315 function TNetwork.WriteOutListOfReactions (Annotate : boolean) : string;
1316 var i, j : integer; Reaction : TEdge;
1317 begin
1318 Result := Result + ' <listOfReactions>' + NL;
1319 for i := 0 to EdgeList.Count - 1 do
1320 begin
1321 Reaction := EdgeList[i];
1322 Result := Result + ' <reaction name="' + Reaction.Name + '" ';
1323
1324 //if Reaction.Comment <> '' then
1325 // Result := Result + ' simpleNotes="' + Reaction.Comment + '" ';
1326
1327 if Reaction.Reversible then
1328 Result := Result + 'reversible="true">' + NL
1329 else Result := Result + 'reversible="false">' + NL;
1330
1331 Result := Result + ' <listOfReactants>' + NL;
1332 Result := Result + WriteOutListOfReactants (EdgeList[i], Annotate);
1333 Result := Result + ' </listOfReactants>' + NL;
1334
1335 Result := Result + ' <listOfProducts>' + NL;
1336 Result := Result + WriteOutListOfProducts (EdgeList[i], Annotate);
1337 Result := Result + ' </listOfProducts>' + NL + NL;
1338
1339 Result := Result + ' <kineticLaw formula="' + Reaction.RateLaw + '">' + NL;
1340 // If there are parameters then write them out
1341 if Reaction.SymbolList.Count > 0 then
1342 begin
1343 Result := Result + ' <listOfParameters>' + NL;
1344 for j := 0 to Reaction.SymbolList.Count - 1 do
1345 Result := Result + ' <parameter name="' + Reaction.SymbolList[j].Name + '" value="' + floattostr (Reaction.SymbolList[j].value) + '"/>' + NL;
1346 Result := Result + ' </listOfParameters>' + NL;
1347 end;
1348 Result := Result + ' </kineticLaw>' + NL;
1349
1350 Result := Result + ' </reaction>' + NL;
1351 Result := Result + NL;
1352 end;
1353 Result := Result + ' </listOfReactions>' + NL;
1354 end;
1355
1356
1357 function TNetwork.GetXMLString : string;
1358 var i, j : integer; Annotate : boolean;
1359 begin
1360 Annotate := False;
1361 result := '<?xml version="1.0" encoding="UTF-8"?>' + NL;
1362 result := Result + '<!-- Created by JDesigner ' + '0.9' + ' on ' + DateToStr (Now) + ' -->' + NL;
1363 result := Result + '<sbml xmlns="sbml.xml" version="1" level="1">' + NL;
1364 result := Result + ' <model name="'+ NetworkName + '">' + NL + NL;
1365
1366 result := result + WriteOutListOfCompartments;
1367 result := Result + ' <listOfSpecies>' + NL;
1368 result := result + WriteOutListOfSpecies (NodeList, Annotate);
1369 result := Result + ' </listOfSpecies>' + NL + NL;
1370 //result := result + WriteOutListOfParameters;
1371
1372 result := result + WriteOutListOfReactions (Annotate);
1373
1374 result := result + NL;
1375 result := result + ' </model>' + NL;
1376 result := result + '</sbml>' + NL;
1377 end;
1378
1379
1380 function TNetwork.GetAnnotatedXMLString : string;
1381 var i, j : integer; Annotate : boolean;
1382 begin
1383 Annotate := True;
1384 Result := '<?xml version="1.0" encoding="UTF-8"?>' + NL;
1385 Result := Result + '<!-- Created by JDesigner ' + '0.9' + ' on ' + DateToStr (Now) + ' -->' + NL;
1386 Result := Result + '<sbml xmlns="cell:sbml.xml" version="1.0">' + NL;
1387 Result := Result + ' <model name="'+ NetworkName + '">' + NL + NL;
1388
1389 result := result + WriteOutListOfCompartments;
1390 Result := Result + ' <listOfSpecies>' + NL;
1391 result := result + WriteOutListOfSpecies (NodeList, Annotate);
1392 Result := Result + ' </listOfSpecies>' + NL + NL;
1393 result := result + WriteOutListOfParameters;
1394
1395 result := result + WriteOutListOfReactions (Annotate);
1396
1397 Result := Result + ' </model>' + NL;
1398 Result := Result + '</sbml>' + NL;
1399 end;
1400
1401
1402 procedure Register;
1403 begin
1404 RegisterComponents('Samples', [TNetwork]);
1405 end;
1406
1407
1408 end.