home *** CD-ROM | disk | FTP | other *** search
/ Garbo / Garbo.cdr / mac / progrmng / netclass.sit / NetClasses.sm.bin / NetClasses.sm
Encoding:
Text File  |  1989-12-28  |  47.6 KB  |  1,646 lines  |  [TEXT/MACV]
  1. "This file consists of a set of Smalltalk/V classes and methods to display and
  2. manipulate a directed acyclic graph i.e. a network of nodes and
  3. links.  The code may be used as part of an implementation of, 
  4. for example, a browser to display a tree; a project management
  5. (CPM or PERT) network; a computer aided system analysis (CASE)
  6. chart and so on.  As usual with Smalltalk, all the source is 
  7. provided in this file.
  8.  
  9. The code has been developed using Digitalk's Smalltalk/V for the
  10. Apple Macintosh, version 1.1.  It will probably work with little
  11. modification with PC versions of Smalltalk/V.  It will NOT work
  12. without extensive modification with other dialects of Smalltalk 
  13. (e.g. Apple Smalltalk-80 and ParkPlace Smalltalk-80).
  14.  
  15. Availability
  16. ============
  17. This code is not in public domain, but it is freely available for 
  18. non-commercial use.  Use in any military application or by military
  19. personnel is absolutely prohibited. Please distribute this file
  20. widely on BBS etc.
  21.  
  22. I would be delighted to receive an electronic mail message or
  23. postcard if you find this code interesting or useful.  Write
  24. to:
  25.  
  26. Nigel Gilbert, Social and Computer Sciences Research Group,
  27. University of Surrey, Guildford GU2 5XH, United Kingdom.
  28. Internet: gng@soc.surrey.ac.uk
  29.  
  30.   ⌐Nigel Gilbert 1990 
  31.  
  32. About the Network Classes
  33. =========================
  34. The basic classes are:
  35. Network:    holds the toplogy (shape) of the network;
  36. NetNode:    an individual node, including methods for drawing
  37.             a node on the display;
  38. NetLink:    an individual link;
  39. NetPane:    a Pane which displays the network;
  40. NetDispatcher: a dispatcher which works with a NetPane.
  41. and
  42. NetDemo:    implements a trivial application which shows off
  43.             the functionality of the these classes.
  44.  
  45. NetNode implements a basic version of a network node: just a
  46. plain rectangular box.  A specialisation of NetNode, NamedNode,
  47. is also included.  This implements nodes which have a label
  48. shown in the centre of the rectangle.  A specialisation of
  49. NamedNode is also provided, called TextNode.  This allows the
  50. user to associate text with the node.  The text is displayed
  51. in a text pane below the main network pane when the node is 
  52. selected.
  53.  
  54. There is a specialisation of Network for each kind of NetNode
  55. (Network goes with NetNode, NamedNetwork with NamedNode and
  56. Textnetwork with TextNode.  These varieties of Network differ
  57. principally in knowing what class to use to create a new node).
  58.  
  59. The code is designed so that you can specialise NetNode or its
  60. subclasses in a way that suits your application.  For example,
  61. it is easy to add code to make the nodes oval instead of
  62. rectangular in shape.
  63.  
  64. The demonstration uses the TextNode class.
  65.  
  66. Running the demonstration
  67. =========================
  68.  
  69. Evaluate
  70.     NetDemo new open.
  71. in the System Transcript window. A window divided into a larger,
  72. top pane and a smaller bottom pane will appear.  The top pane is
  73. for displaying the network; the bottom pane is a text editor which
  74. is used to enter and display the details associated with nodes.
  75.  
  76. To create a new node, click on the upper pane and drag down and
  77. to the right.  For further instructions, select the 
  78. 'About NetDemo...' item on the 'Network' menu in the menu bar.
  79.  
  80. The Network menu also provides options to save a network in a
  81. file, read a network from a file (the network is added to any
  82. existing network in the display, it does not replace it), 'tidy'
  83. the nodes and change the font of the network labels.  The 
  84. algorithm used to tidy a network is rather crude; please let me 
  85. know if you improve on it.
  86.  
  87. The NetDemo uses instances of TextNode as nodes.  To try out the
  88. other node classes, edit method NetDemo>>net and substitute
  89. Network or NamedNetwork for the existing TextNetwork.
  90.  
  91.  
  92. Extensions
  93. ==========
  94. To make use of the code, you will need to incorporate it into
  95. your own application.  The NetDemo class should be helpful in
  96. showing how it may be added to your own 'model'.  You need to
  97. provide at least the following methods in the model class:
  98. accept  -   if you want to save networks.
  99. net     -   (or whatever name you specify in the open method)
  100.             should answer an instance of the Network class or
  101.             of its subclasses.
  102. open    -   should create a new NetPane and send it the messages
  103.             model and name (others are optional).
  104. textPane-   needed only if you are using the TextNode nodes.
  105.  
  106. To create new types of node, you will need to:
  107.     -   specialise Network to provide a newNode: method to answer 
  108.         a new instance of the node
  109.     -   provide a method of that class called fileInNode: to
  110.         read details of the node from a file (if you want to
  111.         save a network)
  112.     -   specialise NetNode and provide methods to draw the
  113.         node on the display (drawOn:with:width) and to file out
  114.         details about the node to a file stream (fileOut:number:)
  115.         Note that the latter method is sent with two parameters,
  116.         the fileStream to write to and an 'index number' for
  117.         the node.  The index number is unique to that node and is
  118.         used to identify the node when filing data about links
  119.         between nodes.
  120.  
  121. The Network class ensures (in method addLinkFrom:to:) that the user
  122. is only allowed to draw a link between two nodes in one direction
  123. (e.g. if node A has been linked to node B, an attempt to link
  124. node B to node A will be ignored).  This method may be specialised
  125. to allow double links or to impose other constraints on links.
  126.  
  127. Endnote
  128. =======
  129. Please do note alter or remove this text from the file.
  130.                     -----*****-----
  131.  
  132. "
  133.  
  134. Object subclass: #NetLink
  135.   instanceVariableNames: 
  136.     'fromNode toNode '
  137.   classVariableNames: ''
  138.   poolDictionaries: '' !
  139.  
  140. !NetLink class methods ! !
  141.  
  142.  
  143. !NetLink methods !
  144.  
  145. distanceTo: aPoint
  146.         "answer the perpendicular distance between the link
  147.         and aPoint, if aPoint is on a perpendicular to the
  148.         link's line"
  149.     | a b c m xI yI|
  150.     a := Float fromInteger: (toNode centre x - fromNode centre x).
  151.     b := Float fromInteger: (toNode centre y - fromNode centre y).
  152.     m := b / a.
  153.     c := fromNode centre y - (m * fromNode centre x).
  154.  
  155.     "check that the foot of the perpendicular lies on the line"
  156.     xI := ((m * (aPoint y - c)) + aPoint x) / (m squared + 1).
  157.     (xI < (fromNode centre x min: toNode centre x)) ifTrue: [^ nil].
  158.     (xI > (fromNode centre x max: toNode centre x)) ifTrue: [^ nil].
  159.     yI := m * xI + c.
  160.     (yI < (fromNode centre y min: toNode centre y)) ifTrue: [^ nil].
  161.     (yI > (fromNode centre y max: toNode centre y)) ifTrue: [^ nil].
  162.  
  163.     ^ ((aPoint y - (m * aPoint x)  - c) /
  164.             (m squared + 1) sqrt) abs.!
  165.  
  166. drawOn: aForm with: aMask width: theWidth
  167.         "Private - draw the link on aForm using a line of
  168.                     theWidth pixels"
  169.  
  170.     (Pen new: aForm) mask: aMask; defaultNib: theWidth;
  171.         drawFrom: (fromNode centre) to: (toNode centre).!
  172.  
  173. fileOut: aStream nodes: nodeDictionary
  174.         "write out details about the receiver on aStream,
  175.         using the nodeDictionary to convert from nodes to
  176.         numbers"
  177.  
  178.     aStream nextPutAll: 'link(',
  179.                         (nodeDictionary
  180.                                 keyAtValue: fromNode
  181.                                 ifAbsent: [self error: 'Node not in dictionary'])
  182.                             printString, ',',
  183.                         (nodeDictionary
  184.                                 keyAtValue: toNode
  185.                                 ifAbsent: [self error: 'Node not in dictionary'])
  186.                             printString, ')'; cr.!
  187.  
  188. from: aNode to: bNode
  189.         "set the receiver to link from aNode to bNode"
  190.  
  191.     fromNode := aNode.
  192.     toNode := bNode.!
  193.  
  194. fromNode
  195.         "answer the node the receiver is going from"
  196.  
  197.     ^fromNode!
  198.  
  199. printOn: aStream
  200.         "show some details"
  201.  
  202.     aStream nextPutAll: 'NetLink from ',(fromNode centre printString),
  203.         ' to ', (toNode centre printString).!
  204.  
  205. selected: aForm
  206.         "draw the link in a way which shows that it
  207.         has been selected"
  208.  
  209.     self drawOn: aForm with: Form black width: 2.!
  210.  
  211. toNode
  212.         "answer the node the receiver is going to"
  213.  
  214.     ^toNode!
  215.  
  216. unselected: aForm
  217.         "draw the link in a way which shows that it
  218.         is not selected"
  219.  
  220.     self drawOn: aForm with: Form black width: 1.! !
  221.  
  222. Object subclass: #NetNode
  223.   instanceVariableNames: 
  224.     'area handles fromLinks toLinks minArea network '
  225.   classVariableNames: ''
  226.   poolDictionaries: '' !
  227.  
  228. !NetNode class methods ! !
  229.  
  230.  
  231. !NetNode methods !
  232.  
  233. addFromLink: aLink
  234.         "note that there is a link to the receiver"
  235.  
  236.     fromLinks add: aLink!
  237.  
  238. addToLink: aLink
  239.         "note that there is a link from the receiver"
  240.  
  241.     toLinks add: aLink!
  242.  
  243. area
  244.         "answer the area occupied by this node"
  245.  
  246.     ^area!
  247.  
  248. calcHandles
  249.         "Private - calculate the rectangles occupied by the
  250.         handles attached to the corners of the node outline.
  251.         The handles are ordered anticlockwise round the outline."
  252.  
  253.         | centres |
  254.  
  255.     centres := Array    with: area origin
  256.                         with: area origin + (0 @ (area height - 4))
  257.                         with: area corner - (4 @ 4)
  258.                         with: area corner - (4 @ area height).
  259.  
  260.     1 to: 4 do: [:corner |
  261.         handles at: corner put:
  262.                 (Rectangle
  263.                     origin: (centres at: corner)
  264.                     extent: 4 @ 4)
  265.         ].
  266.     ^handles!
  267.  
  268. centre
  269.         "answer the centre of the node's display area"
  270.  
  271.     ^area center!
  272.  
  273. displayDetails: aPane
  274.         "by default, a node has no details to display, so do
  275.          nothing"!
  276.  
  277. doubleClick: thePane
  278.         "the user has double clicked on the receiver."
  279.          self inspect!
  280.  
  281. drawHandlesOn: aForm
  282.         "Private - draw black squares on the four corners of
  283.         the outline of the node to show the handles"
  284.  
  285.     self calcHandles.
  286.     handles do: [:handle |
  287.         (BitBlt destForm: aForm sourceForm: nil)
  288.             mask: Form black;
  289.             destRect: handle;
  290.             copyBits.
  291.         ]!
  292.  
  293. drawOn: aForm with: aMask width: theWidth
  294.         "Private - display the Receiver as a rectangle,
  295.                     outlining the shape with the colour aMask,
  296.                     using an outline of width theWidth "
  297.  
  298.     (BitBlt destForm: aForm sourceForm: nil)
  299.         mask: aMask;
  300.         destRect: area;
  301.         copyBits;
  302.         mask: Form white;
  303.         destRect: (area insetBy: theWidth);
  304.         copyBits.!
  305.  
  306. drawOutlineOn: aForm
  307.         "draw a gray rectangle, using the reverse rule, the
  308.         same shape as the node"
  309.  
  310.     (BitBlt destForm: aForm sourceForm: nil)
  311.         mask: Form gray;
  312.         combinationRule: Form reverse;
  313.         destRect: area;
  314.         copyBits;
  315.         destRect: (area insetBy: 1);
  316.         copyBits.!
  317.  
  318. fileOut: aStream number: myIndexNumber
  319.         "write out on aStream the contents of my instance vars"
  320.  
  321.     aStream nextPutAll: 'node(',
  322.                         myIndexNumber printString,',',
  323.                         area printString, ')'; cr.!
  324.  
  325. fromLinks
  326.         "answer the set of from links"
  327.  
  328.     ^fromLinks!
  329.  
  330. initialise: aRectangle
  331.         "specify the window relative location of the node.
  332.         Initialise instance variables.  Answer myself"
  333.  
  334.     area := aRectangle.
  335.     minArea := 10 @ 10.
  336.     handles := Array new: 4.
  337.     fromLinks := Set new.
  338.     toLinks := Set new.
  339.     ^self!
  340.  
  341. inside: aPoint
  342.         "answer true if aPoint is inside the outline of the node"
  343.  
  344.     ^(area insetBy: 3) containsPoint: aPoint.!
  345.  
  346. intersects: aNode
  347.         "answer true if the receiver's area intersects the
  348.         area of aNode"
  349.  
  350.     ^ (area intersects: aNode area)!
  351.  
  352. linkedTo: aNode
  353.         "answer true if there is a link between aNode and
  354.         the receiver"
  355.  
  356.     aNode toLinks do: [ :link |
  357.         link toNode = self ifTrue: [^ true]
  358.         ].
  359.     self toLinks do: [ :link |
  360.         link toNode = aNode ifTrue: [^ true]
  361.         ].
  362.     ^ false!
  363.  
  364. moveBy: aPoint
  365.         "move the area by aPoint"
  366.  
  367.     area moveBy: aPoint.!
  368.  
  369. moveToOrigin
  370.         "move my area so that its origin is at 0@0"
  371.  
  372.     area moveTo: 0 @ 0.!
  373.  
  374. net
  375.         "answer the network the receiver is linked to"
  376.  
  377.     ^ network!
  378.  
  379. net: aNetwork
  380.         "note the network the receiver is linked into"
  381.  
  382.     network := aNetwork!
  383.  
  384. on: aPoint
  385.         "answer true if aPoint is in or near the area occupied
  386.         by the node"
  387.  
  388.     ^(area expandBy: 1) containsPoint: aPoint!
  389.  
  390. onCorner: aPoint
  391.         "answers true if aPoint is on or near one of the
  392.         corners of the outline of the node"
  393.  
  394.     handles do: [ :handle |
  395.         ((handle expandBy: 2) containsPoint: aPoint)
  396.         ifTrue: [^true]].
  397.     ^false.!
  398.  
  399. oppositeCorner: aPoint
  400.         "answers the point which is opposite aPoint
  401.         (a corner of the area in which the node is displayed)"
  402.  
  403.         1 to: 4 do: [:i |
  404.             (((handles at: i) expandBy: 2) containsPoint: aPoint)
  405.                 ifTrue: [
  406.                     (i = 1) ifTrue: [^ area corner].
  407.                     (i = 2) ifTrue: [^ (area right @ area top)].
  408.                     (i = 3) ifTrue: [^ area origin].
  409.                     (i = 4) ifTrue: [^ (area left @ area bottom)].
  410.                 ].
  411.             ].
  412.         self error: 'aPoint not on a corner'.!
  413.  
  414. printOn: aStream
  415.         "prints a description of the receiver"
  416.  
  417.     aStream nextPutAll: self name, ' at ', self centre printString.!
  418.  
  419. removeFromLink: aNode
  420.         "remove the link from aNode to the receiver"
  421.  
  422.     fromLinks do: [ :link |
  423.         link fromNode = aNode
  424.             ifTrue: [
  425.                 fromLinks remove: link.
  426.                 ^link
  427.                 ].
  428.         ].!
  429.  
  430. removeToLink: aNode
  431.         "remove the link from the receiver to aNode"
  432.  
  433.     toLinks do: [ :link |
  434.         link toNode = aNode
  435.             ifTrue: [
  436.                 toLinks remove: link.
  437.                 ^link
  438.                 ].
  439.         ].!
  440.  
  441. selected: aForm
  442.         "displays the node on aForm in a way that shows it has
  443.         been selected"
  444.  
  445.     self drawOn: aForm with: Form gray width: 2.
  446.     self drawHandlesOn: aForm.!
  447.  
  448. shapeTo: aRectangle
  449.         "change the area occupied by the receiver to aRectangle,
  450.         but do not reduce below minArea.
  451.         Answer the new area"
  452.     | newArea |
  453.     newArea := aRectangle normalise.
  454.     (newArea extent >= minArea) ifFalse: [ ^ area := newArea extent: minArea ].
  455.     area := newArea.
  456.     self calcHandles.
  457.     ^ area!
  458.  
  459. storeDetails: aPane
  460.         "by default, a node has no details to store, so
  461.         do nothing"!
  462.  
  463. tidyAt: topCorner
  464.         "locate myself at topCorner.  Then place all my daughters.
  465.         Then move myself down so that I am in the middle of my
  466.         daughters.  Finally, answer my bottom left corner"
  467.  
  468.     | myPos daughterPos dispY|
  469.     myPos := topCorner.
  470.     dispY := 0.
  471.     "if the node has already been placed, put it half way between the
  472.     old place and the expected new place"
  473.     (area origin y = 0) ifFalse: [
  474.         dispY := (myPos y - area origin y) // 2.
  475.         myPos := ((area origin x) max: myPos x) @ (area origin y + dispY).
  476.         ].
  477.     toLinks isEmpty ifTrue: [
  478.         area moveTo: myPos.
  479.         ^ (topCorner x @ ((topCorner y max: area bottom) + dispY + 10))
  480.         ].
  481.     daughterPos := (myPos x + area width + 10) @ myPos y.
  482.     toLinks do: [ :link |
  483.         daughterPos := (link toNode) tidyAt: daughterPos.
  484.         ].
  485.     daughterPos y: (daughterPos y - 10).
  486.     area moveTo: ((myPos x) @ ((( myPos y + daughterPos y - area height) // 2) max: myPos y)).
  487.     ^ (myPos y: (daughterPos y max: area bottom) + dispY + 10).!
  488.  
  489. toLinks
  490.         "answer the set of to links"
  491.  
  492.     ^toLinks!
  493.  
  494. unselected: aForm
  495.         "draw the outline of the node in the unselected way"
  496.  
  497.     self drawOn: aForm with: Form black width: 1.! !
  498.  
  499. NetNode subclass: #NamedNode
  500.   instanceVariableNames: 
  501.     'name '
  502.   classVariableNames: 
  503.     'Font '
  504.   poolDictionaries: '' !
  505.  
  506. !NamedNode class methods !
  507.  
  508. font: aFont
  509.         "set the receiver's class font"
  510.  
  511.     Font := aFont! !
  512.  
  513.  
  514. !NamedNode methods !
  515.  
  516. drawOn: aForm with: aMask width: theWidth
  517.         "display the Receiver as a rectangle, outlining the shape
  518.         with the colour aMask, using an outline of width theWidth,
  519.         and writing my name in the middle "
  520.  
  521.     super drawOn: aForm with: aMask width: theWidth.
  522.     (Pen new: aForm)
  523.         place: (area center);
  524.         centerText: name font: Font.!
  525.  
  526. fileOut: aStream number: myIndexNumber
  527.         "write out on aStream the contents of my instance vars"
  528.  
  529.     aStream nextPutAll: 'node(',
  530.                         myIndexNumber printString,',',
  531.                         area printString,',',
  532.                         name printString, ')'; cr.!
  533.  
  534. name
  535.         "answer my name"
  536.  
  537.     ^ name!
  538.  
  539. name: aString
  540.         "set my name and ensure my area is big enough to
  541.         display it"
  542.  
  543.     name := aString.
  544.     minArea := ((Font stringWidth: aString) + 4) @ (Font height + 4).
  545.     area extent: (area extent max: minArea).! !
  546.  
  547. NamedNode subclass: #TextNode
  548.   instanceVariableNames: 
  549.     'text '
  550.   classVariableNames: ''
  551.   poolDictionaries: '' !
  552.  
  553. !TextNode class methods ! !
  554.  
  555.  
  556. !TextNode methods !
  557.  
  558. displayDetails: textPane
  559.         "Display the text associated with the receiver in the
  560.         text pane"
  561.  
  562.     textPane fileInFrom: text!
  563.  
  564. fileOut: aStream number: myIndexNumber
  565.         "write out on aStream the contents of my instance vars"
  566.  
  567.     aStream nextPutAll: 'node(',
  568.                         myIndexNumber printString,',',
  569.                         area printString,',',
  570.                         text contents printString, ')'; cr.!
  571.  
  572. initialise: aRectangle
  573.         "initialise, giving myself a blank text. Answer myself"
  574.  
  575.     super initialise: aRectangle.
  576.     self name: String new.
  577.     text := ReadWriteStream on: String new.
  578.     ^self!
  579.  
  580. storeDetails: textPane
  581.         "recover the text which was displayed in the text
  582.         pane (and which may have been changed by the user)"
  583.  
  584.         (textPane contents = text contents)
  585.             ifFalse: [
  586.                 text reset.
  587.                 textPane fileOutOn: text.
  588.                 text reset.
  589.                 self name: (text nextLine).
  590.                 textPane model changedNet: self with: #newText.
  591.                 ]!
  592.  
  593. text: aString
  594.         "set the receiver's text to aString and reset its name
  595.         to the first line of the text"
  596.  
  597.     text reset; nextPutAll: aString; reset.
  598.     self name: (text nextLine).! !
  599.  
  600. GraphDispatcher subclass: #NetDispatcher
  601.   instanceVariableNames: 
  602.     'modified '
  603.   classVariableNames: ''
  604.   poolDictionaries: 
  605.     'FunctionKeys CharacterConstants ' !
  606.  
  607. !NetDispatcher class methods ! !
  608.  
  609.  
  610. !NetDispatcher methods !
  611.  
  612. accept
  613.     "Save the modified network. Assumes that saveFile in
  614.     the topPane has been preset to a filestream.
  615.     Answer true if successful"
  616.  
  617.     | file |
  618.  
  619.     modified ifTrue: [
  620.         CursorManager write change.
  621.         file := self topDispatcher pane saveFile.
  622.         file reOpen; reset.
  623.         pane fileOutOn: file.
  624.         file flush; truncate; close.
  625.         modified := false.
  626.         pane topPane label: (file file name); displayLabel.
  627.         CursorManager normal change
  628.     ].
  629.     ^ true!
  630.  
  631. initialize
  632.     "Private - Initialize the instance variables."
  633.  
  634.     modified := false.
  635.     super initialize!
  636.  
  637. modified
  638.         "answer whether my network has been modified since
  639.         the last save"
  640.  
  641.     ^ modified!
  642.  
  643. modified: aBoolean
  644.     "Change modified to aBoolean."
  645.  
  646.     modified := aBoolean!
  647.  
  648. processInputKey: aCharacter
  649.         "If the character is a Bs (= Delete), send it on to the
  650.         pane."
  651.  
  652.     Bs == aCharacter
  653.         ifTrue: [^ pane deleteSelection ].
  654.     ^ super processInputKey: aCharacter.!
  655.  
  656. processMouseEvent: aCharacter
  657.     "Private - Perform the requested function from the
  658.                keyboard or mouse.  Treats shift + mouse click
  659.                just like mouse click"
  660.  
  661.     SelectToFunction == aCharacter
  662.         ifTrue: [^ pane selectAtCursor].
  663.     super processMouseEvent: aCharacter! !
  664.  
  665. Object subclass: #Network
  666.   instanceVariableNames: 
  667.     'nodes links '
  668.   classVariableNames: ''
  669.   poolDictionaries: '' !
  670.  
  671. !Network class methods !
  672.  
  673. new
  674.     "Create an instance of the receiver and initialize it."
  675.  
  676.     ^ super new initialise! !
  677.  
  678.  
  679. !Network methods !
  680.  
  681. add: aNode
  682.         "add aNode to the nodes in the network"
  683.  
  684.     nodes add: aNode!
  685.  
  686. addLinkFrom: nodeA to: nodeB
  687.         "answer a new Link if nodeA and nodeB are not already
  688.         linked. Disallow a link which is the same as an existing
  689.         link, but in the oppposite direction. Ensure that both
  690.         nodes are in the network and tell nodeA about the link
  691.         to nodeB and vice versa"
  692.  
  693.     | newLink |
  694.  
  695.     nodes add: nodeA; add: nodeB.
  696.     (nodeA linkedTo: nodeB) ifTrue: [^ nil].
  697.     newLink := self newLink: nodeA to: nodeB.
  698.     nodeA addToLink: newLink.
  699.     nodeB addFromLink: newLink.
  700.     links add: newLink.
  701.     ^newLink!
  702.  
  703. deleteLink: aLink
  704.         "delete a link from the network and disconnect it from
  705.         its to and from nodes"
  706.  
  707.     (aLink toNode) removeFromLink: (aLink fromNode).
  708.     (aLink fromNode) removeToLink: (aLink toNode).
  709.     links remove: aLink.!
  710.  
  711. deleteNode: aNode
  712.         "delete a node from the network and disconnect it from
  713.         its to and from nodes"
  714.  
  715.     aNode toLinks do: [:toLink |
  716.         aNode removeToLink: toLink.
  717.         (toLink toNode) removeFromLink: aNode.
  718.         links remove: toLink. ].
  719.     aNode fromLinks do: [:fromLink |
  720.         aNode removeFromLink: fromLink.
  721.         (fromLink fromNode) removeToLink: aNode.
  722.         links remove: fromLink. ].
  723.     nodes remove: aNode.!
  724.  
  725. fileInLink: aStream nodes: nodeDictionary
  726.         "read details of a link from aStream, create it
  727.         and add it to the network.  Numeric references to
  728.         nodes are looked up in the dictionary to find actual
  729.         nodes"
  730.  
  731.     | link toNode fromNode|
  732.     fromNode := nodeDictionary
  733.                     at: (aStream nextWord asInteger)
  734.                     ifAbsent: [
  735.                         self error: 'FromNode not found in dictionary'.
  736.                         ].
  737.     toNode := nodeDictionary
  738.                     at: (aStream nextWord asInteger)
  739.                     ifAbsent: [
  740.                         self error: 'ToNode not found in dictionary'.
  741.                         ].
  742.     link := self addLinkFrom: fromNode to: toNode.
  743.     links add: link.
  744.     ^ link.!
  745.  
  746. fileInNode: aStream
  747.         "read node details, create a new node and add it to
  748.         myself.  Answer the node"
  749.  
  750.     | node n1 n2 n3 n4 |
  751.     aStream nextWord. "node number"
  752.     "get node area"
  753.     n1 := aStream nextWord asInteger.
  754.     n2 := aStream nextWord asInteger.
  755.     aStream nextWord.  "corner:"
  756.     n3 := aStream nextWord asInteger.
  757.     n4 := aStream nextWord asInteger.
  758.     node := self newNode: (n1 @ n2 corner: n3 @ n4).
  759.     node net: self.
  760.     nodes add: node.
  761.     ^ node!
  762.  
  763. initialise
  764.         "set up the instance variables"
  765.  
  766.     nodes := Set new.
  767.     links := Set new.!
  768.  
  769. links
  770.         "answer the links in this network"
  771.  
  772.     ^ links!
  773.  
  774. newLink: nodeA to: nodeB
  775.         "answer a new Link.  This method may be specialised
  776.         to answer different kinds of link"
  777.  
  778.     ^ (NetLink new) from: nodeA to: nodeB.!
  779.  
  780. newNode: aRectangle
  781.         "answer a new node, of display area aRectangle.This
  782.         method may be specialised to create alternative
  783.         nodes"
  784.  
  785.     ^ (NetNode new) initialise: aRectangle; net: self.!
  786.  
  787. nodes
  788.         "answer the nodes in the network"
  789.  
  790.     ^nodes!
  791.  
  792. roots
  793.         "answers all the nodes with no links pointing to them"
  794.  
  795.     ^ nodes select: [ :node | node fromLinks isEmpty]!
  796.  
  797. setFont: aFont
  798.         "set the font used by the receiver's nodes to display
  799.         themselves - by default, do nothing"! !
  800.  
  801. Network subclass: #NamedNetwork
  802.   instanceVariableNames: ''
  803.   classVariableNames: ''
  804.   poolDictionaries: '' !
  805.  
  806. !NamedNetwork class methods ! !
  807.  
  808.  
  809. !NamedNetwork methods !
  810.  
  811. fileInNode: aStream
  812.         "read node details, create a new node and add it to
  813.         myself"
  814.  
  815.     | node n1 n2 n3 n4 name |
  816.     aStream nextWord. "node number"
  817.     n1 := aStream nextWord asInteger.
  818.     n2 := aStream nextWord asInteger.
  819.     aStream nextWord. "corner:"
  820.     n3 := aStream nextWord asInteger.
  821.     n4 := aStream nextWord asInteger.
  822.     name := aStream nextString.
  823.     nodes add: (node := (NamedNode new)
  824.                             initialise: (n1 @ n2 corner: n3 @ n4);
  825.                             name: name;
  826.                             net: self).
  827.     ^ node!
  828.  
  829. newNode: aRectangle
  830.         "answer a new node, of display area aRectangle.This
  831.         method may be specialised to create alternative
  832.         nodes"
  833.  
  834.     ^ (NamedNode new)
  835.                 initialise: aRectangle;
  836.                 name: (WriteStream with:
  837.                     'Node-', (nodes size printString)) contents;
  838.                 net: self.!
  839.  
  840. setFont: aFont
  841.         "set the font used by the receiver's nodes to display
  842.         themselves"
  843.  
  844.         NamedNode font: aFont! !
  845.  
  846. NamedNetwork subclass: #TextNetwork
  847.   instanceVariableNames: ''
  848.   classVariableNames: ''
  849.   poolDictionaries: '' !
  850.  
  851. !TextNetwork class methods ! !
  852.  
  853.  
  854. !TextNetwork methods !
  855.  
  856. fileInNode: aStream
  857.         "read node details, create a new node and add it to
  858.         myself"
  859.  
  860.     | node n1 n2 n3 n4 text |
  861.     aStream nextWord. "node number"
  862.     n1 := aStream nextWord asInteger.
  863.     n2 := aStream nextWord asInteger.
  864.     aStream nextWord. "corner:"
  865.     n3 := aStream nextWord asInteger.
  866.     n4 := aStream nextWord asInteger.
  867.     text := aStream nextString.
  868.     nodes add: (node := self newNode: (n1 @ n2 corner: n3 @ n4)).
  869.     node text: text.
  870.     ^ node!
  871.  
  872. newNode: aRectangle
  873.         "answer a new node, of display area aRectangle.This
  874.         method may be specialised to create alternative
  875.         nodes"
  876.  
  877.     ^ (TextNode new)
  878.                 initialise: aRectangle;
  879.                 net: self.!
  880.  
  881. setFont: aFont
  882.         "set the font used by the receiver's nodes to display
  883.         themselves"
  884.  
  885.         TextNode font: aFont! !
  886.  
  887. GraphPane subclass: #NetPane
  888.   instanceVariableNames: 
  889.     'selectedLinks nodeStack network displayedNode '
  890.   classVariableNames: ''
  891.   poolDictionaries: '' !
  892.  
  893. !NetPane class methods ! !
  894.  
  895.  
  896. !NetPane methods !
  897.  
  898. cancelSelection
  899.         "cancel any selection of nodes and links"
  900.  
  901.     selection := Set new.
  902.     selectedLinks := Set new.!
  903.  
  904. changed: nodeOrLink by: action
  905.         "tell the model that the network topology has changed"
  906.  
  907.     changeSelector isNil ifFalse: [
  908.         model perform: changeSelector
  909.                            with: nodeOrLink with: action
  910.         ].!
  911.  
  912. createNode: aRectangle
  913.         "create a new node, of display area aRectangle."
  914.  
  915.     | newNode |
  916.     newNode := network newNode: aRectangle.
  917.     self changed: newNode by: #created.
  918.     ^ newNode!
  919.  
  920. cursorFrom: aPoint with: aRectangle
  921.         "answer the position of the cursor, relative to the
  922.         pane.  The position is constrained so that aRectangle
  923.         is always within the formHolder"
  924.  
  925.     | pos insideRect newRectangle |
  926.     pos := self windowToPane: (Cursor offset).
  927.     insideRect := formHolder boundingBox insetBy: 1.
  928.  
  929.     newRectangle := aRectangle normalise moveBy: (pos - aPoint).
  930.  
  931.     (newRectangle origin x < insideRect origin x)
  932.         ifTrue: [pos x: (pos x - (newRectangle origin x - insideRect origin x))]
  933.         ifFalse:[
  934.             (newRectangle corner x > insideRect corner x)
  935.                 ifTrue: [pos x: (pos x - (newRectangle corner x - insideRect corner x))].
  936.             ].
  937.     (newRectangle origin y < insideRect origin y)
  938.         ifTrue: [pos y: (pos y - (newRectangle origin y - insideRect origin y))]
  939.         ifFalse:[
  940.             (newRectangle corner y > insideRect corner y)
  941.                 ifTrue: [pos y: (pos y - (newRectangle corner y - insideRect corner y))].
  942.             ].
  943.  
  944.     ^ pos!
  945.  
  946. deleteSelection
  947.         "remove whatever is selected, if anything"
  948.  
  949.     selection do: [:node |
  950.         self unDisplayNodeDetails.
  951.         nodeStack remove: node.
  952.         selection remove: node.
  953.         network deleteNode: node.
  954.         self changed: node by: #deleted.
  955.         ].
  956.  
  957.     selectedLinks do: [ :link |
  958.         network deleteLink: link.
  959.         selectedLinks remove: link.
  960.         self changed: link by: #deleted.
  961.         ].
  962.  
  963.     self draw!
  964.  
  965. displayNodeDetails: aNode
  966.         "if aNode is the only node selected, display its details
  967.         on the text pane, first updating the details of the
  968.         previously displayed node in case the user has edited them"
  969.  
  970.         (selection size = 1)
  971.             ifFalse: [self unDisplayNodeDetails]
  972.             ifTrue: [
  973.                 (aNode = displayedNode) ifTrue: [^ nil].
  974.                 aNode isNil ifFalse: [
  975.                     self unDisplayNodeDetails.
  976.                     aNode displayDetails: self model textPane.
  977.                     displayedNode := aNode.
  978.                     ].
  979.                 ].!
  980.  
  981. doubleClickInNode: aNode at: aPoint
  982.         "the user has double clicked inside aNode"
  983.  
  984.         aNode doubleClick: self!
  985.  
  986. draw
  987.         "draw the network, links first, then the nodes"
  988.  
  989.         formHolder white.
  990.         self
  991.             drawAllLinks;
  992.             drawAllNodes;
  993.             redraw.!
  994.  
  995. drawAllLinks
  996.         "draw lines representing the links between nodes on the
  997.         display"
  998.  
  999.     nodeStack do: [ :fromNode |
  1000.         (fromNode toLinks) do: [ :toLink |
  1001.             self drawLink: toLink]
  1002.             ].!
  1003.  
  1004. drawAllNodes
  1005.         "draw all the nodes on the display.Note
  1006.         that they must be drawn in order, bottom first"
  1007.  
  1008.     nodeStack do: [ :node |  self drawNode: node ]!
  1009.  
  1010. drawLink: aLink
  1011.         "draw the link, either selected or unselected, according
  1012.         to its current setting"
  1013.  
  1014.     (selectedLinks includes: aLink)
  1015.             ifTrue: [aLink selected: formHolder]
  1016.             ifFalse: [aLink unselected: formHolder].!
  1017.  
  1018. drawNode: aNode
  1019.         "draw the node, either selected or unselected, according
  1020.         to its current setting"
  1021.  
  1022.     (selection includes: aNode)
  1023.             ifTrue: [aNode selected: formHolder]
  1024.             ifFalse: [aNode unselected: formHolder].!
  1025.  
  1026. fileIn
  1027.         "file in a network and display it. Answer true if
  1028.         successful"
  1029.  
  1030.     | fStream |
  1031.  
  1032.     (fStream := SFReply getTextFile) isNil ifTrue: [^ nil].
  1033.     self fileIn: fStream.
  1034.     fStream close.
  1035.     self topPane saveFile isNil
  1036.         ifTrue: [(self topPane)
  1037.                     saveFile: fStream;
  1038.                     label: fStream file name;
  1039.                     displayLabel ].
  1040.     self dispatcher modified: true.
  1041.     ^ true!
  1042.  
  1043. fileIn: aStream
  1044.         "read nodes and links from aStream "
  1045.  
  1046.     | word nodeDictionary index|
  1047.  
  1048.     nodeDictionary := IdentityDictionary new.
  1049.     index := 0.
  1050.     [aStream atEnd] whileFalse: [
  1051.         word := aStream nextWord.
  1052.         (word = 'node') ifTrue: [
  1053.             nodeDictionary at: index put:
  1054.                 (network fileInNode: aStream).
  1055.             index := index + 1.
  1056.             ].
  1057.         (word = 'link') ifTrue: [
  1058.             network fileInLink: aStream nodes: nodeDictionary.
  1059.             ]
  1060.         ].
  1061.     nodeStack := network nodes asOrderedCollection.
  1062.     self cancelSelection;
  1063.         draw.!
  1064.  
  1065. fileOutOn: aStream
  1066.         "write out all the nodes and links in a form in which they
  1067.         can be read in again"
  1068.  
  1069.     | nodeDictionary index |
  1070.  
  1071.     nodeDictionary := IdentityDictionary new.
  1072.     index := 0.
  1073.     network nodes do: [ :node |
  1074.         nodeDictionary at: index put: node.
  1075.         node fileOut: aStream number: index.
  1076.         index := index + 1.
  1077.         ].
  1078.     network links do: [ :link |
  1079.         link fileOut: aStream nodes: nodeDictionary.
  1080.         ].!
  1081.  
  1082. findNode: aPoint
  1083.         "answer the node which is displayed at aPoint, or
  1084.         nil if no node is there"
  1085.  
  1086.     nodeStack reverseDo: [:node |
  1087.         (node on: aPoint) ifTrue: [ ^node ]
  1088.         ].
  1089.     ^nil!
  1090.  
  1091. getLinkFrom: aNode
  1092.         "get the user to draw a link from the node to
  1093.         some other one"
  1094.  
  1095.     |newPoint oldPoint trackingPen destNode lineDisplayed link|
  1096.  
  1097.     trackingPen := (Pen new: formHolder) combinationRule: Form reverse.
  1098.  
  1099.     lineDisplayed := false.
  1100.     oldPoint := aNode centre.
  1101.     trackingPen place: oldPoint; drawTo: oldPoint.
  1102.     EventRecord whileMouseDownDo: [
  1103.         oldPoint = (newPoint := self windowToPane: (Cursor offset))
  1104.             ifFalse: [
  1105.                 lineDisplayed ifTrue: [trackingPen drawTo: oldPoint].
  1106.                  (aNode inside: newPoint)
  1107.                     ifFalse: [
  1108.                         trackingPen drawTo: newPoint.
  1109.                         oldPoint := newPoint.
  1110.                         lineDisplayed := true.
  1111.                         self redraw.]
  1112.                     ifTrue: [
  1113.                         lineDisplayed ifTrue: [self redraw ].
  1114.                         lineDisplayed := false.].
  1115.                     ]
  1116.         ].
  1117.     trackingPen drawTo: oldPoint.
  1118.  
  1119.     "if the user has let go over another node, add the link to the network."
  1120.     newPoint isNil
  1121.         ifFalse: [ (destNode := self findNode: newPoint) isNil
  1122.             ifFalse: [ destNode = aNode
  1123.                 ifFalse: [
  1124.                     (link := network addLinkFrom: aNode to: destNode) isNil
  1125.                         ifFalse: [self changed: link by: #linked]
  1126.                 ]
  1127.             ]
  1128.         ].!
  1129.  
  1130. initialize
  1131.         "Initialize the drawing area to a suitable size and then
  1132.         initialise myself."
  1133.  
  1134.     formHolder := Form new extent: (Screen extent).
  1135.     selection := Set new.
  1136.     selectedLinks := Set new.
  1137.     nodeStack := OrderedCollection new: 0.
  1138.     self dispatcher: (NetDispatcher new).
  1139.     super initialize.!
  1140.  
  1141. mouseDownAt: aPoint
  1142.         "The user has pressed the mouse button. Act according to
  1143.         whether the mouse is on a node or not"
  1144.  
  1145.      | panePoint node|
  1146.  
  1147.      panePoint := self windowToPane: aPoint.
  1148.  
  1149.      (node := self findNode: panePoint) isNil
  1150.         ifFalse:  [ self mouseInNode: node at: panePoint]
  1151.         ifTrue: [ self mouseNotInNode: panePoint].
  1152.  
  1153.      self draw.!
  1154.  
  1155. mouseInNode: aNode at:aPoint
  1156.         "depending on where the mouse is in the node,
  1157.         start drawing a link to another node,
  1158.         or move the node (or nodes if there are several selected),
  1159.         or shape the node"
  1160.  
  1161.     self select: aNode.
  1162.  
  1163.     (aNode inside: aPoint)
  1164.         ifTrue:  [
  1165.             Terminal underDoubleClickDelay
  1166.                 ifTrue: [ self doubleClickInNode: aNode at: aPoint.]
  1167.                 ifFalse: [self getLinkFrom: aNode]
  1168.             ]
  1169.         ifFalse: [
  1170.            (aNode onCorner: aPoint)
  1171.                 ifTrue: [self shapeNode: aNode from: aPoint]
  1172.                 ifFalse:[self moveNode: aPoint]
  1173.                 ].
  1174.  
  1175.      self displayNodeDetails: aNode.!
  1176.  
  1177. mouseNotInNode: aPoint
  1178.         "the user has pressed the mouse button while not on a
  1179.         node.  If the mouse is near a link, select it.  If not,
  1180.         if the user then drags, create a new node and
  1181.         add it to the network"
  1182.  
  1183.         | box node link|
  1184.  
  1185.     ((link := self selectLink: aPoint) notNil) ifTrue: [
  1186.             "user has selected a link"
  1187.         ^ link
  1188.         ].
  1189.  
  1190.     (box := self promptForRectangle: aPoint) = nil
  1191.         ifFalse: [
  1192.             node := self createNode: box.
  1193.             network add: node.
  1194.             nodeStack addLast: node.
  1195.             self select: node;
  1196.                  displayNodeDetails: node.
  1197.             ]
  1198.         ifTrue: [self unDisplayNodeDetails ].!
  1199.  
  1200. moveNode: aPoint
  1201.         "move the selection"
  1202.  
  1203.     | oldPoint newPoint rectDisplayed |
  1204.  
  1205.     rectDisplayed := false.
  1206.     oldPoint := aPoint.
  1207.     EventRecord whileMouseDownDo: [
  1208.         oldPoint = (newPoint :=
  1209.                 self cursorFrom: oldPoint with: (self selectedArea))
  1210.             ifFalse: [
  1211.                 selection do: [:node |
  1212.                     rectDisplayed ifTrue: [node drawOutlineOn: formHolder].
  1213.                     node moveBy: (newPoint - oldPoint).
  1214.                     node drawOutlineOn: formHolder.
  1215.                     ].
  1216.                 rectDisplayed := true.
  1217.                 self redraw.
  1218.                 oldPoint := newPoint.
  1219.                 ]
  1220.         ].!
  1221.  
  1222. open
  1223.         "set up the network, returned by the model"
  1224.  
  1225.     network := model perform: name.
  1226.     network setFont: curFont.!
  1227.  
  1228. promptForRectangle: origin
  1229.         "answer a rectangle as suggested by the user, or nil if the
  1230.         user gives up by making the rectangle smaller than the default"
  1231.  
  1232.     | initialRect rect pen corner newCorner rectDisplayed |
  1233.  
  1234.     initialRect := origin extent: 10 @ 10.
  1235.     corner := initialRect corner.
  1236.     rect := initialRect copy.
  1237.     pen := (Pen new: formHolder) combinationRule: Form reverse; gray.
  1238.     rectDisplayed := false.
  1239.     EventRecord whileMouseDownDo: [
  1240.         corner = (newCorner := self cursorFrom: corner with: rect)
  1241.             ifFalse: [
  1242.                 ((newCorner x < initialRect corner x) or:
  1243.                     [newCorner y < initialRect corner y])
  1244.                 ifTrue: [
  1245.                     "(still) in initial rectangle"
  1246.                     rectDisplayed ifTrue: [
  1247.                         pen drawRectangle: rect.
  1248.                         rectDisplayed := false.
  1249.                         CursorManager normal change.
  1250.                         ]
  1251.                     ]
  1252.                 ifFalse: [
  1253.                     rectDisplayed
  1254.                         ifFalse: [ CursorManager hair change.]
  1255.                         ifTrue:  [ pen drawRectangle: rect].
  1256.                     rect origin: origin corner: newCorner.
  1257.                     pen drawRectangle: rect.
  1258.                     rectDisplayed := true.
  1259.                     self redraw.
  1260.                     ].
  1261.                 corner := newCorner.
  1262.                ] "cursor moved"
  1263.         ]. "whileMouseDown"
  1264.     rectDisplayed ifTrue: [
  1265.         pen drawRectangle: rect.
  1266.         CursorManager normal change.
  1267.         ^rect].
  1268.     ^nil!
  1269.  
  1270. redraw
  1271.         "redisplay the window, by copying the form in
  1272.         formHolder onto it"
  1273.  
  1274.     self show: (formHolder boundingBox)!
  1275.  
  1276. release
  1277.         "release the instance variables"
  1278.  
  1279.     selectedLinks := nodeStack := network := nil.
  1280.     super release!
  1281.  
  1282. save
  1283.     "Save the contents of the pane. Answer true if successful"
  1284.  
  1285.         (self topPane saveFile) isNil
  1286.             ifTrue:  [^ self saveAs: 'Network']
  1287.             ifFalse: [^ self dispatcher accept].!
  1288.  
  1289. saveAs: defaultFileName
  1290.     "Save the contents of the panes to a file, offering
  1291.     the defaultFileName. Answer true if successful"
  1292.  
  1293.     | file topPane|
  1294.  
  1295.     topPane := self topPane.
  1296.     file := SFReply putFile:
  1297.                 ((file := topPane saveFile) isNil
  1298.                     ifTrue:  [ defaultFileName ]
  1299.                     ifFalse: [ file file name ]).
  1300.     file isNil ifTrue: [ ^ false ].
  1301.     file close.
  1302.     topPane saveFile: file.
  1303.     (self dispatcher modified: true; accept) ifFalse: [ ^ false].
  1304.     ^ true!
  1305.  
  1306. select: aNode
  1307.         "if aNode is already selected, do nothing.
  1308.          if the shift key is not down, cancel any existing
  1309.          selection.  Then add aNode to the selection"
  1310.  
  1311.     (selection includes: aNode) ifTrue: [^ nil].
  1312.     (CurrentEvent isShift) ifFalse: [ self cancelSelection ].
  1313.     selection add: aNode.
  1314.     "move node to top of display stack"
  1315.     nodeStack remove: aNode; addLast: aNode.
  1316.     self draw.!
  1317.  
  1318. selectAtCursor
  1319.         "the user has press a mouse button.  Do something"
  1320.  
  1321.     self mouseDownAt: (Cursor offset)!
  1322.  
  1323. selectedArea
  1324.         "answer the smallest area which entirely encloses
  1325.         the outline of all the nodes currently selected.
  1326.         Assumes that at least one node is selected"
  1327.  
  1328.     | area |
  1329.  
  1330.     area := (selection asArray at: 1) area.
  1331.     selection do: [ :node |
  1332.         area := area merge: (node area)].
  1333.     ^area.!
  1334.  
  1335. selectLink: aPoint
  1336.         "if aPoint is near a link, make it the selected link,
  1337.         or add it to the selected links if the shift key is down"
  1338.     | d |
  1339.     (CurrentEvent isShift) ifFalse: [ self cancelSelection ].
  1340.     network links do: [:link |
  1341.         d := link distanceTo: aPoint.
  1342.         d isNil ifFalse: [
  1343.             (d < 5) ifTrue: [
  1344.                 (selectedLinks includes: link) ifFalse: [
  1345.                     selectedLinks add: link.
  1346.                     self draw.
  1347.                     ^link
  1348.                     ]
  1349.                 ]
  1350.             ]
  1351.         ].
  1352.     ^nil.!
  1353.  
  1354. setFont
  1355.         "reset the font for displaying nodes"
  1356.  
  1357.     | font |
  1358.  
  1359.     font := Dialog setFont: curFont message: 'Select Font:'.
  1360.     font isNil ifTrue: [ ^ self ].
  1361.     curFont := font.
  1362.     network setFont: font.
  1363.     nodeStack do: [:node | node name: (node name)].
  1364.     self draw!
  1365.  
  1366. shapeNode: aNode from: aPoint
  1367.         "reshape aNode, by dragging the corner near aPoint"
  1368.  
  1369.     | oldPoint newPoint origin rect rectDisplayed|
  1370.  
  1371.     rectDisplayed := false.
  1372.     oldPoint := aPoint.
  1373.     origin := aNode oppositeCorner: aPoint.
  1374.     rect := aNode area.
  1375.     EventRecord whileMouseDownDo: [
  1376.         oldPoint = (newPoint := self cursorFrom: oldPoint with: rect)
  1377.             ifFalse: [
  1378.                 rect := origin corner: newPoint.
  1379.                 rectDisplayed
  1380.                     ifFalse: [
  1381.                         "only one node can be shaped at a time"
  1382.                         selection size = 1 ifFalse: [self cancelSelection; select: aNode.]
  1383.                         ]
  1384.                     ifTrue: [aNode drawOutlineOn: formHolder].
  1385.                 rect := aNode shapeTo: rect.
  1386.                 aNode drawOutlineOn: formHolder.
  1387.                 rectDisplayed := true.
  1388.                 self redraw.
  1389.                 oldPoint := newPoint.
  1390.                 ]
  1391.         ].!
  1392.  
  1393. tidy
  1394.         "re-arrange the nodes so that they are tidily positioned"
  1395.  
  1396.     | rootPos |
  1397.     nodeStack do: [ :node | node moveToOrigin].
  1398.     rootPos := 10 @ 10.
  1399.     network roots do: [ :root |
  1400.         rootPos y: (root tidyAt: rootPos) y + 10.
  1401.         ].
  1402.     self draw.!
  1403.  
  1404. topCorner: aPoint
  1405.             "Change topCorner to aPoint, but don't allow any
  1406.             area beyond the form to become visible."
  1407.  
  1408.     topCorner := aPoint max: 0@0.
  1409.     ((topCorner x + frame width) > formHolder width)
  1410.         ifTrue: [topCorner x: (formHolder width - frame width)].
  1411.    ((topCorner y + frame height) > formHolder height)
  1412.         ifTrue: [topCorner y: (formHolder height - frame height)].
  1413.  
  1414.     self
  1415.         show: (topCorner extent: frame extent);
  1416.         changed: #scroll.!
  1417.  
  1418. totalLength
  1419.     "Answer a length used to calculate the ratio of the visible
  1420.     to the invisible parts of the form, for positioning the
  1421.     scroll thumb."
  1422.  
  1423.     ^ (formHolder height - frame height)!
  1424.  
  1425. totalWidth
  1426.     "Answer a width used to calculate the ratio of the visible
  1427.     to the invisible parts of the form, for positioning the
  1428.     scroll thumb."
  1429.  
  1430.     ^ (formHolder width - frame width)!
  1431.  
  1432. unDisplayNodeDetails
  1433.         "if there are node details on display, re-store them
  1434.         in the node and blank the text pane"
  1435.  
  1436.         | textPane |
  1437.  
  1438.     displayedNode isNil ifTrue: [^nil].
  1439.     textPane := self model textPane.
  1440.     displayedNode storeDetails: textPane.
  1441.     displayedNode := nil.
  1442.     textPane
  1443.         selectAll;
  1444.         replaceWithChar: $ ;
  1445.         showWindow.!
  1446.  
  1447. update: aParameter
  1448.         "note that something has changed"
  1449.  
  1450.    self dispatcher modified: true.!
  1451.  
  1452. windowToPane: aPoint
  1453.         "aPoint is in window relative coordinates.  Answer the
  1454.         point in pane relative coordinates"
  1455.  
  1456.     ^aPoint + self topCorner - self frame origin! !
  1457.  
  1458. Object subclass: #NetDemo
  1459.   instanceVariableNames: 
  1460.     'topPane netPane textPane '
  1461.   classVariableNames: ''
  1462.   poolDictionaries: 
  1463.     'SystemMenus ' !
  1464.  
  1465. !NetDemo class methods ! !
  1466.  
  1467.  
  1468. !NetDemo methods !
  1469.  
  1470. about
  1471.         "display a window with a brief description of this
  1472.         demonstration"
  1473.  
  1474.     ('About NetDemo...\',
  1475.     'This demonstrates a set of Smalltalk/V classes and methods\',
  1476.     'for displaying and manipulating directed acyclic graphs i.e.\',
  1477.     'nodes and the links between them.\\',
  1478.     'Using the Demonstration:\',
  1479.     'To create a node, click on the top, larger window.  Then\',
  1480.     '    drag down and to the right.\',
  1481.     'To destroy a node, click on the node (to select it) and press\',
  1482.     '    the delete key.\',
  1483.     'To select a node, click anywhere inside it.\',
  1484.     'To select several nodes, hold down the shift key while selecting\',
  1485.     '    each one in turn.\',
  1486.     'To deselect a node or nodes, click anywhere in the display\',
  1487.     '    window except on a node.\',
  1488.     'To label a node, click in the node and then click in the bottom\',
  1489.     '    window.  Type as many lines of "details" about the node as\',
  1490.     '    you wish.  Then click in the upper window, away from the\',
  1491.     '    node.  The first line of the details will be copied into\',
  1492.     '    the node as its label.\',
  1493.     'To show a node''s details in the lower, text window, select the\',
  1494.     '   node in the upper, display window\',
  1495.     'To move a node, click anywhere on the edge of the node except at\',
  1496.     '    a corner to select it, and drag it to where you want it to\',
  1497.     '    go.\',
  1498.     'To reshape a node, click on one of the corners (on the black\',
  1499.     '    "handles") and drag.  You can''t make the node smaller than\',
  1500.     '    a reasonable size.\',
  1501.     'To draw a link between two nodes, click in the centre of one node\',
  1502.     '    and drag towards the centre of the other node. If you\',
  1503.     '    let go of the mouse button before you reach another node,\',
  1504.     '    no link is made.\',
  1505.     'To select a link, click on it.\',
  1506.     'To delete a link, select it and press the delete key.\',
  1507.     '     \',
  1508.     'The basic classes are:\',
  1509.     'Network:  which holds the toplogy (shape) of the network;\',
  1510.     'NetNode:  an individual node, including methods for drawing\',
  1511.     '          a node on the display;\',
  1512.     'NetLink:  an individual link;\',
  1513.     'NetPane:  a Pane which displays the network;\',
  1514.     'NetDispatcher: a dispatcher which works with a NetPane.\')
  1515.         breakLinesAtBackSlashes edit.!
  1516.  
  1517. accept
  1518.         "save the network.  Answer true if successful"
  1519.  
  1520.     ^ netPane save!
  1521.  
  1522. changedNet: nodeOrLink with: action
  1523.         "invoked by the pane when the user changes the
  1524.         topology of the network"
  1525.  
  1526.     (topPane menuBar menuAt: 'Network') enable: #save.
  1527.     self changed: nodeOrLink!
  1528.  
  1529. close
  1530.         "close down"
  1531.  
  1532.     topPane dispatcher closeIt.!
  1533.  
  1534. fileIn
  1535.         "open and read a file containing nodes and links"
  1536.  
  1537.     netPane fileIn!
  1538.  
  1539. fileOut
  1540.         "save the current network into a specified file"
  1541.  
  1542.     (netPane saveAs: 'Network') ifTrue: [
  1543.         (topPane menuBar menuAt: 'Network') disable: #save
  1544.         ].!
  1545.  
  1546. net
  1547.         "answer the data of the pane: the network which it is
  1548.         to show.  To use a different class of network and
  1549.         corresponding nodes, just change the class specified
  1550.         below.  Everything else changes to suit."
  1551.  
  1552.     ^ (TextNetwork new)!
  1553.  
  1554. netFont
  1555.         "get a new font for displaying the nodes
  1556.         from the user"
  1557.  
  1558.     netPane setFont.!
  1559.  
  1560. netMenu
  1561.         "answer my menu"
  1562.  
  1563.     ^ (Menu labels:
  1564.         'File In...\Save/S\File Out...\Tidy/T\Net Font...\Close/W\About NetDemo...'
  1565.                 breakLinesAtBackSlashes
  1566.             lines:
  1567.                 #(1 3 5 6)
  1568.             selectors:
  1569.                 #(fileIn save fileOut tidy netFont close about))
  1570.         title: 'Network'!
  1571.  
  1572. open
  1573.         "open the Network menu in the menubar and a default
  1574.         blank display window"
  1575.  
  1576.     topPane := TopPane new
  1577.         label: 'Untitled';
  1578.         model: self.
  1579.     topPane addSubpane:
  1580.         (netPane := NetPane new
  1581.             model: self;
  1582.             name: #net;
  1583.             menu: #netMenu;
  1584.             change: #changedNet:with:;
  1585.             framingRatio: (0 @ 0 extent: 1 @ (3/4))).
  1586.     topPane addSubpane:
  1587.         (textPane := TextPane new
  1588.             model: self;
  1589.             name: #text;
  1590.             framingRatio: (0 @ (3/4) extent: 1 @ (1/4))).
  1591.     topPane dispatcher open scheduleWindow.!
  1592.  
  1593. save
  1594.         "save the current network into the current file"
  1595.  
  1596.     (self accept) ifTrue: [
  1597.         (topPane menuBar menuAt: 'Network') disable: #save
  1598.         ].!
  1599.  
  1600. text
  1601.         "Initialise the text pane to nothing"
  1602.  
  1603.        ^String new!
  1604.  
  1605. textPane
  1606.         "answer the window's text pane"
  1607.  
  1608.     ^ textPane!
  1609.  
  1610. tidy
  1611.         "tidy the network"
  1612.  
  1613.     netPane tidy! !
  1614.  
  1615.  
  1616. !Rectangle methods !
  1617.  
  1618. normalise
  1619.         "answer a rectangle at the same location and with the
  1620.         shape as self, but with the origin at the top left corner"
  1621.  
  1622.     ^ ((origin x) min: (corner x)) @ ((origin y) min: (corner y))
  1623.                     extent: self extent abs.! !
  1624.  
  1625.  
  1626. !Stream methods !
  1627.  
  1628. nextString
  1629.     "Answer a String containing the next string in the
  1630.      receiver stream. A string is a sequence of characters begun
  1631.      and ended with $'.  Two adjacent $' are treated as one embedded
  1632.      $', not as a string terminator."
  1633.  
  1634.     | answer |
  1635.  
  1636.     [self atEnd ifTrue: [^ String new].
  1637.      self next = $']
  1638.         whileFalse: [].
  1639.     answer := self upTo: $'.
  1640.     [self atEnd or: [(self peekFor: $') not]]
  1641.         whileFalse: [
  1642.             answer := answer,
  1643.                 (String with: $'),
  1644.                 (self upTo: $')].
  1645.     ^ answer! !
  1646.