[net.lang.st80] Grapher

messick@tekchips.UUCP (Steve Messick) (07/29/86)

Grapher is a Smalltalk tool to display data structures.  The
distribution consists of two parts: PART 1 contains the files README
and Grapher-2.st, PART 2 has only the file Grapher-1.st.  See
the README file for further information.

------------------------------ README ------------------------------

Introduction

Grapher is a tool which attempts to provide a general yet simple mechanism
for viewing and interacting with Smalltalk data structures.  It is especially
well suited for directed acyclic graphs.  It should be able to handle cyclic
graphs but this has not been extensively tested and the resultant lay out of
the graph would probably be non-optimal.  Grapher is a generic name which
includes these classes: GraphNode, EmptyGraphNode, GraphHolder,
GraphHolderView, and GraphHolderController.

Interaction occurs via the mouse.  An element (node) of the graph may be
selected with the mouse, and sent messages chosen from a menu of options
recognized by the elements of the graph.

Graphs consist of labeled nodes (which correspond to Smalltalk objects; the
objects are referred to as elements) and unlabeled arcs.  The arcs are drawn
as straight lines without arrowheads.  The label of the node may be an
instance of either Text or Form.  An instance of GraphHolder contains a
collection of GraphNodes.  There is one GraphNode for every node in the graph.

It is, perhaps, a bit presumptuous to call this tool Grapher.  The original
Grapher is supplied with Xerox Lisp machines.  It has several features not
available in this implementation.  The two most noticeable extra features are
the ability to interactively edit graphs and the ability to lay out more
general kinds of graphs.

Grapher is known to work with the Tektronix 4400 series machines.  It
probably will not work with Version 1 Smalltalk-80 images (e.g. Apple
Macintosh Smalltalk: class ActionMenu needs to be defined).  No claims 
are made as to whether it will work with any other Smalltalk images.


Use

First, the simple cases, applicable for DAGs.  A Graph of a forest of DAGs
can be easily created by sending GraphHolder class the message
'createForestWithRoots:' with an argument which a Collection of elements that
are the roots of the DAGs.  This will create a GraphNode for each element of
the graph and return a properly initialized instance of GraphHolder.
A special case for creating a graph of a tree is available via
'createTreeWithRoot:'.  The GraphHolder returned by either is suitable
for use as a model in a GraphHolderView.

To create a scrollable, resizable view of a DAG send GraphHolderView class the
message 'openOn: roots label: string'.  This creates a forest, as above, lays
out the graph in horizontal format, and opens a new window on it. There are
other, similar messages which allow the specification of graph format, menu,
etc.  The elements in roots and all their subnodes must respond to messages
requesting their children, and their label.  The default message selectors
are 'children' and 'graphLabel'.  'children' must return a Collection of child
nodes, or an empty collection if none.  'graphLabel' must return a Text 
or Form to be used as the label of the node in the Graph.  These message
selectors may be changed by including the desired selector as an argument to
'openOn: roots label: labelString format: formatSymbols menu: actionMenu
childrenMsg: children labelMsg: graphLabel'.

That last message selector included a couple other parameters of interest.
'formatSymbols' is an Array of Symbols which control the format of the graph.
Currently recognized symbols are:

		#horizontal		the default, left to right
		#vertical		top to bottom
		#reverse		right to left, or bottom to top

Note that #horizontal and #vertical are mutually exclusive, but both can be
combined with #reverse.  A 'formatSymbols' of #( vertical reverse ) results
in a Graph which looks like a true tree: the root is at the bottom.

The other parameter is 'actionMenu'.  If 'actionMenu' is non-nil the window
becomes sensitive to mouse clicks.  The red button can be used to select an
element of the graph, then the yellow button will activate 'actionMenu'.  The
menu selection message will be sent to the object which the node of the tree
represents.  Note that there will be two different menus:  if no selection
has been made the default window menu will be present on the yellow button,
but if a selection has been made then the 'actionMenu' will be the menu
used by the yellow button.

To create a GraphHolder without tying it to a particular view send
GraphHolder class the message 'createForestWithRoots: roots' or
'createTreeWithRoot: root'.  These methods return a properly initialized
instance of GraphHolder which then may be used as a model for a
GraphHolderView.  The GraphHolder will need to be laid out by
sending it the message 'layout: formatSymbols' where 'formatSymbols'
is the same as for GraphHolderView.

It is not necessary to use the supplied routines for initializing a
GraphHolder. It is only required that the GraphHolder be given a
Collection of GraphNodes (via 'GraphHolder.graphNodes:').  Each GraphNode
must have its 'object' and 'to' fields initialized.  The 'object'
field is a pointer to the object represented by the GraphNode.  The
'to' field points to the objects (not the GraphNodes) which are
the children of the node.  These fields are initialized by the
'GraphNode.to: toObjects object: myObject' method.

Occasionally it is necessary to create a graph with no nodes in it. To
do so send GraphHolder class the message 'createEmpty'.  It returns a
GrapherHolder with one EmptyGraphNode in it.  The message 'isEmpty'
test a GraphHolder: it returns true if graph has one EmptyGraphNode in
it, false otherwise.  'GraphHolderView.erase' has an example of how
an empty graph may be used.


Default Menu

The default yellow (middle) button menu for a GraphHolderView window
contains two items.  `inspect' opens a model-view-controller
inspector on the GraphHolderView.  This option is provided mostly for
debugging Grapher, but can be used to get a handle on the objects
which make up the graph.  The other option is `file out' which
doesn't quite work yet.  It is intended to produce PostScript code,
and it does, which will cause the graph to be replicated on the
Laser Writer.  The PostScript is almost correct when I preview it on
a Magnolia but nothing comes out when I send it to the Laser Writer.
A rather long file of predefined PostScript code is required to make
this work; see me if you want a copy.  It also requires
'WriteStream.lf' to be defined.

Note that this menu is not available when an 'actionMenu' has been
specified and a node has been selected.


Installation

Grapher is distributed as a set of files (all of which have
lf's, not cr's, as line terminators): Grapher-1.st, Grapher-2.st,
and README.  The first two are Smalltalk source code files,
the third is this documentation file.  It should be possible to
simply file-in Grapher-1.st and Grapher-2.st to install Grapher.
GrapherHolder class has two examples. The examples each create a
GraphHolderView on a portion of the Smalltalk inheritance hierarchy.


Acknowledgements

Steve Messick wrote the first version of Smalltalk Grapher in March, 1986.
It was based on the Grapher LispUsers package in Interlisp-D (but with
much less functionallity).  Chris Jacobsen provided most of the extensions
and bug fixes which result in the current version.  In particular he
introduced empty and replaceable GraphHolders, and got Forms to work as
the label of a GraphNode. Thanks to Roxie Rochet and Brian Phillips
for helping to test the earlier version of Grapher.


Known Bugs

	o Scrolling is off-by-2.  The right and bottom edges may
	  have a 2 bit wide strip which does not get cleared if
	  the graph is scrolled to far left or far top.

	o Scrolling horizontally is not continuous on the 4400's,
	  but vertical scrolling is.

Problems, questions, and/or suggestions should be directed
to Steve Messick, CRL, Tek Labs (messick%tekcrl@tektronix.csnet),
or to Chris Jacobson (chrisj%tekcrl@tektronix.csnet). Of particular
interest are any extensions, bug fixes, or other modifications to
the code.

------------------------------ Grapher-2.st ------------------------------

DisplayObject subclass: #GraphHolder
	instanceVariableNames: 'nodes virtualNodes roots directed sides delta form offset boundingBox '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Grapher'!
GraphHolder comment:
'A GraphHolder provides the global organization required to present a structured, graphical display of a data structure.  GraphHolders may be created with the createTreeWithRoot: or createForestWithRoots: messages in GraphHolder metaclass, or by the openOn:label: message of GraphHolderView metaclass.  Also, it is possible, but not easy, to use routines external to GraphHolder to create a graph.  After a graph has been created it must have its elements positioned properly.  The message layout: does this.  I



ts argument is an Array of formatting symbols, which specify the various format options which are in effect for this GraphHolder.  The format symbols currently recognized are:

	#horizontal		The default.  GraphHolders have roots to the left,
					leaves to the right.
	#vertical		Roots at top, leaves at bottom.
	#reverse		Either right-left, or bottom-top.

My instance variables:

	nodes		<Dictionary from Object to GraphNode>
				The nodes which make up a GraphHolder.
	virtualNodes <Dictionary from Object to Sets of GraphNode>
				Nodes with multiple ''from'' fields are replicated here.
	roots		<Collection of Object>
				The distinguished nodes which are the roots of a DAG.
	directed	<Boolean>
				If true, I am a directed graph and links are fixed (e.g.
				from bottom of a label to top of a child label).
				If false, links may originate at whichever edge of
				the label is convenient (modulo the value of sides).
	sides		<Boolean>
				If true, links are drawn to the left or right of a node.
				If false, links are drawn to the top or bottom of a node.
	delta		<Point>
				The minimum distances between node labels. The x
				value specifies the distance between parent/child.  The
				y value, adjacent children.
	form		<Form or GraphHolder>
				The object to be displayed.  If the display fits on a form
				then a form is created and saved here.  Otherwise this
				is a pointer back to the GraphHolder.  Only used for display.
	offset		<Point>
				My display offset (in local view coordinates).
	boundingBox <Rectangle>
				A rectangle large enough to hold my entire graphical
				display, positioned in local view coordinates.

Currently, my sides and directed flags are unused.  They are provided for compatability with future versions of Grapher which may support more generalized layout options.

File out Grapher:

	| sourceStream |
	sourceStream _ Disk file: ''Grapher-1.st'' asFileName.
	#(XAxisScrollController GraphHolderController GraphHolderView) do:
		[ :className |
		(Smalltalk at: className) fileOutOn: sourceStream].
	sourceStream nextChunkPut:
''#(''''FourWay'''' ''''LeftCursor'''' ''''RightCursor'''' ''''XMarkerCursor'''') do:
	[ :var | Cursor addClassVarName: var].''; cr.
	#(fourWay left right xMarker initialize) do:
		[ :selector |
		Cursor class fileOutMessage: selector on: sourceStream moveSource: false toFile: 0].
	sourceStream nextChunkPut: ''Cursor initialize.''; cr.
	sourceStream close.

	| sourceStream |
	sourceStream _ Disk file: ''Grapher-2.st'' asFileName.
	#(GraphHolder GraphNode EmptyGraphNode) do:
		[ :className |
		(Smalltalk at: className) fileOutOn: sourceStream].
	Object fileOutCategory: ''grapher access'' asSymbol on: sourceStream moveSource: false toFile: 0.
	sourceStream close.
'!


!GraphHolder methodsFor: 'initialize-release'!

initialize

	sides _ true.
	directed _ true.
	offset _ 0@0!

release

	form _ nil! !


!GraphHolder methodsFor: 'accessing'!

directed
	^directed!

directed: aBool
	directed _ aBool!

form

	form == nil
		ifTrue: [self composeForm].
	^form!

nodes
	^nodes!

offset
	^offset!

offset: aPoint
	offset _ aPoint!

roots

	"Chris Jacobson 7-9-86"
	^roots!

selectNodeAt: selectionPoint

	| selection |
	selection _ nodes detect: [ :node | node containsPoint: selectionPoint]
					   ifNone: [nil].
	selection == nil & (virtualNodes ~= nil) ifTrue:
		[virtualNodes do:
			[ :group |
			selection _ group detect: [ :node | node containsPoint: selectionPoint]
							   ifNone: [nil].
			selection == nil
				ifFalse: [^selection]]].
	^selection!

sides
	^sides!

sides: aBool
	sides _ aBool! !


!GraphHolder methodsFor: 'testing'!

isEmpty

	^(nodes size = 1) and: [nodes keysDo: [:node | ^node class == EmptyGraphNode]]! !


!GraphHolder methodsFor: 'display box access'!

boundingBox

	boundingBox == nil
		ifTrue: [boundingBox _ self computeBoundingBox].
	^boundingBox!

computeBoundingBox

	self layout.
	^boundingBox! !


!GraphHolder methodsFor: 'displaying'!

displayOn: aDisplayMedium at: aDisplayPoint clippingBox: clipRectangle rule: ruleInteger mask: aForm

	| displayPoint blter |
	displayPoint _ aDisplayPoint + offset.
	blter _ BitBlt
		destForm: aDisplayMedium
		sourceForm: (Form extent: 1@1) black
		halftoneForm: aForm
		combinationRule: ruleInteger
		destOrigin: 0@0
		sourceOrigin: 0@0
		extent: 1@1
		clipRect: clipRectangle.
	nodes do:
		[ :node |
		node to do:
			[ :child |
			blter drawFrom: displayPoint + node fromPt
				  to: displayPoint + child toPt]].
	nodes do:
		[ :node |
		node
			displayOn: aDisplayMedium
			at: displayPoint
			clippingBox: clipRectangle
			rule: ruleInteger
			mask: aForm].
	virtualNodes == nil ifFalse:
		[virtualNodes do:
			[ :share | share do:
				[ :node |
				node			
					displayOn: aDisplayMedium
					at: displayPoint
					clippingBox: clipRectangle
					rule: ruleInteger
					mask: aForm]]]!

displayOn: aDisplayMedium transformation: aDisplayTransformation clippingBox: aRectangle rule: ruleInteger mask: aHalfTone

	self form
		displayOn: aDisplayMedium
		transformation: aDisplayTransformation
		clippingBox: aRectangle
		rule: ruleInteger
		mask: aHalfTone!

view

	self displayOn: self form at: 0@0.
	form openAs: 
		(roots size = 1
			ifTrue: ['Tree']
			ifFalse: ['Forest'])! !


!GraphHolder methodsFor: 'graph layout'!

layout
	"Default format."

	self layout: #( #horizontal )!

layout: format

	| messages realOffset extents max horizontal |
	delta == nil ifTrue: [delta _ 30@30].
	messages _ (nodes at: roots first) formatMessages: format.
	horizontal _ format includes: #horizontal.
	realOffset _ offset copy.
	extents _ OrderedCollection new: roots size.
	max _ 0.
	roots do:
		[ :root |
		extents addLast:
			((nodes at: root) extentOfGraph: self
							  withDelta: delta
							  formatMessages: (messages at: 1))].
	1 to: roots size do:
		[ :n |
		(nodes at: (roots at: n))
			setPosition: offset
			withDelta: delta
			forGraph: self
			formatMessages: (messages at: 2).
		horizontal
			ifTrue: [max _ max max: (extents at: n) x.
					offset y: offset y + (extents at: n) y + delta y]
			ifFalse: [max _ max max: (extents at: n) y.
					offset x: offset x + (extents at: n) x + delta x]].
	horizontal
		ifTrue: [boundingBox _ 0@0 extent: (max + delta x @ offset y).
				offset _ realOffset.
				offset x: offset x + (delta x // 2)]
		ifFalse: [boundingBox _ 0@0 extent: offset x @ (max + delta y).
				offset _ realOffset.
				offset y: offset y + (delta y // 2)]! !


!GraphHolder methodsFor: 'graph setup'!

addNode: newNode
	"Add a 'virtual' node to the graph.  Virtual nodes have no children;
	they serve as markers for nodes with multiple from nodes."

	virtualNodes == nil ifTrue: [virtualNodes _ IdentityDictionary new: 16].
	(virtualNodes at: newNode object
		   ifAbsent: [virtualNodes at: newNode object put: (OrderedCollection new: 5)])
		addLast: newNode!

forestFrom: rootObjs children: childrenMsg label: labelMsg

	| index |
	nodes _ IdentityDictionary new: 64.
	roots _ Array new: rootObjs size.
	index _ 1.
	rootObjs do:
		[ :root |
		roots at: index put: root.
		index _ index + 1.
		self newGraphNode: root
			fromNode: nil
			children: childrenMsg
			label: labelMsg]!

newGraphNode: nodeObj fromNode: fromNode children: childrenMsg label: labelMsg
	"Add another graphNode (for nodeObj) to the graph.  Its
	immediate parent is fromNode. 'Ware circularities!!"

	| graphNode toNodes children |
	graphNode _ nodes at: nodeObj ifAbsent:
		[graphNode _ GraphNode from: fromNode
								   object: nodeObj
								   label: (nodeObj perform: labelMsg).
		children _ nodeObj perform: childrenMsg.
		toNodes _ OrderedCollection new: children size.
		children do:
			[ :child |
			toNodes addLast: (self newGraphNode: child
									fromNode: graphNode
									children: childrenMsg
									label: labelMsg)].
		graphNode to: toNodes asArray.
		nodes at: nodeObj put: graphNode.
		^graphNode].
	graphNode addFromNode: fromNode.
	^graphNode! !


!GraphHolder methodsFor: 'graph hardcopy'!

psEpilogueOn: aStream

	aStream lf!

psLine: beginPt to: endPt on: aStream

	beginPt x printOn: aStream.
	aStream space.
	beginPt y printOn: aStream.
	aStream space.
	endPt x printOn: aStream.
	aStream space.
	endPt y printOn: aStream.
	aStream space; nextPutAll: 'Line'; lf!

psPrologueOn: aStream

	aStream lf.
	offset x negated printOn: aStream.
	aStream space.
	offset y negated printOn: aStream.
	aStream space.
	boundingBox extent x printOn: aStream.
	aStream space.
	boundingBox extent y printOn: aStream.
	aStream space; nextPutAll: 'SetPage'; lf!

psScriptOn: aStream

	nodes do:
		[ :node |
		node to do:
			[ :child |
			self psLine: node fromPt to: child toPt on: aStream ]].
	nodes do:
		[ :node |
		node psStoreOn: aStream ].
	virtualNodes == nil ifFalse:
		[virtualNodes do:
			[ :share |
			share do:
				[ :node |
				node boxYourself.		"workaround for a slight glitch"
				node psStoreOn: aStream ]]]!

psStoreOn: aStream
	"Store the PostScript code to reproduce me on aStream.  This set of
	methods requires some external PostScript definitions for SetPage,
	Box, Line, and Label."

	self psPrologueOn: aStream.
	self psScriptOn: aStream.
	self psEpilogueOn: aStream! !


!GraphHolder methodsFor: 'private'!

composeForm

	self boundingBox extent x +15 // 16
	* self boundingBox extent y > WordArray maxSize
		ifFalse: [form _ Form extent: self boundingBox extent.
				self displayOn: form at: 0@0.
				self changed: #form]
		ifTrue: [form _ self.
				self changed: #noform]! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

GraphHolder class
	instanceVariableNames: ''!


!GraphHolder class methodsFor: 'instance creation'!

createEmpty

	^self createTreeWithRoot: (EmptyGraphNode new)!

createForestWithRoots: objs

	^self createForestWithRoots: objs children: #children label: #graphLabel!

createForestWithRoots: objs children: childrenMsg label: labelMsg
	"Create a forest rooted at objs.  Use the message selector in
	childrenMsg to get the children of node.  Use the selector in
	labelMsg to get the label of a node."

	^self new forestFrom: objs children: childrenMsg label: labelMsg!

createTreeWithRoot: obj

	^self createForestWithRoots: (Array with: obj)!

new
	^super new initialize! !


!GraphHolder class methodsFor: 'examples'!

example1
	"If 'children' and 'graphLabel' have been defined in Object then
	display the inheritance heirarchy for Number."

	GraphHolderView openOn: (Array with: Number)
				label: 'Number'
				format: #( #vertical #reverse )

	"GraphHolder example1"

	"definition of children for Object"
"children
	^self subclasses"

	"definition of graphLabel for Object"
"graphLabel
	^self name asText"!

example2
	"If 'children' and 'graphLabel' have been defined in Object then
	display the inheritance heirarchies for View and Controller.
	This example is interesting because the space required to display
	the resulting forest is too large to fit into an instance of Form.
	(At least, it's too big for a 16-bit interpreter.)"

	GraphHolderView openOn: (Array with: View with: Controller)
				label: 'Windows'

	"GraphHolder example2"! !
DisplayText subclass: #GraphNode
	instanceVariableNames: 'object from to fromPt toPt boxed '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Grapher'!
GraphNode comment:
'My instance variables:

	object		<Object>
				Reference to the object which I am to display.
	from		<Array of Integer>
				A list of GraphNode id''s. A link fruns from each node
				in this list to me.
	to			<Array of Integer>
				A list of GraphNode id''s. A link fruns from me to each
				node in this list.
	fromPt		<Point>
				The location (wrt offset) on my form where my to
				links begin.
	toPt		<Point>
				The location (wrt offset) on my form where my from
				links end.
	boxed		<Boolean>
				If true, a box is to drawn around my form.  Only valid
				for ''real'' nodes (ie those GraphNodes in the nodes
				field of GraphHolder, not the virtualNodes field).
'!


!GraphNode methodsFor: 'initialize-release'!

initialize

	boxed _ false! !


!GraphNode methodsFor: 'accessing'!

from
	^from!

from: fromNodes
	from _ fromNodes!

fromPt
	^fromPt!

object
	^object!

to
	^to!

to: toNodes
	to _ toNodes!

toPt
	^toPt!

visited
	"Boxed is used as a temporary indicator: it is set to true
	during pass one, then false in pass two.  Shared nodes
	remain true."

	^toPt ~= nil and: [to size > 0]! !


!GraphNode methodsFor: 'testing'!

containsPoint: aPoint

	^(Rectangle origin: offset extent: form boundingBox extent)
		containsPoint: aPoint! !


!GraphNode methodsFor: 'editing'!

addFromNode: new

	from _ from copyWith: new!

addToNode: new

	to _ to copyWith: new!

boxYourself

	| newForm |
	boxed
		ifTrue: [^self].
	form border: form boundingBox width: 1.
	boxed _ true!

deleteFromNode: old

	from _ from copyWithout: old!

deleteToNode: old

	to _ to copyWithout: old! !


!GraphNode methodsFor: 'display box access'!

bottomCenter

	^self form boundingBox bottomCenter + offset!

boundingBox
	^self form boundingBox!

leftCenter

	^self form boundingBox leftCenter + offset!

origin

	^self form boundingBox origin + offset!

rightCenter

	^self form boundingBox rightCenter + offset!

topCenter

	^self form boundingBox topCenter + offset! !


!GraphNode methodsFor: 'graph layout'!

extentOfGraph: graph withDelta: delta formatMessages: msgs
	"Determine the extent of the rectangular area required
	to hold the subtree of which I am the root.  Save the extent
	temporarily in offset (till we get to setPosition:...)."

	| boundingBox labelBox updateMsg childExtent |
	labelBox _ self boundingBox.
	boxed ifTrue:
		[^self perform: (msgs at: 1) with: labelBox extent with: delta].
	to size = 0 ifTrue:
		[^offset _ self perform: (msgs at: 1) with: labelBox extent with: delta].
	boxed _ true.
	updateMsg _ msgs at: 2.
	to do:
		[ :child |
		childExtent _ child extentOfGraph: graph
							withDelta: delta
							formatMessages: msgs.
		self perform: updateMsg with: childExtent].
	self perform: (msgs at: 3) with: labelBox extent with: delta.
	^offset!

formatMessages: format

	(format includes: #vertical)
		ifTrue:
			[(format includes: #reverse)
				ifTrue: [^self reverseVerticalFormat]
				ifFalse: [^self verticalFormat]].
	(format includes: #horizontal)
		ifTrue:
			[(format includes: #reverse)
				ifTrue: [^self reverseHorizontalFormat]
				ifFalse: [^self horizontalFormat]].
	self error: 'Unknown graph format.'!

horizontalFormat

	^Array
		with:
			#(	#horizExtent:with:
				#horizAdjustOffset:
				#horizAddLabel:with: )
		with:
			#(	#leftCenter
				#horizWidth:with:
				#horizFixedSubOrigin:with:with:
				#horizVariableSubOrigin:
				#horizNewSubOrigin:with: )!

reverseHorizontalFormat

	^Array
		with:
			#(	#horizExtent:with:
				#horizAdjustOffset:
				#horizAddLabel:with: )
		with:
			#(	#rightCenter
				#horizWidth:with:
				#revHorizFixedSubOrigin:with:with:
				#horizVariableSubOrigin:
				#horizNewSubOrigin:with: )!

reverseVerticalFormat

	^Array
		with:
			#(	#vertExtent:with:
				#vertAdjustOffset:
				#vertAddLabel:with: )
		with:
			#(	#bottomCenter
				#vertWidth:with:
				#revVertFixedSubOrigin:with:with:
				#vertVariableSubOrigin:
				#vertNewSubOrigin:with: )!

setPosition: origin withDelta: delta forGraph: graph formatMessages: msgs
	"Allocate space for each of my children side-by-side and
	assign a value to offset which results in my form being appropriately
	centered in my display rectangle."

	| area labelBox x d w child |
	labelBox _ self boundingBox.
	area _ origin extent: offset.
	offset _ 0@0.
	boxed _ false.
	to size = 0 ifTrue:
		[self align: (labelBox perform: (msgs at: 1))
			  with: (area perform: (msgs at: 1)).
		toPt _ offset + (labelBox perform: (msgs at: 1)).
		^self perform: (msgs at: 2) with: labelBox extent with: delta].
	self align: (labelBox perform: (msgs at: 1))
		with: (area perform: (msgs at: 1)).
	toPt _ offset + (labelBox perform: (msgs at: 1)).
	fromPt _ offset + (labelBox perform: (self oppositeCenter: (msgs at: 1))).
	x _ self perform: (msgs at: 3)
			with: area
			with: labelBox extent
			with: delta.
	w _ 0.
	d _ self perform: (msgs at: 4) with: area origin.
	1 to: to size do:
		[ :n |
		child _ to at: n.
		child visited ifTrue:
			[child boxYourself.
			child _ child copy.
			child offset: child boundingBox extent + delta.
			child to: Array new.
			graph addNode: child.
			to at: n put: child].
		w _ w + (child setPosition: (self perform: (msgs at: 5)
										  with: x
										  with: d+w)
						withDelta: delta
						forGraph: graph
						formatMessages: msgs)].
	^w!

verticalFormat

	^Array
		with:
			#(	#vertExtent:with:
				#vertAdjustOffset:
				#vertAddLabel:with: )
		with:
			#(	#topCenter
				#vertWidth:with:
				#vertFixedSubOrigin:with:with:
				#vertVariableSubOrigin:
				#vertNewSubOrigin:with: )! !


!GraphNode methodsFor: 'graph formating'!

horizAddLabel: labelExtent with: delta
	"This message belongs in position 3 of extentOfGraph:"

	offset y: (offset y max: (labelExtent y + delta y)).
	offset x: offset x + labelExtent x + delta x!

horizAdjustOffset: subExtent
	"This message belongs in position 2 of extentOfGraph:"

	offset y: offset y + subExtent y.
	offset x: (offset x max: subExtent x)!

horizExtent: extent with: delta
	"This message belongs in position 1 for extentOfGraph:"

	^extent + (0 @ delta y)!

horizFixedSubOrigin: area with: extent with: delta
	"This message belongs in position 3 of extentOfGraph:"

	^area origin x + extent x + delta x!

horizNewSubOrigin: x with: y
	"This message belongs in position 5 of extentOfGraph:"

	^x @ y!

horizVariableSubOrigin: origin
	"This message belongs in position 4 of extentOfGraph:"

	^origin y!

horizWidth: extent with: delta
	"This message belongs in position 2 of setPosition:
	(Note that a message in Rectangle goes in position 1)"

	^extent y + delta y!

oppositeCenter: aSymbol

	aSymbol == #topCenter ifTrue: [^#bottomCenter].
	aSymbol == #leftCenter ifTrue: [^#rightCenter].
	aSymbol == #bottomCenter ifTrue: [^#topCenter].
	aSymbol == #rightCenter ifTrue: [^#leftCenter]!

revHorizFixedSubOrigin: area with: extent with: delta
	"This message belongs in position 3 of extentOfGraph:"

	^area origin x!

revVertFixedSubOrigin: area with: extent with: delta
	"This message belongs in position 3 of extentOfGraph:"

	^area origin y!

vertAddLabel: labelExtent with: delta
	"This message belongs in position 3 of extentOfGraph:"

	offset x: (offset x max: (labelExtent x + delta x)).
	offset y: offset y + labelExtent y + delta y!

vertAdjustOffset: subExtent
	"This message belongs in position 2 of extentOfGraph:"

	offset x: offset x + subExtent x.
	offset y: (offset y max: subExtent y)!

vertExtent: extent with: delta
	"This message belongs in position 1 for extentOfGraph:"

	^extent + (delta x @ 0)!

vertFixedSubOrigin: area with: extent with: delta
	"This message belongs in position 3 of extentOfGraph:"

	^area origin y + extent y + delta y!

vertNewSubOrigin: y with: x
	"This message belongs in position 5 of extentOfGraph:"

	^x @ y!

vertVariableSubOrigin: origin
	"This message belongs in position 4 of extentOfGraph:"

	^origin x!

vertWidth: extent with: delta
	"This message belongs in position 2 of setPosition:
	(Note that a message in Rectangle goes in position 1)"

	^extent x + delta x! !


!GraphNode methodsFor: 'graph hardcopy'!

psStoreOn: aStream

	| insetBox |
	insetBox _ (offset extent: self form boundingBox extent) insetBy: 2@2.
	boxed ifTrue:
		[offset x printOn: aStream.
		aStream space.
		offset y printOn: aStream.
		aStream space.
		insetBox corner x + 2 printOn: aStream.
		aStream space.
		insetBox corner y + 2 printOn: aStream.
		aStream space; nextPutAll: 'Box'; lf].
	insetBox origin x printOn: aStream.
	aStream space.
	insetBox origin y printOn: aStream.
	aStream space; nextPut: $(; nextPutAll: text string; nextPut: $);
		space; nextPutAll: 'Label'; lf.! !


!GraphNode methodsFor: 'private'!

composeForm

	| newForm |

	super composeForm.
	newForm _ Form extent: form boundingBox extent + (4@4).
	newForm white.
	form displayOn: newForm at: 2@2.
	form _ newForm!

from: fromNodes to: toNodes object: myObject label: label

	from _ fromNodes.
	to _ toNodes.
	object _ myObject.
	(label isKindOf: DisplayObject)
		ifTrue: [form _ label.
				offset _ 0@0]
		ifFalse: [self setText: label asText
				textStyle: DefaultTextStyle copy
				offset: 0@0]! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

GraphNode class
	instanceVariableNames: ''!


!GraphNode class methodsFor: 'instance creation'!

from: fromID object: obj

	^self from: (Array with: fromID) to: nil object: obj label: obj graphLabel!

from: fromID object: obj label: graphLabel

	^self from: (Array with: fromID) to: nil object: obj label: graphLabel!

from: fromIDs to: toIDs object: obj

	^self from: fromIDs to: toIDs object: obj label: obj graphLabel!

from: fromIDs to: toIDs object: obj label: label

	^self new from: fromIDs to: toIDs object: obj label: label!

new
	^super new initialize!

to: toID object: obj

	^self from: nil to: (Array with: toID) object: obj label: obj graphLabel! !
Object subclass: #EmptyGraphNode
	instanceVariableNames: 'graphLabel children '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Grapher'!


!EmptyGraphNode methodsFor: 'accessing'!

children

	^children!

graphLabel

	^graphLabel! !


!EmptyGraphNode methodsFor: 'initialize'!

initialize

	graphLabel _ (Form dotOfSize: 0).
	children _ #()! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

EmptyGraphNode class
	instanceVariableNames: ''!


!EmptyGraphNode class methodsFor: 'instance creation'!

new

	^super new initialize! !


!Object methodsFor: 'grapher access'!

children
	^self subclasses!

graphLabel
	^self name asText! !

messick@tekchips.UUCP (Steve Messick) (07/29/86)

Grapher is a Smalltalk tool to display data structures.  The
distribution consists of two parts: PART 1 contains the files README
and Grapher-2.st, PART 2 has only the file Grapher-1.st.  See
the README file for further information.

------------------------------ Grapher-1.st ------------------------------

ScrollController subclass: #XAxisScrollController
	instanceVariableNames: 'xScrollBar xMarker xSavedArea '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Grapher'!
XAxisScrollController comment:
'I represent control for scrolling using an x-axis scroll bar.  I am a subclass of ScrollController that creates an x-axis scroll bar.  My subclasses then have x and y-axis
scroll bars.  I keep control as long as the cursor is inside the view or either one of the scroll bars.

The y-axis scroll bar is a rectangular area representing the length of the information being viewed.  It contains an inner rectangle whose top y-coordinate represents the relative position of the information visible on the screen with respect to all of the information, and whose size represents the relative amount of that information visible on the screen.  The user controls which part of the information is visible by pressing the red button.  If the cursor is to the right of the inner rectangle, the windo



w onto the visible information moves upward, if the cursor is to the left, the window moves downward, and if the cursor is inside, the inner rectangle is grabbed and moved to a desired position.  The x-axis scroll bar is controlled in an analogous manner.  

Instance Variables:
	xScrollBar	<Quadrangle> inside white, the outer rectangle
	xMarker		<Quadrangle> inside gray, the inner rectangle
	xSavedArea	<Form> the area the xScrollBar overlaps, restored whenever
				the xScrollBar is hidden
	'!


!XAxisScrollController methodsFor: 'initialize-release'!

initialize
	super initialize.
	xScrollBar _ Quadrangle new.
	xScrollBar borderWidthLeft: 2 right: 2 top: 0 bottom: 2.
	xMarker _ Quadrangle new.
	xMarker insideColor: Form gray! !


!XAxisScrollController methodsFor: 'basic control sequence'!

controlInitialize
	"The scrollbar has a two-pixel border, and for alignment it assumes that this sub-view
	has a one-pixel border and shares another one-pixel border from its neighbor/super view"
	super controlInitialize.
	xScrollBar region: (0 @ 0 extent: (view displayBox width + 2) @ 32). 
	xMarker region: self computeXMarkerRegion.
	xScrollBar _ xScrollBar align: xScrollBar topLeft with: view displayBox bottomLeft - (1@0).
	xMarker _ xMarker align: xMarker leftCenter with: xScrollBar inside leftCenter.
	xSavedArea _ Form fromDisplay: xScrollBar.
	xScrollBar displayOn: Display.
	self moveXMarker!

controlTerminate
	super controlTerminate.
	xSavedArea notNil 	
		ifTrue: 
			[xSavedArea displayOn: Display at: xScrollBar topLeft.
			xSavedArea_ nil]! !


!XAxisScrollController methodsFor: 'control defaults'!

controlActivity

	self xScrollBarContainsCursor
		ifTrue: [self xScroll]
		ifFalse: [super controlActivity]!

isControlActive

	^self xScrollBarContainsCursor or: [super isControlActive]! !


!XAxisScrollController methodsFor: 'scroll bar region'!

repaintUnderScrollBar
	"Repaint the area under the scroll bar ."

	super repaintUnderScrollBar.
	self repaintUnderXScrollBar!

repaintUnderXScrollBar
	"Repaint the area under the scroll bar ."

	xSavedArea notNil 	
		ifTrue: 
			[xSavedArea displayOn: Display at: xScrollBar topLeft.
			xSavedArea_ nil]! !


!XAxisScrollController methodsFor: 'scrolling'!

canXScroll
	"Answer whether there is information that is not visible and can be seen
	by scrolling."
	^xMarker region width < xScrollBar inside width!

scrollViewLeft
	"Scroll the receiver's view left the default amount."
	self xScrollView: self xScrollAmount negated!

scrollViewNoDisplay: delta

	| t2 |
	delta ~= 0
		ifTrue: 
			[t2 _ (delta min: view window top - model boundingBox top)
						max: view window top - model boundingBox bottom.
			view scrollBy: 0 @ t2]!

scrollViewRight
	"Scroll the receiver's view right the default amount."
	self xScrollView: self xScrollAmount!

viewXDelta
	"Answer an integer that indicates how much the view should be scrolled.
	The scroll bar has been moved and now the view must be so the amount to
	scroll is computed as a ratio of the current scroll bar position."

	^view window left - view boundingBox left -
		((xMarker left - xScrollBar inside left) asFloat /
			xScrollBar inside width asFloat *
				view boundingBox width asFloat) rounded!

xScroll
	"Check to see whether the user wishes to jump, scroll left, or scroll right."

	| savedCursor regionPercent |
	savedCursor _ sensor currentCursor.
	[self xScrollBarContainsCursor]
		whileTrue: 
			[Processor yield.
			regionPercent _ 100 * (xScrollBar inside bottom  - sensor cursorPoint y) // xScrollBar height.
			regionPercent <= 40
				ifTrue: [self scrollLeft]
				ifFalse: [regionPercent >= 60
							ifTrue: [self scrollRight]
							ifFalse: [self xScrollAbsolute]]].
	savedCursor show!

xScrollAmount
	"Answer the number of bits of x-coordinate should be scrolled.  This is a 
	default determination based on the view's preset display transformation."

	^((view inverseDisplayTransform: sensor cursorPoint)
		- (view inverseDisplayTransform: xScrollBar inside leftCenter)) x!

xScrollView
	"The scroll bar jump method was used so that the view should be updated to
	correspond to the location of the scroll bar gray area."
	self xScrollView: self viewXDelta!

xScrollView: anInteger 
	"If anInteger is not zero, tell the receiver's view to scroll by anInteger amount."

	anInteger ~= 0
		ifTrue: 
			[view scrollBy: ((anInteger min: view window left - view boundingBox left)
						max: view window left - view boundingBox right) @ 0.
			view clearInside.
			view display]! !


!XAxisScrollController methodsFor: 'cursor'!

xMarkerContainsCursor
	"Answer whether the gray area inside the scroll bar area contains the cursor."
	^xMarker inside containsPoint: sensor cursorPoint!

xScrollBarContainsCursor
	"Answer whether the cursor is anywhere within the scroll bar area."
	^xScrollBar inside containsPoint: sensor cursorPoint! !


!XAxisScrollController methodsFor: 'marker adjustment'!

computeXMarkerRegion
	"Answer the rectangular area in which the gray area of the scroll bar
	should be displayed."

	^0@0 extent: ((view window width asFloat /
						view boundingBox width *
							xScrollBar inside width)
				 rounded min: xScrollBar inside width) @ 10!

moveXMarker
	"The view window has changed.  Update the xMarker."

	self moveXMarker: self xMarkerDelta negated!

moveXMarker: anInteger
	"Update the xMarker so that is is translated by an amount corresponding to
	a distance of anInteger, constrained within the boundaries of the scroll bar."

	Display fill: xMarker mask: xScrollBar insideColor.
	xMarker _ xMarker translateBy: ((anInteger min: xScrollBar inside right - xMarker right) max:
					xScrollBar inside left - xMarker left) @ 0.
	xMarker displayOn: Display!

xMarkerDelta
	^xMarker left 
		- xScrollBar inside left  
		- ((view window left - view boundingBox left) asFloat 
			/ view boundingBox width asFloat *
				xScrollBar inside width asFloat) rounded!

xMarkerRegion: aRectangle 
	"Set the area defined by aRectangle as the xMarker.  Fill it with gray tone."

	Display fill: xMarker mask: xScrollBar insideColor.
	xMarker region: aRectangle.
	xMarker _ xMarker align: xMarker leftCenter with: xScrollBar inside leftCenter! !


!XAxisScrollController methodsFor: 'private'!

scrollLeft
	"This is modified from the original to provide continuous scrolling"
	self changeCursor: Cursor left.
	sensor anyButtonPressed 
		ifTrue: [self canXScroll
					ifTrue: 
						[self scrollViewLeft.
						self moveXMarker]].
	sensor waitNoButton!

scrollRight
	"This is modified from the original to provide continuous scrolling"
	self changeCursor: Cursor right.
	sensor anyButtonPressed
		ifTrue: [self canXScroll
					ifTrue: 
						[self scrollViewRight.
						self moveXMarker]].
	sensor waitNoButton!

xAndYScrollAbsolute

	| oldMarker oldXMarker savedCursor |
	(((self canXScroll) or: [self canScroll])
			and: [sensor redButtonPressed]) ifTrue:
		[savedCursor _ sensor currentCursor.
		self changeCursor: Cursor fourWay.
		[sensor redButtonPressed] whileTrue:
			[oldMarker _ marker.
			oldXMarker _ xMarker.
			marker _ marker translateBy:
				0@((sensor cursorPoint y - marker center y
						min: scrollBar inside bottom - marker bottom)
							max: scrollBar inside top - marker top).
			xMarker _ xMarker translateBy:
				((sensor cursorPoint x - xMarker center x
					min: xScrollBar inside right - xMarker right)
						max: xScrollBar inside left - xMarker left) @ 0.
			(oldMarker areasOutside: marker),
			(marker areasOutside: oldMarker),
			(oldXMarker areasOutside: xMarker),
			(xMarker areasOutside: oldXMarker) do:
				[:region | Display fill: region rule: Form reverse mask: Form gray].
			self scrollViewNoDisplay: self viewDelta.
			self xScrollView.
			scrollBar display.
			xScrollBar display.
			self moveMarker.
			self moveXMarker].
		savedCursor show]!

xScrollAbsolute
	| oldMarker |
	self changeCursor: Cursor xMarker.
	self canXScroll & sensor anyButtonPressed ifTrue:
		[[sensor anyButtonPressed] whileTrue:
			[oldMarker _ xMarker.
			xMarker _ xMarker translateBy:
				((sensor cursorPoint x - xMarker center x min:
					xScrollBar inside right - xMarker right) max: xScrollBar inside left - xMarker left) @ 0.
			(oldMarker areasOutside: xMarker), (xMarker areasOutside: oldMarker) do:
				[:region | Display fill: region rule: Form reverse mask: Form gray]].
			self xScrollView.
			xScrollBar display.
			self moveXMarker]! !
XAxisScrollController subclass: #GraphHolderController
	instanceVariableNames: 'scrollBox selection selectionMenu '
	classVariableNames: 'YellowButtonMenu '
	poolDictionaries: ''
	category: 'Grapher'!
GraphHolderController comment:
'As a subclass of XAxisScrollController I provide X and Y axis scrolling.  In addition, I provide ''smooth'' scrolling by red button dragging of the mouse.  I also am capable of responding to red button clicks to select an element of the display if I have a menu to activate for selections.  The menu is initialized by my selectionMenu: message which takes an ActionMenu as its argument. The message selectors included with the ActionMenu must be messages that the objects which make up the graph respond to.

My instance variables:

	scrollBox	<Rectangle>
				My scrollBox represents the area of the display which
				is visible on the screen.  It is in local view coordinates.
	selection	<GraphNode>
				If an element of the display has been selected by clicking
				the mouse red button on it, it is saved here.
	selectionMenu <Array of (PopUpMenu, Array of message selectors)>
				The yellow button menu to be activated when a selection
				has been made and the yellow button is pressed.  Menu
				messages are sent to the object field of the selected
				GraphNode.  If selectionMenu is nil the window does not
				respond to red button clicks (although red button scrolling
				is still available).

'!


!GraphHolderController methodsFor: 'initialize-release'!

initialize
	"I use an ActionMenu rather than a PopUpMenu so no
	yellowButtonMessages are needed."

	yellowButtonMenu _ YellowButtonMenu.
	scrollBox _ 0@0 extent: 0@0.
	super initialize! !


!GraphHolderController methodsFor: 'accessing'!

scrollBox: aRectangle
	"My scrollBox is a Rectangle which pans over the virtual display of
	my model.  My view looks through my scrollBox at the model.  Normally,
	my window would perform this function, but windows get scaled and
	I required an unscaled scrollBox."

	scrollBox _ Rectangle origin: 0@0 extent: aRectangle extent!

selection

	^selection!

selectionMenu: anActionMenu

	selectionMenu _ anActionMenu! !


!GraphHolderController methodsFor: 'basic control sequence'!

controlInitialize

	selection == nil ifFalse: [self darkHighlightSelection].
	super controlInitialize!

controlTerminate

	selection == nil ifFalse: [self dimHighlightSelection]. 
	super controlTerminate! !


!GraphHolderController methodsFor: 'control defaults'!

controlActivity

	| cursorPoint xlate newSelection |
	sensor redButtonPressed ifTrue:
		[sensor leftShiftDown | (selectionMenu == nil)
			ifTrue: [^self xAndYScrollAbsolute].
		cursorPoint _ (sensor cursorPoint
							translateBy: scrollBox origin
										- view displayTransformation translation
										- model offset) rounded.
		newSelection _ model selectNodeAt: cursorPoint.
		self setSelection: newSelection.
		newSelection == nil
			ifTrue: [self xAndYScrollAbsolute]
			ifFalse: [[sensor redButtonPressed & self isControlActive]
						whileTrue]].
	super controlActivity!

isControlActive

	^sensor blueButtonPressed not and: [super isControlActive]! !


!GraphHolderController methodsFor: 'menu messages'!

fileOutGraph
	"Produce a PostScript file which will make a hardcopy version of my model."

	| aStream |
	Cursor write showWhile:
		[aStream _ FileStream fileNamed: 'diagps.script'.
		model psStoreOn: aStream.
		aStream close]!

localMenuItem: aSelector

	^ #( #mvcInspect #fileOutGraph ) includes: aSelector!

menuMessageReceiver

	selection == nil
		ifTrue: [^self]
		ifFalse: [sensor leftShiftDown
			ifTrue: [^selection]
			ifFalse: [^selection object]]!

mvcInspect

	self controlTerminate.
	sensor leftShiftDown
		ifTrue: [view superView inspect]
		ifFalse: [view inspect]!

yellowButtonActivity
	"Determine which item in the yellow button pop-up menu is selected.
	If one is selected, then send the corresponding message to the object
	designated as the menu message receiver."

	| index selector |
	yellowButtonMenu == nil
		ifFalse: 
			[index _ yellowButtonMenu startUpYellowButton.
			index ~= 0 
				ifTrue:
					[selector _ yellowButtonMenu selectorAt: index.
					(self localMenuItem: selector)
						ifTrue: [self perform: selector]
						ifFalse: [self controlTerminate.
								selector numArgs = 1
									ifTrue: [self menuMessageReceiver perform: selector with: model]
									ifFalse: [self menuMessageReceiver perform: selector].
								self controlInitialize]]]! !


!GraphHolderController methodsFor: 'marker adjustment'!

computeMarkerRegion

	^Rectangle
		origin: 0 @ 0
		extent: 10 @ ((scrollBox height asFloat /
							view boundingBox height asFloat *
								scrollBar inside height) rounded
						min: scrollBar inside height)!

computeXMarkerRegion

	^Rectangle
		origin: 0 @ 0
		extent: ((scrollBox width asFloat /
							view boundingBox width asFloat *
								xScrollBar inside width) rounded
						min: xScrollBar inside width) @ 10!

markerDelta
	^marker top
		- scrollBar inside top
		- (scrollBox top - view boundingBox top asFloat 
			/ view boundingBox height asFloat *
				scrollBar inside height asFloat) rounded!

xMarkerDelta
	^xMarker left 
		- xScrollBar inside left  
		- (scrollBox left - view boundingBox left asFloat 
			/ view boundingBox width asFloat
			* xScrollBar inside width asFloat) rounded! !


!GraphHolderController methodsFor: 'scrolling'!

scrollAmount

	^(sensor cursorPoint - scrollBar inside topCenter) y!

scrollBy: amount

	scrollBox _ scrollBox translateBy: amount!

scrollView: anInteger 
	"If anInteger is not zero, scroll by anInteger amount."

	| min max amount |
	max _ view boundingBox top - scrollBox top min: 0.
	min _ view boundingBox bottom - scrollBox bottom max: 0.
	amount _ (anInteger negated max: max) min: min.
	amount ~= 0
		ifTrue: 
			[self scrollBy: 0 @ amount.
			view clearInside.
			view display]!

scrollViewNoDisplay: anInteger 

	| min max amount |
	max _ view boundingBox top - scrollBox top min: 0.
	min _ view boundingBox bottom - scrollBox bottom max: 0.
	amount _ (anInteger negated max: max) min: min.
	amount ~= 0
		ifTrue: 
			[self scrollBy: 0 @ amount]!

scrollViewXY: aPoint 

	| amount ymax ymin xmax xmin |
	ymax _ view boundingBox top - scrollBox top min: 0.
	ymin _ view boundingBox bottom - scrollBox bottom max: 0.
	xmax _ view boundingBox left - scrollBox left min: 0.
	xmin _ view boundingBox right - scrollBox right max: 0.
	amount _ Point x: ((aPoint x negated max: xmax) min: xmin) rounded
					y: ((aPoint y negated max: ymax) min: ymin) rounded.
	amount ~= (0@0)
		ifTrue: 
			[self scrollBy: amount.
			view clearInside.
			view display]!

viewDelta
	"Answer an integer that indicates how much the view should be scrolled.
	The scroll bar has been moved and now the view must be so the amount to
	scroll is computed as a ratio of the current scroll bar position."

	^scrollBox top - view boundingBox top - 
		((marker top - scrollBar top) asFloat
			/ scrollBar height asFloat
			* view boundingBox height asFloat) rounded!

viewXDelta
	"Answer an integer that indicates how much the view should be scrolled.
	The scroll bar has been moved and now the view must be so the amount to
	scroll is computed as a ratio of the current scroll bar position."

	^scrollBox left - view boundingBox left
		- ((xMarker left - xScrollBar left) asFloat
			/ xScrollBar width asFloat
			* view boundingBox width asFloat) rounded!

xScrollAmount

	^(sensor cursorPoint - scrollBar inside leftCenter) x!

xScrollView: anInteger 
	"If anInteger is not zero, scroll by anInteger amount."

	| min max amount |
	max _ view boundingBox left - scrollBox left min: 0.
	min _ view boundingBox right - scrollBox right max: 0.
	amount _ (anInteger negated max: max) min: min.
	amount ~= 0
		ifTrue: 
			[self scrollBy: amount @ 0.
			view clearInside.
			view display]! !


!GraphHolderController methodsFor: 'displaying'!

displayOn: aDisplayMedium transformation: aDisplayTransformation clippingBox: clippingBox rule: ruleInteger mask: halfTone

	| location |
	location _ aDisplayTransformation applyTo: scrollBox origin x negated @ scrollBox origin y negated.
	model form
		displayOn: aDisplayMedium
		at: location
		clippingBox: clippingBox
		rule: ruleInteger
		mask: halfTone.
	selection == nil ifFalse: [self darkHighlightSelection]! !


!GraphHolderController methodsFor: 'private'!

darkHighlightSelection

	| selectBox  |
	selectBox _ (selection boundingBox
					translateBy: selection offset +
								  model offset +
								  view displayTransformation translation -
								  scrollBox origin) rounded.
	(selection form) displayOn: Display
					at: (selectBox origin)
					clippingBox: (selectBox intersect: view insetDisplayBox)
					rule: 12
					mask: Form black!

deHighlightSelection

	| selectBox  |
	selectBox _ (selection boundingBox
					translateBy: selection offset +
								  model offset +
								  view displayTransformation translation -
								  scrollBox origin) rounded.
	(selection form) displayOn: Display
					at: (selectBox origin)
					clippingBox: (selectBox intersect: view insetDisplayBox)
					rule: Form over
					mask: Form black!

dimHighlightSelection

	| selectBox  newForm |
	selectBox _ (selection boundingBox
					translateBy: selection offset +
								  model offset +
								  view displayTransformation translation -
								  scrollBox origin) rounded.
	newForm _ selection form deepCopy.
	newForm fill: (newForm boundingBox)
			rule: Form under
			mask: Form lightGray.
	newForm displayOn: Display
					at: (selectBox origin)
					clippingBox: (selectBox intersect: view insetDisplayBox)
					rule: Form over
					mask: Form black!

setSelection: aGraphNode
	"Set the currently selected node to aGraphNode and set
	the yellowButtonMenu."

	selection == nil
		ifFalse: [self deHighlightSelection].
	selection _ aGraphNode.
	selection == nil
		ifTrue: [yellowButtonMenu _ YellowButtonMenu]
		ifFalse: [self darkHighlightSelection.
				yellowButtonMenu _ selectionMenu]!

xAndYScrollAbsolute

	| savedCursor oldMarker oldXMarker cursorPoint delta |
	((self canXScroll or: [self canScroll])
			and: [sensor redButtonPressed]) ifTrue:
		[savedCursor _ sensor currentCursor.
		self changeCursor: Cursor fourWay.
		cursorPoint _ sensor cursorPoint.
		[sensor redButtonPressed and: [self isControlActive]] whileTrue:
			[[(sensor cursorPoint - cursorPoint) abs < (1@1)
				and: [sensor redButtonPressed]] whileTrue.
			delta _ cursorPoint.
			delta _ (cursorPoint _ sensor cursorPoint) - delta.
			self scrollViewXY: delta.
			self moveMarker.
			self moveXMarker].
		savedCursor show]! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

GraphHolderController class
	instanceVariableNames: ''!


!GraphHolderController class methodsFor: 'class initialization'!

initialize
	"GraphController initialize."

	YellowButtonMenu _ ActionMenu
		labels: 'inspect\file out' withCRs
		selectors: #( #mvcInspect #fileOutGraph )! !


GraphHolderController initialize!
View subclass: #GraphHolderView
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Grapher'!
GraphHolderView comment:
'I provide a resizable View on graphical objects, without scaling the object.  To do this I maintain the standard cooridinate transformations of View, but I use only a transformation with unit scaling for display purposes.

Used as a subview of a StandardSystemView, I should be added via the addSubView:in:borderWidth: message to ensure proper rescaling during a resize operation.
'!


!GraphHolderView methodsFor: 'initialize-release'!

release
	"If the #noform change protocol has been used, there is a circularity
	in the Graph so release it, too."

	model release.
	super release! !


!GraphHolderView methodsFor: 'window access'!

defaultWindow

	^model boundingBox! !


!GraphHolderView methodsFor: 'controller access'!

defaultControllerClass

	^GraphHolderController! !


!GraphHolderView methodsFor: 'display box access'!

computeBoundingBox

	^boundingBox _ model boundingBox! !


!GraphHolderView methodsFor: 'displaying'!

display

	self isUnlocked ifTrue:
		[boundingBox _ nil.
		viewport _ nil.
		self controller scrollBox: self insetDisplayBox].
	super display!

displayView
	"We always want to see the Graph at unit scale."

	controller
		displayOn: Display
		transformation: self displayTransformation copy scaleOfOne
		clippingBox: self insetDisplayBox
		rule: Form over
		mask: Form black! !


!GraphHolderView methodsFor: 'updating'!

update: how
	"Graph's change protocol includes #form and #noform.  #form indicates
	that the view is actually displaying a Form and does not need to clear
	its inside during scrolling.  #noform indicates that the Graph is being
	redisplayed each time the View scrolls, and the View must clear its
	inside before redisplaying the Graph.  The boundingBox is always reset
	because the size of the Graph changed."

	how == #form ifTrue:
		[boundingBox _ nil.
		self insideColor: nil.
		^self].
	how == #noform ifTrue:
		[boundingBox _ nil.
		self insideColor: Form white.
		^self]! !


!GraphHolderView methodsFor: 'model access'!

erase

	"I replace the current model with a model constructed of the EmptyGraph."

	model isEmpty
		ifFalse: [ self replaceModel: (GraphHolder createEmpty)]!

replaceModel: newModel

	"I replace the model in the view with a new model."

	self model: newModel.
	self update: #noform.
	self clearInside.
	self display! !

"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!

GraphHolderView class
	instanceVariableNames: ''!


!GraphHolderView class methodsFor: 'instance creation'!

openOn: roots label: labelString
	"Create a Graph viewing the DAG rooted in roots.  Label the
	GraphView with labelString.  The default lay out is horizontal.
	See the comment in GraphView class.open:label:menu:"

	self openOn: roots label: labelString format: #( #horizontal )!

openOn: roots label: labelString format: formatSymbols
	"By default, Graph windows do not respond to mouse clicks
	(except for the yellow button menu)."

	self openOn: roots label: labelString format: formatSymbols menu: nil!

openOn: roots label: labelString format: formatSymbols menu: anActionMenu
	"The default messages used to build a graph are #children and
	#graphLabel.  #children returns a Colleciton of child nodes.
	#graphLabel returns a Text to be used as the label in the GraphView."

	self openOn: roots
		label: labelString
		format: formatSymbols
		menu: anActionMenu
		childrenMsg: #children
		labelMsg: #graphLabel!

openOn: roots label: labelString format: formatSymbols menu: actionMenu childrenMsg: childrenMsg labelMsg: labelMsg

	self open: (self createModel: roots
					children: childrenMsg
					label: labelMsg
					format: formatSymbols)
		label: labelString
		menu: actionMenu! !


!GraphHolderView class methodsFor: 'private'!

createModel: roots children: childrenMsg label: labelMsg format: formatSymbols

	| aGraph |
	aGraph _ GraphHolder createForestWithRoots: roots
					children: childrenMsg
					label: labelMsg.
	aGraph layout: formatSymbols.
	^aGraph!

open: aGraph label: labelString menu: anActionMenu
	"Open a scrollable, resizeable view displaying the data structure
	in aGraph.  To make the elements sensitive to mouse clicks anActionMenu
	non nil. The message selected from the menu will be sent to the selected
	element.  If anActionMenu is nil mouse clicks are ignored."

	| formView topView |
	formView _ self new model: aGraph.
	formView controller selectionMenu: anActionMenu.
	topView _ StandardSystemView new label: labelString.
	topView borderWidth: 1.
	topView insideColor: Form white.
	"formView is added as follows to ensure proper scaling of
	the view when the topView is resized (via 'frame')."
	topView addSubView: formView in: (0@0 extent: 1@1) borderWidth: 1.
	topView controller open! !
#('FourWay' 'LeftCursor' 'RightCursor' 'XMarkerCursor') do:
	[ :var | Cursor addClassVarName: var].!


!Cursor class methodsFor: 'constants'!

fourWay
	"Answer the instance of me that is the shape of four connected arrows."
	^FourWay! !


!Cursor class methodsFor: 'constants'!

left
	"Answer the instance of me that is the shape of an arrow facing to the left."
	^LeftCursor! !


!Cursor class methodsFor: 'constants'!

right
	"Answer the instance of me that is the shape of an arrow facing to the right."
	^RightCursor! !


!Cursor class methodsFor: 'constants'!

xMarker
	"Answer the instance of me that is displayed when thumb-scrolling on the x-axis."
	^XMarkerCursor! !


!Cursor class methodsFor: 'class initialization'!

initialize
	"Create all the standard cursors
		Cursor blank
		Cursor corner
		Cursor crossHair
		Cursor down
		Cursor execute
		Cursor fourWay
		Cursor left
		Cursor marker
		Cursor normal
		Cursor origin
		Cursor read
		Cursor right
		Cursor square
		Cursor up
		Cursor wait
		Cursor write
		Cursor xMarker"

	OriginCursor _   
		(Cursor
			extent: 16@16
			fromArray: #(
		2r1111111111111111
		2r1111111111111111
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000)
			offset: -2@-2).

	CornerCursor _ 
		(Cursor 
			extent: 16@16
			fromArray: #(
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r0000000000000011
		2r1111111111111111
		2r1111111111111111)
			offset: -14@-14).

	ReadCursor _  
		(Cursor
			extent: 16@16
			fromArray: #(
		2r0000110000000110
		2r0001001000001001
		2r0001001000001001
		2r0010000000010000
		2r0100000000100000
		2r1111101111100000
		2r1000010000100000
		2r1000010000100000
		2r1011010110100000
		2r0111101111000000
		2r0
		2r0
		2r0
		2r0
		2r0
		2r0)
	offset: 0@0).

	WriteCursor _ (Cursor
	extent: 16@16
	fromArray: #(
		2r0000000000000110
		2r0000000000001111
		2r0000000000010110
		2r0000000000100100
		2r0000000001001000
		2r0000000010010000
		2r0000000100100000
		2r0000001001000011
		2r0000010010000010
		2r0000100100000110
		2r0001001000001000
		2r0010010000001000
		2r0111100001001000
		2r0101000010111000
		2r0110000110000000
		2r1111111100000000)
	offset: 0@0).

	WaitCursor _ 
		  (Cursor
			extent: 16@16
			fromArray: #(
		2r1111111111111111
		2r1000000000000001
		2r0100000000000010
		2r0010000000000100
		2r0001110000111000
		2r0000111101110000
		2r0000011011100000
		2r0000001111000000
		2r0000001111000000
		2r0000010110100000
		2r0000100010010000
		2r0001000110001000
		2r0010001101000100
		2r0100111111110010
		2r1011111111111101
		2r1111111111111111)
			offset: 0@0).

	BlankCursor _ Cursor new.

	XeqCursor _ 
		(Cursor
			extent: 16@16
			fromArray: #(
		2r1000000000010000
		2r1100000000010000
		2r1110000000111000
		2r1111000111111111
		2r1111100011000110
		2r1111110001000100
		2r1111111001111100
		2r1111000001101100
		2r1101100011000110
		2r1001100010000010
		2r0000110000000000
		2r0000110000000000
		2r0000011000000000
		2r0000011000000000
		2r0000001100000000
		2r0000001100000000)
	offset: 0@0).

	SquareCursor _ 
		(Cursor
			extent: 16@16
			fromArray: #(
		2r0
		2r0
		2r0
		2r0
		2r0
		2r0000001111000000
		2r0000001111000000
		2r0000001111000000
		2r0000001111000000
		2r0
		2r0
		2r0
		2r0
		2r0
		2r0
		2r0)
	offset: -8@-8).

	NormalCursor _   
		(Cursor
			extent: 16@16
			fromArray: #(
		2r1000000000000000
		2r1100000000000000
		2r1110000000000000
		2r1111000000000000
		2r1111100000000000
		2r1111110000000000
		2r1111111000000000
		2r1111100000000000
		2r1111100000000000
		2r1001100000000000
		2r0000110000000000
		2r0000110000000000
		2r0000011000000000
		2r0000011000000000
		2r0000001100000000
		2r0000001100000000)
	offset: 0@0).

	CrossHairCursor _   
		(Cursor
			extent: 16@16
			fromArray: #(
		2r0000000100000000
		2r0000000100000000
		2r0000000100000000
		2r0000000100000000
		2r0000000100000000
		2r0000000100000000
		2r0000000100000000
		2r1111111111111110
		2r0000000100000000
		2r0000000100000000
		2r0000000100000000
		2r0000000100000000
		2r0000000100000000
		2r0000000100000000
		2r0000000100000000
		2r0)
			offset: -7@-7).

	MarkerCursor _ 
		Cursor
			extent: 16@16
			fromArray: #(
		2r0
		2r0
		2r0
		2r0000001000000000
		2r0000001110000000
		2r0000001111100000
		2r1111111111111000
		2r1111111111111110
		2r1111111111111000
		2r0000001111100000
		2r0000001110000000
		2r0000001000000000
		2r0
		2r0
		2r0
		2r0)
			offset: -7@-7.

	UpCursor _ 
		Cursor 
			extent: 16@16
			fromArray: #(
		2r1000000000000000
		2r1100000000000000
		2r1110000000000000
		2r1111000000000000
		2r1111100000000000
		2r1111110000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000
		2r1100000000000000)
	 		offset: 0@-7.

	DownCursor _
		 Cursor 
			extent: 16@16
			fromArray: #(
		2r0000110000000000
		2r0000110000000000
		2r0000110000000000
		2r0000110000000000
		2r0000110000000000
		2r0000110000000000
		2r0000110000000000
		2r0000110000000000
		2r0000110000000000
		2r0000110000000000
		2r1111110000000000
		2r0111110000000000
		2r0011110000000000
		2r0001110000000000
		2r0000110000000000
		2r0000010000000000)
			offset: -5@-7.

	LeftCursor _ 
		Cursor 
			extent: 16@16
			fromArray: #(
		2r1111111111111111
		2r0111111111111111
		2r0011110000000000
		2r0001110000000000
		2r0000110000000000
		2r0000010000000000
		2r0000000000000000
		2r0000000000000000
		2r0000000000000000
		2r0000000000000000
		2r0000000000000000
		2r0000000000000000
		2r0000000000000000
		2r0000000000000000
		2r0000000000000000
		2r0000000000000000)
	 		offset: -7@0.

	RightCursor _
		 Cursor 
			extent: 16@16
			fromArray: #(
		2r0000000000100000
		2r0000000000110000
		2r0000000000111000
		2r0000000000111100
		2r1111111111111110
		2r1111111111111111
		2r0000000000000000
		2r0000000000000000
		2r0000000000000000
		2r0000000000000000
		2r0000000000000000
		2r0000000000000000
		2r0000000000000000
		2r0000000000000000
		2r0000000000000000
		2r0000000000000000)
			offset: -7@-5.
	XMarkerCursor _ 
		Cursor
			extent: 16@16
			fromArray: #(
		2r0
		2r0000000100000000
		2r0000000100000000
		2r0000001110000000
		2r0000001110000000
		2r0000011111000000
		2r0000011111000000
		2r0000111111100000
		2r0000111111100000
		2r0001111111110000
		2r0000001110000000
		2r0000001110000000
		2r0000001110000000
		2r0000001110000000
		2r0000001110000000
		2r0000001110000000)
			offset: -7@-7.
	FourWay _ 
		Cursor
			extent: 16@16
			fromArray: #(
		2r0000000100000000
		2r0000001110000000
		2r0000011111000000
		2r0000111111100000
		2r0001001110010000
		2r0011001110011000
		2r0111111111111100
		2r1111111111111110
		2r0111111111111100
		2r0011001110011000
		2r0001001110010000
		2r0000111111100000
		2r0000011111000000
		2r0000001110000000
		2r0000000100000000
		2r0000000000000000)
			offset: -7@-7.

"Cursor initialize"! !
Cursor initialize.!