--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/GraphColumn.st Sat Feb 07 16:16:52 1998 +0100
@@ -0,0 +1,535 @@
+Model subclass:#GraphColumn
+ instanceVariableNames:'aspects functionYblock'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Graphs'
+!
+
+
+!GraphColumn class methodsFor:'instance creation'!
+
+name:aName
+ ^ self new name:aName
+!
+
+new
+ ^ super basicNew initialize
+! !
+
+!GraphColumn class methodsFor:'menu definitions'!
+
+colorMenuSelector:aSelector
+ "specification used to build the Menu
+ "
+ ^ ColorMenu colorMenu:true value:aSelector.
+!
+
+middleButtonMenu
+ "this window spec was automatically generated by the ST/X MenuEditor"
+
+ "do not manually edit this - the builder may not be able to
+ handle the specification if its corrupted."
+
+ "
+ MenuEditor new openOnClass:GraphColumn andSelector:#middleButtonMenu
+ (Menu new fromLiteralArrayEncoding:(GraphColumn middleButtonMenu)) startUp
+ "
+
+ <resource: #menu>
+
+ ^
+
+ #(#Menu
+
+ #(
+ #(#MenuItem
+ #'label:' 'Style'
+ #'argument:' #'lineStyle:'
+ #'submenuChannel:' #'styleMenuSelector:'
+ )
+ #(#MenuItem
+ #'label:' 'Size'
+ #'argument:' #'lineWidth:'
+ #'submenuChannel:' #'widthMenuSelector:'
+ )
+ #(#MenuItem
+ #'label:' 'Color'
+ #'argument:' #'foregroundColor:'
+ #'submenuChannel:' #'colorMenuSelector:'
+ )
+ #(#MenuItem
+ #'label:' 'Zoom Y'
+ #'argument:' #'zoomY:'
+ #'submenuChannel:' #'zoomMenuSelector:'
+ )
+ ) nil
+ nil
+ )
+!
+
+styleMenuSelector:aSelector
+ |menu width height item bitmap|
+
+ menu := Menu new.
+ width := 40.
+ height := 10.
+
+ #( #solid #dashed ) do:[:style|
+ bitmap := Form width:width height:height depth:1.
+ bitmap paint:(Color colorId:1).
+ bitmap fillRectangleX:0 y:0 width:width height:height.
+
+ bitmap paint:(Color colorId:0).
+ bitmap fillRectangleX:0 y:0 width:width height:height.
+ bitmap paint:(Color colorId:1).
+ bitmap lineWidth:2.
+ bitmap lineStyle:style.
+ bitmap displayLineFromX:2 y:(height // 2) toX:width-2 y:(height // 2).
+ item := MenuItem labeled:bitmap.
+ item value:aSelector.
+ item argument:style.
+ menu addItem:item.
+ ].
+ ^ menu
+
+"
+(self styleMenuSelector:#lineStyle) startUp
+"
+
+!
+
+widthMenuSelector:aSelector
+ |menu width item bitmap|
+
+ menu := Menu new.
+ width := 40.
+
+ #( 1 2 3 4 5 6 ) do:[:height|
+ bitmap := Form width:width height:height depth:1.
+ bitmap paint:(Color colorId:1).
+ bitmap fillRectangleX:0 y:0 width:width height:height.
+
+ item := MenuItem labeled:bitmap.
+ item value:aSelector.
+ item argument:height.
+ menu addItem:item.
+ ].
+ item := MenuItem labeled:'other ..'.
+ item value:[:arg :panel||n|
+ n := Number fromString:(Dialog request:'size:') onError:nil.
+
+ n notNil ifTrue:[
+ panel receiver perform:aSelector with:n
+ ]
+ ].
+ menu addItem:item.
+ ^ menu
+
+"
+(self widthMenuSelector:#lineWidth) startUp
+"
+
+!
+
+zoomMenuSelector:aSelector
+ "specification used to build the Menu
+ "
+ |menu width item bitmap|
+
+ menu := Menu new.
+ width := 40.
+
+ #( 25 50 75 nil 100 nil 150 200 nil ) do:[:zY|
+ zY notNil ifTrue:[
+ item := MenuItem labeled:(zY printString, ' %' ).
+ item value:aSelector.
+ item argument:(zY / 100).
+ ] ifFalse:[
+ item := MenuItem labeled:'-'.
+ ].
+ menu addItem:item.
+ ].
+ item := MenuItem labeled:'other ..'.
+ item value:[:arg :panel||n|
+ n := Number fromString:(Dialog request:'zoom %:') onError:nil.
+
+ n notNil ifTrue:[
+ panel receiver perform:aSelector with:(n / 100)
+ ]
+ ].
+ menu addItem:item.
+ ^ menu
+
+"
+(self zoomMenuSelector:#zoomY) startUp
+"
+
+! !
+
+!GraphColumn methodsFor:'accessing'!
+
+name
+ "get the name of the column
+ "
+ ^ aspects at:#name ifAbsent:nil
+!
+
+name:aName
+ "set the name of the column
+ "
+ self aspectAt:#name put:aName
+!
+
+relativeXaxis
+ "get the relative X-axis (y == 0) into the view; 0.5 is centered.
+ "
+ ^ aspects at:#relativeXaxis ifAbsent:0.5
+
+
+!
+
+relativeXaxis:aNumberOrNil
+ "set the relative X-axis (y == 0) into the view; 0.5 is centered; nil sets
+ the axis to the center
+ "
+ |x|
+
+ aNumberOrNil notNil ifTrue:[
+ x := aNumberOrNil isInteger ifTrue:[aNumberOrNil]
+ ifFalse:[aNumberOrNil asFloat] "/ no fractions
+ ] ifFalse:[
+ x := 0.5
+ ].
+
+ self aspectAt:#relativeXaxis put:x
+!
+
+scaleY
+ "get the current y-scale of the column (~~ 0)
+ "
+ ^ aspects at:#scaleY ifAbsent:1
+!
+
+scaleY:aNumberOrNil
+ "set the current y-scale of the column to a number or nil (== 1).
+ "
+ |y|
+
+ aNumberOrNil notNil ifTrue:[
+ y := aNumberOrNil isInteger ifTrue:[aNumberOrNil]
+ ifFalse:[aNumberOrNil asFloat]. "/ no fractions
+
+ y > 0 ifFalse:[y := 1]
+ ] ifFalse:[
+ y := 1
+ ].
+
+ self aspectAt:#scaleY put:y
+!
+
+shown
+ "returns true if the column is shown; each graph which contains the
+ column specification will show the column
+ "
+ ^ aspects at:#shown ifAbsent:true
+!
+
+shown:aState
+ "true if the column is shown; each graph which contains the
+ column specification will show the column
+ "
+ self aspectAt:#shown put:aState
+!
+
+transY
+ "get the current y-transition of the column
+ "
+ ^ aspects at:#transY ifAbsent:0
+!
+
+transY:anIntegerOrNil
+ "set the current y-transition of the column to an integer or nil (== 0).
+ "
+ |y|
+
+ anIntegerOrNil notNil ifTrue:[
+ y := anIntegerOrNil isInteger ifTrue:[anIntegerOrNil]
+ ifFalse:[anIntegerOrNil asFloat rounded] "/ catch fractions
+ ] ifFalse:[
+ y := 0
+ ].
+
+ self aspectAt:#transY put:y
+!
+
+zoomY
+ "get the current y-zoom factor of the column (~~ 0)
+ "
+ ^ aspects at:#zoomY ifAbsent:1
+!
+
+zoomY:aFactor
+ "define a specific zoom factor which will zoom the graph/hlines
+ to its relative center defined by relativeXaxis
+ "
+ |y|
+
+ aFactor notNil ifTrue:[
+ y := aFactor isInteger ifTrue:[aFactor]
+ ifFalse:[aFactor asFloat]. "/ no fractions
+
+ y > 0 ifFalse:[y := 1]
+ ] ifFalse:[
+ y := 1
+ ].
+ self aspectAt:#zoomY put:y
+
+! !
+
+!GraphColumn methodsFor:'accessing Y function'!
+
+functionYblock
+ "get the two arguments block which is used to access Y values from
+ start into an array. The block should return the collection of y
+ values; see method: #from:into:
+ "
+ ^ functionYblock
+!
+
+functionYblock:something
+ "set the two arguments block which is used to access Y values from
+ start into an array. The block should return the collection of y
+ values; see method: #from:into:
+ "
+ functionYblock := something.
+ self changed.
+! !
+
+!GraphColumn methodsFor:'accessing Y values'!
+
+yValueAt:anIndex
+ "returns the y value at an index
+ "
+ ^ (self yValuesStartAt:anIndex into:(Array new:1)) at:1
+!
+
+yValuesStartAt:start into:anArray
+ "returns the Y values from start upto array size. The collection of y
+ values should be returned; can use the 'anArray' or your own
+ "
+ ^ functionYblock value:start value:anArray
+! !
+
+!GraphColumn methodsFor:'accessing graph'!
+
+foregroundColor
+ "get the color of the graph; if the color is nil the
+ foreground color of the graph is used
+ "
+ ^ aspects at:#foregroundColor ifAbsent:nil
+
+!
+
+foregroundColor:aColor
+ "set the color of the graph; if the color is nil the
+ foreground color of the graph is used
+ "
+ self aspectAt:#foregroundColor put:aColor
+
+!
+
+lineStyle
+ "get the style in which the graph is drawn; supported
+ styles are #solid or #dashed
+ "
+ ^ aspects at:#lineStyle ifAbsent:#solid
+!
+
+lineStyle:aStyle
+ "set the style in which the graph is drawn; supported styles are
+ #solid or #dashed. If the style is nil, #solid will be set.
+ "
+ self aspectAt:#lineStyle put:aStyle
+!
+
+lineWidth
+ "get the line width of the graph
+ "
+ ^ aspects at:#lineWidth ifAbsent:1
+!
+
+lineWidth:anInteger
+ "set the line width of the graph
+ "
+ self aspectAt:#lineWidth put:(anInteger ? 1)
+! !
+
+!GraphColumn methodsFor:'accessing hLines'!
+
+hLineFgColor
+ "get the color of the horizontal lines; if the color is nil the
+ foreground color of the graph is used
+ "
+ ^ aspects at:#hLineFgColor ifAbsent:nil
+!
+
+hLineFgColor:aColor
+ "set the color of the horizontal lines; if the color is nil the
+ foreground color of the graph is used
+ "
+ self aspectAt:#hLineFgColor put:aColor
+!
+
+hLineList
+ "get list of horizontal lines assigned to the column
+ "
+ ^ aspects at:#hLineList ifAbsent:nil
+!
+
+hLineList:aCollection
+ "set list of horizontal lines assigned to the column; scalling and
+ transition is used for redrawing the horizontal lines
+ "
+ |col|
+
+ col := (aCollection size ~~ 0) ifTrue:[aCollection] ifFalse:[nil].
+
+ self aspectAt:#hLineList put:col
+!
+
+hLineStyle
+ "get the style in which the horizontal lines are drawn; supported
+ styles are #solid or #dashed.
+ "
+ ^ aspects at:#hLineStyle ifAbsent:#solid
+!
+
+hLineStyle:aStyle
+ "set the style in which the horizontal lines are drawn; supported styles
+ are #solid or #dashed. If the style is nil, #solid will be set.
+ "
+ self aspectAt:#hLineStyle put:aStyle
+!
+
+hLineWidth
+ "get the line width of the horizontal lines
+ "
+ ^ aspects at:#hLineWidth ifAbsent:1
+
+!
+
+hLineWidth:anInteger
+ "set the line width of the horizontal lines
+ "
+ self aspectAt:#hLineWidth put:(anInteger ? 1)
+
+
+! !
+
+!GraphColumn methodsFor:'accessing menu'!
+
+middleButtonMenu
+ |menu|
+
+ menu := Menu new fromLiteralArrayEncoding:(self class middleButtonMenu).
+ menu receiver:self.
+ ^ menu
+
+
+! !
+
+!GraphColumn methodsFor:'aspects'!
+
+aspect
+ "returns current aspects
+ "
+ ^ aspects
+!
+
+aspectAt:aKey put:aValue
+ |oldValue|
+
+ oldValue := aspects at:aKey ifAbsent:nil.
+
+ oldValue ~= aValue ifTrue:[
+ aValue isNil ifTrue:[aspects removeKey:aKey]
+ ifFalse:[aspects at:aKey put:aValue].
+
+ self changed:aKey with:oldValue
+ ]
+!
+
+aspects:aDictionaryOrNil
+ "change aspects; raise a change notification when changed. If the argument is
+ nil, the default aspects are set
+ "
+ |oldAspects|
+
+ aDictionaryOrNil == aspects ifFalse:[
+ oldAspects := aspects.
+ self setAspects:aDictionaryOrNil.
+ self changed:#aspects with:oldAspects.
+ ]
+!
+
+setAspects:aDictionaryOrNil
+ "change aspects; raise no notification. If the argument is
+ nil, the default aspects are set
+ "
+ aDictionaryOrNil isNil ifTrue:[
+ aspects := IdentityDictionary new.
+
+ aspects at:#hLineWidth put:1.
+ aspects at:#lineWidth put:1.
+ aspects at:#scaleY put:1.
+ aspects at:#zoomY put:1.
+ aspects at:#transY put:0.
+ aspects at:#relativeXaxis put:0.5.
+ ] ifFalse:[
+ aspects := aDictionaryOrNil
+ ]
+! !
+
+!GraphColumn methodsFor:'initialization'!
+
+initialize
+ "setup default values
+ "
+ super initialize.
+ self setAspects:nil.
+! !
+
+!GraphColumn methodsFor:'printing'!
+
+printString
+ "returns my printable string
+ "
+ |name|
+
+ ^ (name := self name) notNil ifTrue:[name printString] ifFalse:['']
+! !
+
+!GraphColumn methodsFor:'queries'!
+
+centerGraphMaxY:maxY minY:minY
+ "set transition Y for the graph dependent on current scaleY; the graph is centered
+ to its relative X-Axis (changes transition Y)
+ "
+ self transY:(((maxY + minY) / 2) * self scaleY)
+!
+
+scaleToHeight:aHeight maxY:maxY minY:minY
+ "set scaleY dependent on a max and min y value to fit into
+ a height >= 1
+ "
+ |dltY|
+
+ (dltY := (maxY - minY) abs) = 0 ifTrue:[dltY := 1].
+ self scaleY:((aHeight max:1) / dltY)
+! !
+
+!GraphColumn class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg2/GraphColumn.st,v 1.1 1998-02-07 15:15:30 ca Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/GraphColumnView.st Sat Feb 07 16:16:52 1998 +0100
@@ -0,0 +1,657 @@
+View subclass:#GraphColumnView
+ instanceVariableNames:'listHolder zoomYHolder columns oldMenuMessage windowSizeHolder
+ windowSize gridColor showGrid fgColor bgColor vLinesColor zoomY'
+ classVariableNames:'DefaultBackgroundColor DefaultGridColor DefaultForegroundColor
+ DefaultVLinesColor'
+ poolDictionaries:''
+ category:'Views-Graphs'
+!
+
+
+!GraphColumnView class methodsFor:'defaults'!
+
+defaultMenu
+ "redefined by subclass: should return the default middle button menu
+ "
+ ^ nil
+!
+
+updateStyleCache
+ "extract values from the styleSheet and cache them in class variables
+ "
+ DefaultForegroundColor := Color black.
+ DefaultBackgroundColor := Color veryLightGray.
+ DefaultGridColor := Color lightGray.
+ DefaultVLinesColor := DefaultForegroundColor
+"
+ self updateStyleCache
+"
+
+
+! !
+
+!GraphColumnView methodsFor:'accessing'!
+
+columns
+ "returns list of column descriptions
+ "
+ ^ columns
+
+
+!
+
+columns:aList
+ "set list of columns
+ "
+ columns notNil ifTrue:[
+ columns do:[:aCol| aCol removeDependent:self ]
+ ].
+
+ aList size ~~ 0 ifTrue:[
+ columns := OrderedCollection new.
+
+ aList do:[:aColumn|
+ aColumn addDependent:self.
+ columns add:aColumn
+ ]
+ ] ifFalse:[
+ columns := nil
+ ].
+ self recomputeWholeGraph
+!
+
+showDefaultMenu
+ "enable or disable my default menu
+ "
+ ^ self menuMessage == #defaultMenu
+!
+
+showDefaultMenu:aBool
+ "enable or disable my default menu
+ "
+ |currMsg|
+
+ currMsg := self menuMessage.
+
+ aBool ifTrue:[
+ oldMenuMessage := currMsg.
+ self menuMessage:#defaultMenu
+ ] ifFalse:[
+ currMsg == #defaultMenu ifTrue:[
+ self menuMessage:oldMenuMessage
+ ]
+ ].
+
+
+! !
+
+!GraphColumnView methodsFor:'accessing dimensions'!
+
+windowSize
+ "get number of horizontal steps ( X )
+ "
+ ^ windowSize
+
+
+!
+
+windowSize:aValue
+ "set number of horizontal steps ( X )
+ "
+ |sz|
+
+ sz := (self unsignedIntegerFrom:aValue onError:[101]) max:5.
+
+ sz ~~ windowSize ifTrue:[
+ windowSize := sz.
+ self recomputeWholeGraph
+ ]
+
+!
+
+zoomY
+ "returns current y-zoom factor
+ "
+ ^ zoomY
+
+
+!
+
+zoomY:aValue
+ "set current y-zoom factor; if the argument is nil,
+ the y-zoom is set to 1 ( no zoom ).
+ "
+ |zY|
+
+ (zY := self floatFrom:aValue onError:[1]) <= 0 ifTrue:[
+ zY := 1
+ ].
+
+ zY = zoomY ifFalse:[
+ zoomY := zY.
+ self invalidateGraph
+ ]
+
+
+! !
+
+!GraphColumnView methodsFor:'accessing look'!
+
+backgroundColor
+ "get the background color
+ "
+ ^ bgColor
+
+
+!
+
+backgroundColor:aColor
+ "set the background color
+ "
+ (aColor isColor and:[bgColor ~= aColor]) ifTrue:[
+ shown ifTrue:[
+ bgColor := aColor on:device.
+ self colorChanged:#background.
+ ] ifFalse:[
+ bgColor := aColor
+ ]
+ ]
+!
+
+foregroundColor
+ "get the default foreground color; used in case that no color for
+ a column is specified
+ "
+ ^ fgColor
+
+!
+
+foregroundColor:aColor
+ "set the default foreground color; used in case that no color for
+ a column is specified
+ "
+ (aColor isColor and:[fgColor ~= aColor]) ifTrue:[
+ shown ifTrue:[
+ fgColor := aColor on:device.
+ self colorChanged:#foreground
+ ] ifFalse:[
+ fgColor := aColor
+ ]
+ ]
+
+!
+
+gridColor
+ "get the foreground color of the grid
+ "
+ ^ gridColor
+
+!
+
+gridColor:aColor
+ "set the foreground color of the grid
+ "
+ (aColor isColor and:[gridColor ~= aColor]) ifTrue:[
+ shown ifTrue:[
+ gridColor := aColor on:device.
+
+ showGrid ifTrue:[
+ self colorChanged:#grid
+ ]
+ ] ifFalse:[
+ gridColor := aColor
+ ]
+ ]
+
+!
+
+showGrid
+ ^ showGrid
+
+!
+
+showGrid:aBool
+ |hasGrid|
+
+ showGrid ~~ aBool ifTrue:[
+ showGrid := aBool.
+
+ shown ifTrue:[
+ self invalidateGraph
+ ]
+ ]
+
+!
+
+vLinesColor
+ "get the foreground color of the vertical lines
+ "
+ ^ vLinesColor
+
+
+!
+
+vLinesColor:aColor
+ "set the foreground color of the vertical lines
+ "
+ (aColor isColor and:[vLinesColor ~= aColor]) ifTrue:[
+ shown ifTrue:[
+ vLinesColor := aColor on:device.
+ self colorChanged:#vLines
+ ] ifFalse:[
+ vLinesColor := aColor
+ ]
+ ]
+
+! !
+
+!GraphColumnView methodsFor:'accessing mvc'!
+
+listHolder
+ "get the valueHolder which holds the list of column descriptons
+ "
+ ^ listHolder
+
+
+!
+
+listHolder:aHolder
+ "set the valueHolder which holds the list of column descriptons
+ "
+ listHolder == aHolder ifFalse:[
+ listHolder notNil ifTrue:[
+ listHolder removeDependent:self
+ ].
+ (listHolder := aHolder) notNil ifTrue:[
+ listHolder addDependent:self
+ ].
+ ].
+ self columns:(listHolder value)
+
+!
+
+model:aModel
+ "set the valueHolder which holds the selection and maybe the list of columnms
+ "
+ (model respondsTo:#list) ifTrue:[
+ (model list == listHolder) ifTrue:[
+ self listHolder:nil
+ ]
+ ].
+ super model:aModel.
+
+ aModel notNil ifTrue:[
+ (aModel respondsTo:#list) ifTrue:[
+ self listHolder:model list
+ ]
+ ]
+
+!
+
+windowSizeHolder
+ "get the valueHolder which holds the size of the window; X
+ "
+ ^ windowSizeHolder
+
+!
+
+windowSizeHolder:aHolder
+ "set the valueHolder which holds the size of the window; X
+ "
+ windowSizeHolder == aHolder ifFalse:[
+ windowSizeHolder notNil ifTrue:[
+ windowSizeHolder removeDependent:self
+ ].
+ (windowSizeHolder := aHolder) notNil ifTrue:[
+ windowSizeHolder addDependent:self
+ ].
+ ].
+ self windowSize:(windowSizeHolder value)
+
+!
+
+zoomYHolder
+ "get the valueHolder which holds the y zoom factor
+ "
+ ^ zoomYHolder
+
+!
+
+zoomYHolder:aHolder
+ "set the valueHolder which holds the y zoom factor
+ "
+ zoomYHolder == aHolder ifFalse:[
+ zoomYHolder notNil ifTrue:[
+ zoomYHolder removeDependent:self
+ ].
+ (zoomYHolder := aHolder) notNil ifTrue:[
+ zoomYHolder addDependent:self
+ ]
+ ].
+ self zoomY:(zoomYHolder value).
+
+! !
+
+!GraphColumnView methodsFor:'adding & removing'!
+
+add:aColumn
+ "insert a column at end; returns the inserted column
+ "
+ ^ self add:aColumn beforeIndex:(1 + columns size)
+
+!
+
+add:aColumn afterIndex:anIndex
+ "add a new column after an index; returns the inserted column
+ "
+ ^ self add:aColumn beforeIndex:(anIndex + 1)
+
+!
+
+add:aColumn beforeIndex:anIndex
+ "add a column before an index; returns the inserted column
+ "
+ aColumn isNil ifTrue:[^ nil].
+
+ columns isNil ifTrue:[
+ self columns:(Array with:aColumn).
+ ^ aColumn.
+ ].
+ columns add:aColumn beforeIndex:anIndex.
+ aColumn addDependent:self.
+
+ aColumn shown ifTrue:[
+ self listSizeChanged:#insert: from:aColumn.
+ ].
+
+!
+
+addAll:aCollection beforeIndex:anIndex
+ "add a collection of columns before an index
+ "
+ aCollection size ~~ 0 ifTrue:[
+ columns size == 0 ifTrue:[
+ self columns:aCollection
+ ] ifFalse:[
+ columns addAll:aCollection beforeIndex:anIndex.
+ self recomputeWholeGraph.
+ ]
+ ]
+
+!
+
+addFirst:aColumn
+ "insert a column at start; returns the inserted column
+ "
+ ^ self add:aColumn beforeIndex:1
+
+!
+
+removeAll
+ "remove all columns
+ "
+ self columns:nil
+
+!
+
+removeFirst
+ "remove first column; returns the removed column
+ "
+ ^ self removeIndex:1
+
+
+!
+
+removeIndex:anIndex
+ "remove column at an index; returns the removed column
+ "
+ |col|
+
+ col := columns removeAtIndex:anIndex.
+ col removeDependent:self.
+
+ columns size == 0 ifTrue:[
+ columns := nil
+ ].
+ col shown ifTrue:[
+ self listSizeChanged:#remove: from:col
+ ].
+ ^ col
+
+
+!
+
+removeLast
+ "remove last column; the removed column is returned
+ "
+ ^ self removeIndex:(columns size)
+
+! !
+
+!GraphColumnView methodsFor:'change & update'!
+
+update:what with:aPara from:chgObj
+ "catch and handle a change notification of any object
+ "
+ |list start size stop|
+
+ chgObj == windowSizeHolder ifTrue:[
+ ^ self windowSize:(windowSizeHolder value)
+ ].
+
+ chgObj == zoomYHolder ifTrue:[
+ ^ self zoomY:(zoomYHolder value)
+ ].
+
+ chgObj == model ifTrue:[
+ (what == #selectionIndex or:[what == #selection]) ifTrue:[
+ ^ self
+ ].
+ what == #list ifTrue:[
+ ^ self listHolder:model list
+ ].
+ model == listHolder ifFalse:[
+ ^ self
+ ].
+ ].
+
+ chgObj == listHolder ifTrue:[
+ list := listHolder value.
+
+ (what == #insert:) ifTrue:[
+ self add:(list at:aPara) beforeIndex:aPara
+ ] ifFalse:[
+ (what == #remove:) ifTrue:[
+ self removeIndex:aPara
+ ] ifFalse:[
+ (what == #insertCollection:) ifTrue:[
+ start := aPara first.
+ size := aPara last.
+
+ size ~~ 0 ifTrue:[
+ size == 1 ifTrue:[
+ self add:(list at:start) beforeIndex:start
+ ] ifFalse:[
+ stop := start + size - 1.
+ self addAll:(list copyFrom:start to:stop) beforeIndex:start
+ ]
+ ]
+ ] ifFalse:[
+ self listHolder:chgObj
+ ]
+ ]
+ ].
+ ^ self
+ ].
+
+ columns notNil ifTrue:[
+ (columns includesIdentical:chgObj) ifTrue:[
+ ^ self columnChanged:what with:aPara from:chgObj
+ ]
+ ].
+
+ super update:what with:aPara from:chgObj
+
+! !
+
+!GraphColumnView methodsFor:'conversion'!
+
+floatFrom:aValue onError:aBlock
+ "converts something to a float, on error the result of the
+ block is returned
+ "
+ ^ aValue isNumber ifTrue:[aValue asFloat] ifFalse:[aBlock value]
+!
+
+unsignedIntegerFrom:aValue onError:aBlock
+ "converts something to an unsigned integer, on error the result of the
+ block is returned
+ "
+ |v|
+
+ aValue isNumber ifTrue:[
+ v := aValue isInteger ifTrue:[aValue] ifFalse:[(aValue asFloat) rounded]. "/ no fractions
+
+ v >= 0 ifTrue:[ ^ v ]
+ ].
+ ^ aBlock value
+! !
+
+!GraphColumnView methodsFor:'initialization'!
+
+create
+ "set color on device
+ "
+ super create.
+
+ fgColor := (fgColor ? DefaultForegroundColor) on:device.
+ bgColor := (bgColor ? DefaultBackgroundColor) on:device.
+ gridColor := (gridColor ? DefaultGridColor) on:device.
+ vLinesColor := (vLinesColor ? DefaultVLinesColor) on:device.
+
+!
+
+destroy
+ "remove dependencies
+ "
+ super destroy.
+
+ listHolder removeDependent:self.
+ listHolder := nil.
+
+ windowSizeHolder removeDependent:self.
+ windowSizeHolder := nil.
+
+ zoomYHolder removeDependent:self.
+ zoomYHolder := nil.
+
+ columns notNil ifTrue:[
+ columns do:[:aCol| aCol removeDependent:self ]
+ ].
+
+!
+
+initialize
+ "setup default values
+ "
+ super initialize.
+
+ DefaultGridColor isNil ifTrue:[
+ self class updateStyleCache
+ ].
+
+ windowSize := 101.
+ showGrid := false.
+ zoomY := 1.
+
+! !
+
+!GraphColumnView methodsFor:'menu & submenus'!
+
+defaultMenu
+ "returns the default middle button menu
+ "
+ |menu|
+
+ menu := self class defaultMenu decodeAsLiteralArray.
+ menu notNil ifTrue:[
+ menu receiver:self
+ ].
+ ^ menu
+
+
+!
+
+doZoomY:aValue
+ |old|
+
+ old := self zoomY.
+ self zoomY:aValue.
+
+ self zoomYHolder notNil ifTrue:[
+ zoomYHolder value:(self zoomY)
+ ]
+!
+
+subMenuZoomY
+ "returns a submenu to configure the y-zoom value
+ "
+ ^ GraphColumn zoomMenuSelector:#doZoomY:
+
+
+! !
+
+!GraphColumnView methodsFor:'protocol'!
+
+colorChanged:what
+ "called if a color changed, #foreground, #background, #grid or #vLines
+ "
+ self recomputeWholeGraph
+!
+
+columnChanged:what with:aPara from:aColumn
+ "a column changed
+ "
+ self recomputeWholeGraph
+
+
+!
+
+invalidateGraph
+ "called to redraw the graph
+ "
+ self recomputeWholeGraph
+!
+
+listSizeChanged:what from:aColumn
+ "called if a column is inserted (#insert:) or removed from list
+ "
+ self recomputeWholeGraph
+!
+
+recomputeWholeGraph
+ "called if the whole graph should be recomputed
+ "
+ self subclassResponsibility
+! !
+
+!GraphColumnView methodsFor:'queries'!
+
+numberOfVisibleColumns
+ "returns number of visible Columns
+ "
+ |no|
+
+ no := 0.
+
+ columns notNil ifTrue:[
+ columns do:[:aCol| aCol shown ifTrue:[no := no + 1]]
+ ].
+ ^ no
+! !
+
+!GraphColumnView class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg2/GraphColumnView.st,v 1.1 1998-02-07 15:15:50 ca Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/GraphColumnView2D.st Sat Feb 07 16:16:52 1998 +0100
@@ -0,0 +1,1533 @@
+GraphColumnView subclass:#GraphColumnView2D
+ instanceVariableNames:'colorMap vLines gridXoffset gridX gridY actionBlock
+ doubleClickBlock buttonReleaseBlock menuAccessBlock'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Graphs'
+!
+
+
+!GraphColumnView2D class methodsFor:'defaults'!
+
+gridStep
+ ^ 8
+! !
+
+!GraphColumnView2D class methodsFor:'examples'!
+
+test1
+ "testing vertical lines and actions
+
+ start with:
+ self test1
+ "
+ |top list view x|
+
+ top := StandardSystemView extent:800 @ 400.
+ view := GraphColumnView2D origin:0@0 extent:1.0@1.0 in:top.
+ list := OrderedCollection new.
+
+ top label:'2D-View'.
+
+ #( 0.25 0.5 0.75 ) keysAndValuesDo:[:aKey :xAxis||aCol|
+ aCol := GraphColumn name:aKey.
+ aCol relativeXaxis:xAxis.
+
+ xAxis ~= 0.5 ifTrue:[
+ xAxis < 0.5 ifTrue:[
+ aCol foregroundColor:(Color red).
+ ] ifFalse:[
+ aCol foregroundColor:(Color blue).
+ aCol lineStyle:#dashed
+ ]
+ ].
+ aCol hLineStyle:#dashed.
+ aCol hLineList:#( 0 ).
+ aCol scaleY:40.
+
+ aCol functionYblock:[:start :array|
+ x := (start - 1) * 0.2.
+ 1 to:(array size) do:[:i| array at:i put:(x sin). x := x + 0.2 ].
+ array
+ ].
+ list add:aCol.
+ ].
+
+ view action:[:column :indexX :deltaY|
+ Transcript showCR:'SINGLE CLICK:'.
+
+ Transcript showCR:' column: ', column printString,
+ ' indexX: ', indexX printString,
+ ' deltaY: ', deltaY printString.
+
+ (view hasVLineAt:indexX) ifTrue:[
+ view vLineRemove:indexX
+ ] ifFalse:[
+ view vLineAdd:indexX
+ ]
+ ].
+
+ view doubleClickAction:[:column :indexX :deltaY|
+ Transcript showCR:'DOUBLE CLICK:'.
+
+ Transcript showCR:' column: ', column printString,
+ ' indexX: ', indexX printString,
+ ' deltaY: ', deltaY printString.
+ ].
+ view showDefaultMenu:true.
+ view showGrid:true.
+ view columns:list.
+ top openAndWait.
+
+
+
+!
+
+test2
+ "testing models and change notifications
+
+ start with:
+ self test2
+ "
+ |top list cols listView graph red blue yellow sav pause|
+
+ top := StandardSystemView extent:950 @ 400.
+ listView := ListView origin:0.0@0.0 corner:150@1.0 in:top.
+ graph := GraphColumnView2D origin:150@0 corner:1.0@1.0 in:top.
+ cols := OrderedCollection new.
+ list := List new.
+
+ top label:'Testing 2D-View: Models & Style'.
+
+ listView list:OrderedCollection new.
+ graph showGrid:true.
+ graph listHolder:list.
+ top openAndWait.
+
+ #( 0.2 0.8 ) keysAndValuesDo:[:aKey :xAxis||aCol x|
+ aCol := GraphColumn name:'Column <', aKey printString, '>'.
+ aCol relativeXaxis:xAxis.
+ aCol hLineFgColor:(Color blue).
+ aCol scaleY:40.
+ aCol hLineStyle:#dashed.
+
+ aCol functionYblock:[:start :array|
+ x := (start - 1) * 0.2.
+ 1 to:(array size) do:[:i| array at:i put:(x sin). x := x + 0.2 ].
+ array
+ ].
+ cols add:aCol.
+ ].
+
+ red := Color red.
+ blue := Color blue.
+ yellow := Color yellow lightened.
+ pause := [ |l|
+ l := listView list.
+ l size > 500 ifTrue:[l removeFromIndex:1 toIndex:400. listView list:l].
+ listView scrollToBottom.
+ top shown ifTrue:[Delay waitForSeconds:1] ].
+
+ [ [top shown] whileTrue:[
+ listView add:'ADD COLUMNS'.
+ cols do:[:el|
+ listView add:( ' ', el printString ).
+ list add:el.
+ pause value
+ ].
+
+ listView add:( 'GRAPH' ).
+ listView add:( ' Background' ).
+ sav := graph backgroundColor.
+ graph backgroundColor:yellow.
+ pause value.
+ graph backgroundColor:sav.
+ sav := graph foregroundColor.
+ listView add:( ' Foreground' ).
+ graph foregroundColor:blue.
+ pause value.
+ graph foregroundColor:sav.
+
+ listView add:( 'GRID' ).
+ listView add:( ' Grid X' ).
+ graph gridExtent:(4 @ 0).
+ pause value.
+ listView add:( ' Grid Y' ).
+ graph gridExtent:(0 @ 4).
+ pause value.
+ listView add:( ' Grid X/Y' ).
+ graph gridExtent:(8 @ 8).
+ pause value.
+ listView add:( ' Color' ).
+ sav := graph gridColor.
+ graph gridColor:yellow.
+ pause value.
+ graph gridColor:sav.
+ listView add:( ' Off' ).
+ graph showGrid:false.
+ pause value.
+ listView add:( ' On' ).
+ graph showGrid:true.
+
+ listView add:( 'VLINES' ).
+ listView add:( ' Add' ).
+ #( 7 15 43 90 ) do:[:i| graph vLineAdd:i. Delay waitForSeconds:0.2 ].
+ top shown ifTrue:[Delay waitForSeconds:0.5].
+ sav := graph vLinesColor.
+ listView add:( ' Color' ).
+ graph vLinesColor:blue.
+ pause value.
+ graph vLinesColor:sav.
+ listView add:( ' Remove' ).
+ #( 7 15 43 90 ) do:[:i| graph vLineRemove:i. Delay waitForSeconds:0.2 ].
+ pause value.
+
+ listView add:'REMOVE COLUMNS'.
+ [list notEmpty] whileTrue:[
+ listView add:( ' ', list removeFirst printString ).
+ pause value
+ ].
+ ].
+
+ ] forkAt:1.
+
+
+!
+
+test3
+ "testing models and change notifications
+
+ start with:
+ self test3
+ "
+ |top list slices index view graph column actLbl tmOut button bAction tmLbl title pause toggle auto next|
+
+ top := StandardSystemView extent:800 @ 400.
+ view := View origin:0@0 corner:1.0@28 in:top.
+ graph := GraphColumnView2D origin:0@28 corner:1.0@1.0 in:top.
+ list := OrderedCollection new.
+ top label:'Testing 2D-View: Model-Column'.
+
+ slices := #( ( foregroundColor #color )
+ ( lineStyle #dashed )
+ ( lineWidth 4 )
+
+ ( hLineFgColor #color )
+ ( hLineStyle #dashed )
+ ( hLineWidth 4 )
+ ( hLineList #( -0.8 -0.5 0 0.5 0.8 ) )
+
+ ( shown false )
+ ( scaleY 10 )
+ ( transY 20 )
+ ( relativeXaxis 0.2 )
+ ).
+
+
+ column := GraphColumn name:'test'.
+ column relativeXaxis:0.5.
+ column scaleY:40.
+ column hLineList:#( -1 1 ).
+ column functionYblock:[:start :array||x|
+ x := (start - 1) * 0.2.
+ 1 to:(array size) do:[:i| array at:i put:(x sin). x := x + 0.2 ].
+ array
+ ].
+ tmOut := 1.0.
+ auto := true.
+ index := 1.
+ next := false.
+
+ view level:1.
+
+ toggle := CheckBox origin:0@0.0 corner:100@1.0 in:view.
+ toggle label:'Auto/Step'.
+ toggle turnOn.
+ toggle action:[:aState|
+ (next := auto := aState) ifTrue:[
+ title label:'Time: '.
+ tmLbl label:(tmOut printString).
+ ] ifFalse:[
+ title label:'Step: '.
+ tmLbl label:(index printString).
+ ]
+ ].
+
+ title := Label origin:100@0.0 corner:160@1.0 in:view.
+ title adjust:#right.
+ title sizeFixed:true.
+ title label:'Time: '.
+
+ bAction := [:add|
+ auto ifTrue:[
+ tmOut := (tmOut + (add ifTrue:[0.1] ifFalse:[-0.1])) max:0.1.
+ tmLbl label:(tmOut printString).
+ ] ifFalse:[
+ add ifTrue:[
+ (index := index + 1) > slices size ifTrue:[index := 1]
+ ] ifFalse:[
+ (index := index - 1) < 1 ifTrue:[index := slices size]
+ ].
+ tmLbl label:(index printString).
+ next := true.
+ ]
+ ].
+
+ button := ArrowButton leftIn:view.
+ button origin:160@0.0 corner:180@1.0.
+ button autoRepeat:true.
+ button pressAction:[ bAction value:false ].
+
+ button := ArrowButton rightIn:view.
+ button origin:181@0.0 corner:201@1.0.
+ button autoRepeat:true.
+ button pressAction:[ bAction value:true ].
+
+ tmLbl := Label origin:202 @0.0 corner:230@1.0 in:view.
+ tmLbl adjust:#center.
+ tmLbl sizeFixed:true.
+ tmLbl label:(tmOut printString).
+
+ actLbl := Label origin:230 @0.0 corner:290@1.0 in:view.
+ actLbl sizeFixed:true.
+ actLbl adjust:#right.
+ actLbl label:'Action: '.
+
+ actLbl := Label origin:290 @0.0 corner:1.0@1.0 in:view.
+ actLbl adjust:#left.
+ view subViews do:[:v| v verticalInset:2 ].
+
+ graph gridExtent:( 4 @ 4 ).
+ graph showDefaultMenu:true.
+ graph listHolder:(Array with:column).
+ top openAndWait.
+
+ pause := [
+ auto ifTrue:[
+ top shown ifTrue:[Delay waitForSeconds:tmOut]
+ ] ifFalse:[
+ next := false.
+
+ [(next not and:[top shown])] whileTrue:[
+ Delay waitForSeconds:0.2
+ ]
+ ]
+ ].
+
+ [ |sav rsl wsl arg dsc|
+
+ [top shown] whileTrue:[
+
+ dsc := slices at:index.
+
+ auto ifTrue:[
+ (index := index + 1) > slices size ifTrue:[
+ index := 1
+ ]
+ ].
+ rsl := dsc at:1.
+ wsl := (rsl, ':') asSymbol.
+ (arg := dsc at:2) == #color ifTrue:[arg := Color red].
+ sav := column perform:rsl.
+
+ actLbl label:wsl printString, ' ', arg printString.
+ column perform:wsl with:arg.
+ pause value.
+ column perform:wsl with:sav.
+ ]
+
+ ] forkAt:1.
+
+
+!
+
+testRun
+ "running view
+
+ start with:
+ self testRun
+ "
+ |top list view step x offs time|
+
+ top := StandardSystemView extent:800 @ 400.
+ view := GraphColumnView2D origin:0@0 extent:1.0@1.0 in:top.
+ offs := -1.
+ step := 2.
+ list := OrderedCollection new.
+
+ top label:'Testing 2D-View: Performance Test'.
+
+ #( 0.25 0.5 0.75 ) do:[:xAxis||aCol|
+ aCol := GraphColumn new.
+ aCol relativeXaxis:xAxis.
+ xAxis ~= 0.5 ifTrue:[
+ xAxis < 0.5 ifTrue:[aCol foregroundColor:(Color red)]
+ ifFalse:[aCol foregroundColor:(Color blue)]
+ ].
+ aCol hLineStyle:#dashed.
+ aCol hLineList:#( 0 ).
+ aCol scaleY:40.
+
+ aCol functionYblock:[:start :array|
+ x := (start + offs) * 0.2.
+ 1 to:(array size) do:[:i| array at:i put:(x sin). x := x + 0.2 ].
+ array
+ ].
+ list add:aCol.
+ ].
+ view showGrid:true.
+ view gridExtent:(4 @ 4).
+ view columns:list.
+ top openAndWait.
+
+ [
+ [top shown] whileTrue:[
+ time := Time millisecondsToRun:[
+ 1000 timesRepeat:[
+ offs := offs + step.
+ view scrollLeft:step.
+ ].
+ ].
+ Transcript showCR:time
+ ]
+
+ ] forkAt:1.
+! !
+
+!GraphColumnView2D class methodsFor:'menu'!
+
+defaultMenu
+ "this window spec was automatically generated by the ST/X MenuEditor"
+
+ "do not manually edit this - the builder may not be able to
+ handle the specification if its corrupted."
+
+ "
+ MenuEditor new openOnClass:GraphColumnView2D andSelector:#defaultMenu
+ (Menu new fromLiteralArrayEncoding:(GraphColumnView2D defaultMenu)) startUp
+ "
+
+ <resource: #menu>
+
+ ^
+
+ #(#Menu
+
+ #(
+ #(#MenuItem
+ #'label:' 'Grid'
+ #'submenu:'
+ #(#Menu
+
+ #(
+ #(#MenuItem
+ #'label:' 'Show'
+ #'indication:' #'showGrid:'
+ )
+ #(#MenuItem
+ #'label:' '-'
+ )
+ #(#MenuItem
+ #'label:' 'Extent'
+ #'isVisible:' #showGrid
+ #'submenu:'
+ #(#Menu
+
+ #(
+ #(#MenuItem
+ #'label:' 'larger'
+ #'value:' #'doGridExtent:'
+ #'argument:' #larger
+ )
+ #(#MenuItem
+ #'label:' 'smaller'
+ #'value:' #'doGridExtent:'
+ #'argument:' #smaller
+ )
+ ) nil
+ nil
+ )
+ )
+ #(#MenuItem
+ #'label:' 'X-Step'
+ #'argument:' #'doGridStepX:'
+ #'submenuChannel:' #'gridStepMenuSelector:'
+ )
+ #(#MenuItem
+ #'label:' 'Y-Step'
+ #'argument:' #'doGridStepY:'
+ #'submenuChannel:' #'gridStepMenuSelector:'
+ )
+ ) nil
+ nil
+ )
+ )
+ #(#MenuItem
+ #'label:' 'Zoom Y'
+ #'submenuChannel:' #subMenuZoomY
+ )
+ ) nil
+ nil
+ )
+!
+
+gridStepMenuSelector:aSelector
+ |menu width height item bitmap|
+
+ menu := Menu new.
+ width := 40.
+ height := 10.
+
+ #( off 1 2 4 8 ) do:[:aNumberOrSymbol|
+ item := MenuItem labeled:(aNumberOrSymbol printString).
+ item value:aSelector.
+ item argument:aNumberOrSymbol.
+ menu addItem:item.
+ ].
+ ^ menu
+
+"
+(self styleMenuSelector:#lineStyle) startUp
+"
+
+
+! !
+
+!GraphColumnView2D methodsFor:'accessing'!
+
+vLineAdd:anIndex
+ "add a vertical line at an index
+ "
+ |x|
+
+ ( (anIndex between:1 and:(self windowSize))
+ and:[(vLines includes:anIndex) not]
+ ) ifTrue:[
+ vLines add:anIndex.
+
+ shown ifTrue:[
+ x := ((anIndex - 1) * self stepX) rounded.
+
+ (x between:1 and:width) ifTrue:[
+ self paint:vLinesColor.
+ self displayLineFromX:x y:0 toX:x y:height
+ ]
+ ]
+ ]
+!
+
+vLineRemove:anIndex
+ "remove a vertical line at an index
+ "
+ |x|
+
+ ((vLines remove:anIndex ifAbsent:nil) notNil and:[shown]) ifTrue:[
+ x := ((anIndex - 1) * self stepX) rounded.
+
+ (x between:1 and:width) ifTrue:[
+ self redrawX:x y:0 width:1 height:height
+ ]
+ ]
+!
+
+vLines
+ "returns list of vertical lines
+ "
+ ^ vLines
+!
+
+vLines:aColl
+ "set list of vertical lines
+ "
+ aColl size == 0 ifTrue:[
+ vLines do:[:x| self vLineRemove:x ]
+ ] ifFalse:[
+ vLines do:[:x| (aColl includes:x) ifFalse:[self vLineRemove:x]].
+ aColl do:[:x| self vLineAdd:x].
+ ]
+! !
+
+!GraphColumnView2D methodsFor:'accessing actions'!
+
+action
+ "action block which is performed on a single button click.
+ Number of arguments to the block can be 0 upto 4.
+
+ argument 1: nearest column to the click point
+ argument 2: the logical index (X)
+ argument 3: the distance y from the click point to the columns's graph
+ argument 4: physical y value
+ "
+ ^ actionBlock
+!
+
+action:aBlockUpTo4Args
+ "action block which is performed on a single button click.
+ Number of arguments to the block can be 0 upto 4.
+
+ argument 1: nearest column to the click point
+ argument 2: the logical index (X)
+ argument 3: the distance y from the click point to the columns's graph
+ argument 4: physical y value
+ "
+ actionBlock := aBlockUpTo4Args
+!
+
+buttonReleaseBlock
+ "action block which is performed if the button is released; the number
+ of arguments to the block can be 0 upto 3.
+
+ argument 1: physical x value
+ argument 2: physical y value
+ argument 3: the logical index (X)
+ "
+ ^ buttonReleaseBlock
+!
+
+buttonReleaseBlock:aThreeArgAction
+ "action block which is performed if the button is released; the number
+ of arguments to the block can be 0 upto 3.
+
+ argument 1: physical x value
+ argument 2: physical x value
+ argument 3: the logical index (X)
+ "
+ buttonReleaseBlock := aThreeArgAction
+!
+
+doubleClickAction
+ "action block which is performed on a double button click.
+ Number of arguments to the block can be 0 upto 4.
+
+ argument 1: nearest column to the click point
+ argument 2: the logical index (X)
+ argument 3: the distance y from the click point to the columns's graph
+ argument 4: physical y value
+ "
+ ^ doubleClickBlock
+!
+
+doubleClickAction:aBlockUpTo4Args
+ "action block which is performed on a double button click.
+ Number of arguments to the block can be 0 upto 4.
+
+ argument 1: nearest column to the click point
+ argument 2: the logical index (X)
+ argument 3: the distance y from the click point to the columns's graph
+ argument 4: physical y value
+ "
+ doubleClickBlock := aBlockUpTo4Args
+!
+
+menuAccessBlock
+ "action block which is performed if a menu is required; if the block returns
+ nil, the default middlebutton menu is evaluated.
+
+ Number of arguments to the block can be 0 upto 4.
+
+ argument 1: nearest column to the click point
+ argument 2: the logical index (X)
+ argument 3: the distance y from the click point to the columns's graph
+ argument 4: physical y value
+ "
+ ^ menuAccessBlock
+!
+
+menuAccessBlock:aBlockUpTo4Args
+ "action block which is performed if a menu is required; if the block returns
+ nil, the default middlebutton menu is evaluated.
+
+ Number of arguments to the block can be 0 upto 4.
+
+ argument 1: nearest column to the click point
+ argument 2: the logical index (X)
+ argument 3: the distance y from the click point to the columns's graph
+ argument 4: physical y value
+ "
+ menuAccessBlock:= aBlockUpTo4Args
+! !
+
+!GraphColumnView2D methodsFor:'accessing dimensions'!
+
+gridExtent
+ "get the x/y extent of the grid
+ "
+ ^ gridX @ gridY
+!
+
+gridExtent:anExtent
+ "set the x/y extent of the grid
+ "
+ |gX gY|
+
+ anExtent isNil ifTrue:[
+ gX := gY := 0
+ ] ifFalse:[
+ gX := (anExtent x) max:0.
+ gY := (anExtent y) max:0.
+ ].
+
+ gridX == gX ifTrue:[
+ self gridY:gY
+ ] ifFalse:[
+ gridY := gY.
+ self gridX:gX
+ ]
+!
+
+gridX
+ "get the horizontal size of the grid or 0 if no horizontal grid is enabled
+ "
+ ^ gridX
+!
+
+gridX:aValue
+ "set the horizontal size of the grid or 0 if no horizontal grid is enabled
+ "
+ |x|
+
+ x := self unsignedIntegerFrom:aValue onError:[gridX].
+
+ x ~~ gridX ifTrue:[
+ gridX := x.
+ showGrid ifTrue:[ self recomputeWholeGraph ].
+ ]
+!
+
+gridY
+ "get the vertical size of the grid or 0 if no vertical grid is enabled
+ "
+ ^ gridY
+!
+
+gridY:aValue
+ "set the vertical size of the grid or 0 if no vertical grid is enabled
+ "
+ |y|
+
+ y := self unsignedIntegerFrom:aValue onError:[gridY].
+
+ y ~~ gridY ifTrue:[
+ gridY := y.
+ showGrid ifTrue:[ self recomputeWholeGraph ].
+ ]
+
+
+! !
+
+!GraphColumnView2D methodsFor:'change & update'!
+
+changedGraphIn:aColumn what:what from:oldValue
+ "graph changed
+ "
+ |widthC scaleY transY dataY stepX|
+
+ widthC := aColumn lineWidth.
+ scaleY := self scaleYofColumn:aColumn.
+ transY := self transYofColumn:aColumn.
+ stepX := self stepX.
+ dataY := self yDataForColumn:aColumn.
+
+ what == #lineWidth ifTrue:[
+ widthC < oldValue ifTrue:[widthC := oldValue]
+ ifFalse:[widthC := nil]
+ ] ifFalse:[
+ (what ~~ #lineStyle or:[aColumn lineStyle == #solid]) ifTrue:[
+ widthC := nil
+ ]
+ ].
+
+ widthC notNil ifTrue:[
+ self drawGRX:0
+ step:stepX
+ scaleY:scaleY
+ transY:transY
+ ydata:dataY
+ with:bgColor
+ style:#solid
+ width:widthC.
+
+ what == #lineWidth ifTrue:[
+ ^ self drawX:0 y:0 width:width height:height
+ ]
+ ].
+
+ self drawGRC:aColumn
+ x:0
+ step:stepX
+ scaleY:scaleY
+ transY:transY
+ ydata:dataY.
+
+
+
+
+
+
+
+
+
+
+
+
+
+!
+
+changedHLineIn:aColumn what:what from:oldValue
+ "hline changed
+ "
+ |widthC scaleY transY list|
+
+ widthC := aColumn hLineWidth.
+ scaleY := self scaleYofColumn:aColumn.
+ transY := self transYofColumn:aColumn.
+
+ what == #hLineList ifTrue:[
+ oldValue notNil ifTrue:[list := oldValue]
+ ifFalse:[widthC := nil].
+ ] ifFalse:[
+ (list := aColumn hLineList) isNil ifTrue:[
+ ^ self
+ ].
+
+ what == #hLineWidth ifTrue:[
+ widthC < oldValue ifTrue:[widthC := oldValue]
+ ifFalse:[widthC := nil]
+ ] ifFalse:[
+ (what ~~ #hLineStyle or:[aColumn hLineStyle == #solid]) ifTrue:[
+ widthC := nil
+ ]
+ ].
+ ].
+
+ widthC notNil ifTrue:[
+ self drawHLN:list
+ x:0
+ y:0
+ toX:width
+ y:height
+ scaleY:scaleY
+ transY:transY
+ with:bgColor
+ style:#solid
+ width:widthC.
+
+ what ~~ #hLineStyle ifTrue:[
+ ^ self drawX:0 y:0 width:width height:height
+ ]
+ ].
+
+ self drawHLC:aColumn
+ x:0
+ y:0
+ toX:width
+ y:height
+ scaleY:scaleY
+ transY:transY.
+
+! !
+
+!GraphColumnView2D methodsFor:'drawing'!
+
+clearColumnAndRedraw:aColumn
+ "undraw a column and redraw the view without clearing the background
+ "
+ shown ifTrue:[
+ (self sensor hasDamageFor:self) ifTrue:[
+ self recomputeWholeGraph
+ ] ifFalse:[
+ self undrawColumn:aColumn
+ scaleY:(self scaleYofColumn:aColumn)
+ transY:(self transYofColumn:aColumn)
+ ]
+ ]
+!
+
+redrawColumn:aColumn
+ "redraw a column including the horizontal lines
+ and the graph of the column
+ "
+ |transY scaleY stepX values|
+
+ (shown and:[aColumn shown]) ifTrue:[
+ scaleY := self scaleYofColumn:aColumn.
+ transY := self transYofColumn:aColumn.
+ stepX := self stepX.
+
+ self drawHLC:aColumn
+ x:0
+ y:0
+ toX:width
+ y:height
+ scaleY:scaleY
+ transY:transY.
+
+ self drawGRC:aColumn
+ x:0
+ step:stepX
+ scaleY:scaleY
+ transY:transY
+ ydata:(self yDataForColumn:aColumn)
+ ]
+
+
+!
+
+redrawColumnAt:anIndex
+ "redraw a column at an index including the horizontal lines
+ and the graph of the column
+ "
+ self redrawColumn:(columns at:anIndex)
+!
+
+redrawX:x y:y width:w height:h
+ "clear and redraw
+ "
+ shown ifTrue:[
+ self paint:bgColor.
+ self fillRectangleX:x y:y width:w height:h.
+ self drawX:x y:y width:w height:h.
+ ].
+! !
+
+!GraphColumnView2D methodsFor:'drawing basics'!
+
+drawGRC:aColumn x:xStart step:xStep scaleY:yScale transY:yTrans ydata:yData
+ "draw a graph
+ "
+ self drawGRX:xStart
+ step:xStep
+ scaleY:yScale
+ transY:yTrans
+ ydata:yData
+ with:(self mapColor:(aColumn foregroundColor))
+ style:(aColumn lineStyle)
+ width:(aColumn lineWidth)
+!
+
+drawGRX:xStart step:xStep scaleY:yScale transY:yTrans ydata:ydata with:aColor style:aStyle width:aWidth
+ "draw a graph
+ "
+ self paint:aColor.
+ self lineStyle:aStyle.
+ self lineWidth:aWidth.
+
+ device displayLinesFromX:xStart
+ step:xStep
+ yValues:ydata
+ scaleY:yScale
+ transY:yTrans
+ in:drawableId
+ with:gcId.
+
+ self lineStyle:#solid.
+ self lineWidth:1.
+!
+
+drawHLC:aColumn x:x y:y toX:xMax y:yMax scaleY:yScale transY:yTrans
+ "draw horizontal lines derrived from column
+ "
+ |list|
+
+ (list := aColumn hLineList) notNil ifTrue:[
+ self drawHLN:list
+ x:x
+ y:y
+ toX:xMax
+ y:yMax
+ scaleY:yScale
+ transY:yTrans
+ with:(self mapColor:(aColumn hLineFgColor))
+ style:(aColumn hLineStyle)
+ width:(aColumn hLineWidth)
+ ].
+
+
+!
+
+drawHLN:aList x:x y:y toX:xMax y:yMax scaleY:yScale transY:yTrans with:aColor style:aStyle width:aWidth
+ "draw horizontal lines derrived from list
+ "
+ self paint:aColor.
+ self lineStyle:aStyle.
+ self lineWidth:aWidth.
+
+ aList do:[:hY||dY|
+ dY := (hY * yScale + yTrans) rounded.
+
+ (dY < y or:[dY > yMax]) ifFalse:[
+ self displayLineFromX:x y:dY toX:xMax y:dY.
+ ]
+ ].
+ aStyle ~~ #solid ifTrue:[self lineStyle:#solid].
+ aWidth ~~ 1 ifTrue:[self lineWidth:1].
+
+
+!
+
+drawX:x y:y width:w height:h
+ "redraw without clearing the background
+ "
+ |saveClip stepX startX ydata hlines scaleY transY
+ x0 "{ Class:SmallInteger }"
+ y0 "{ Class:SmallInteger }"
+ xMax "{ Class:SmallInteger }"
+ yMax "{ Class:SmallInteger }"
+ step "{ Class:SmallInteger }"
+ gstep "{ Class:SmallInteger }"
+ start "{ Class:SmallInteger }"
+ stop "{ Class:SmallInteger }"
+ |
+ stepX := self stepX.
+ xMax := x + w.
+ yMax := y + h.
+ x0 := x // stepX.
+ start := x0 + 1.
+ stop := (xMax // stepX + 2) min:windowSize.
+
+ start < stop ifFalse:[^ self].
+
+ saveClip := clipRect.
+ self clippingRectangle:(Rectangle left:x top:y width:w height:h).
+
+ showGrid ifTrue:[
+ self paint:gridColor.
+ gstep := self class gridStep.
+
+"/ X-Grid
+ gridX ~~ 0 ifTrue:[
+ step := gridX * gstep.
+ x0 := (x // step) * step + gridXoffset.
+
+ [ x0 < xMax ] whileTrue:[
+ self displayLineFromX:x0 y:y toX:x0 y:yMax.
+ x0 := x0 + step.
+ ]
+ ].
+
+"/ Y-Grid
+ gridY > 0 ifTrue:[
+ step := gridY * gstep.
+
+ y0 := (y // step) * step.
+
+ [ y0 < yMax ] whileTrue:[
+ self displayLineFromX:x y:y0 toX:xMax y:y0.
+ y0 := y0 + step
+ ]
+ ]
+ ].
+
+ columns notNil ifTrue:[
+ startX := start - 1 * stepX.
+ ydata := Array new:(stop - start + 1).
+
+"/ Column
+ columns do:[:aCol|
+ aCol shown ifTrue:[
+ scaleY := self scaleYofColumn:aCol.
+ transY := self transYofColumn:aCol.
+
+ self drawHLC:aCol
+ x:x
+ y:y
+ toX:xMax
+ y:yMax
+ scaleY:scaleY
+ transY:transY.
+
+ self drawGRC:aCol
+ x:startX
+ step:stepX
+ scaleY:scaleY
+ transY:transY
+ ydata:(aCol yValuesStartAt:start into:ydata)
+ ]
+ ].
+
+"/ V-Lines
+ vLines size ~~ 0 ifTrue:[
+ self paint:vLinesColor.
+
+ vLines do:[:anIndex|
+ x0 := ((anIndex - 1) * stepX) rounded.
+
+ (x0 >= x and:[x0 <= xMax]) ifTrue:[
+ self displayLineFromX:x0
+ y:y
+ toX:x0
+ y:yMax.
+ ]
+ ]
+ ]
+ ].
+
+ self clippingRectangle:saveClip.
+!
+
+undrawColumn:aColumn scaleY:scaleY transY:transY
+ "undraw a column, than redraw all without clearing the background
+ "
+ |stepX hlines|
+
+ stepX := self stepX.
+
+ (hlines := aColumn hLineList) notNil ifTrue:[
+ self drawHLN:hlines
+ x:0
+ y:0
+ toX:width
+ y:height
+ scaleY:scaleY
+ transY:transY
+ with:bgColor
+ style:#solid
+ width:(aColumn hLineWidth)
+ ].
+
+ self drawGRX:0
+ step:stepX
+ scaleY:scaleY
+ transY:transY
+ ydata:(self yDataForColumn:aColumn)
+ with:bgColor
+ style:#solid
+ width:(aColumn lineWidth).
+
+ self drawX:0 y:0 width:width height:height
+! !
+
+!GraphColumnView2D methodsFor:'event handling'!
+
+buttonMultiPress:button x:x y:y
+ "handle a button double click event
+ "
+ ((button == 1) or:[button == #select]) ifFalse:[
+ ^ super buttonMultiPress:button x:x y:y
+ ].
+ self buttonPressBlock:doubleClickBlock x:x y:y
+!
+
+buttonPress:button x:x y:y
+ "handle a button press event
+ "
+ |menu|
+
+ ((button == 2) or:[button == #menu]) ifTrue:[
+ menu := self buttonPressBlock:menuAccessBlock x:x y:y.
+
+ menu notNil ifTrue:[
+ ^ menu startUp
+ ]
+ ] ifFalse:[
+ ((button == 1) or:[button == #select]) ifTrue:[
+ ^ self buttonPressBlock:actionBlock x:x y:y
+ ]
+ ].
+
+ super buttonPress:button x:x y:y
+!
+
+buttonPressBlock:aBlock x:x y:y
+ "evaluate the user defined block if not nil dependant on its required
+ arguments; the result of the block is returned
+ "
+ |numArgs desc index|
+
+ aBlock isNil ifTrue:[
+ ^ nil
+ ].
+ (numArgs := aBlock numArgs) == 0 ifTrue:[
+ ^ aBlock value
+ ].
+
+ (desc := self nearestColumnAtX:x y:y) isNil ifTrue:[
+ ^ nil
+ ].
+ index := self visibleIndexOfX:x.
+
+ numArgs == 1 ifTrue:[ ^ aBlock value:(desc key) ].
+ numArgs == 2 ifTrue:[ ^ aBlock value:(desc key) value:index ].
+ numArgs == 3 ifTrue:[ ^ aBlock value:(desc key) value:index value:(desc value) ].
+
+ ^ aBlock value:(desc key) value:index value:(desc value) value:y
+
+!
+
+buttonRelease:button x:x y:y
+ "handle a button release event
+ "
+ |numArgs|
+
+ buttonReleaseBlock isNil ifTrue:[
+ ^ super buttonRelease:button x:x y:y
+ ].
+ numArgs := buttonReleaseBlock numArgs.
+
+ numArgs == 0 ifTrue:[ ^ buttonReleaseBlock value ].
+ numArgs == 1 ifTrue:[ ^ buttonReleaseBlock value:x ].
+ numArgs == 2 ifTrue:[ ^ buttonReleaseBlock value:x value:y ].
+
+ buttonReleaseBlock value:x value:y value:(self visibleIndexOfX:x)
+! !
+
+!GraphColumnView2D methodsFor:'initialize'!
+
+initialize
+ "setup default values
+ "
+ super initialize.
+
+ gridXoffset := 0.
+ colorMap := Dictionary new.
+ vLines := OrderedCollection new.
+ gridX := 2.
+ gridY := 2.
+!
+
+unrealize
+ "clear colorMap
+ "
+ super unrealize.
+ colorMap := Dictionary new.
+
+! !
+
+!GraphColumnView2D methodsFor:'private'!
+
+mapColor:aColor
+ "get the same color on the device. If the argument is
+ nil, the foreground color is returned.
+ "
+ |fg|
+
+ aColor isNil ifTrue:[
+ ^ fgColor
+ ].
+ (fg := colorMap at:aColor ifAbsent:nil) isNil ifTrue:[
+ colorMap at:aColor put:(fg := aColor on:device)
+ ].
+ ^ fg
+!
+
+visibleIndexOfX:x
+ "given a x-coordinate, return index
+ "
+ ^ (x // self stepX + 1) min:windowSize
+!
+
+yDataForColumn:aColumn
+ "returns collection of visible Y-data for a column
+ "
+ ^ aColumn yValuesStartAt:1 into:(Array new:windowSize)
+
+
+! !
+
+!GraphColumnView2D methodsFor:'protocol'!
+
+colorChanged:what
+ "called if a color changed, #foreground, #background, #grid or #vLines
+ "
+ |stepX|
+
+ what == #vLines ifTrue:[
+ vLines size ~~ 0 ifTrue:[
+ stepX := self stepX.
+ self paint:vLinesColor.
+
+ vLines do:[:i||x|
+ x := ((i - 1) * stepX) rounded.
+ self displayLineFromX:x y:0 toX:x y:height.
+ ]
+ ]
+ ] ifFalse:[
+ self recomputeWholeGraph
+ ]
+
+!
+
+columnChanged:what with:oldValue from:aColumn
+ "a column changed
+ "
+ |colSY colZY colTY colRX|
+
+ (shown not or:[what == #name]) ifTrue:[ ^ self ].
+
+ (what == nil or:[self sensor hasDamageFor:self]) ifTrue:[
+ ^ self recomputeWholeGraph
+ ].
+
+ what == #shown ifTrue:[
+ aColumn shown ifTrue:[self redrawColumn:aColumn]
+ ifFalse:[self clearColumnAndRedraw:aColumn].
+
+ ^ self
+ ].
+
+ aColumn shown ifFalse:[ ^ self ].
+
+ ( what == #lineStyle
+ or:[what == #foregroundColor
+ or:[what == #lineWidth]]
+ ) ifTrue:[
+ ^ self changedGraphIn:aColumn what:what from:oldValue
+ ].
+
+ ( what == #hLineStyle
+ or:[what == #hLineFgColor
+ or:[what == #hLineWidth
+ or:[what == #hLineList ]]]
+ ) ifTrue:[
+ ^ self changedHLineIn:aColumn what:what from:oldValue
+ ].
+ colSY := aColumn scaleY.
+ colZY := aColumn zoomY.
+ colTY := aColumn transY.
+ colRX := aColumn relativeXaxis.
+
+ what == #scaleY ifTrue:[ colSY := oldValue ] ifFalse:[
+ what == #transY ifTrue:[ colTY := oldValue ] ifFalse:[
+ what == #relativeXaxis ifTrue:[ colRX := oldValue ] ifFalse:[
+ what == #zoomY ifTrue:[ colZY := oldValue ] ifFalse:[ ^ self recomputeWholeGraph ]]]].
+
+ self undrawColumn:aColumn
+ scaleY:(self absScaleY:colSY zoomY:colZY)
+ transY:(self absTransY:colTY
+ relativeTo:colRX
+ zoomY:colZY
+ ).
+!
+
+listSizeChanged:what from:aColumn
+ "called if a column is inserted (#insert:) or removed from list
+ "
+ what == #insert: ifTrue:[
+ ^ self redrawColumn:aColumn
+ ].
+
+ what == #remove: ifTrue:[
+ ^ self clearColumnAndRedraw:aColumn
+ ].
+ self recomputeWholeGraph
+!
+
+recomputeWholeGraph
+ "called if the whole graph should be recomputed
+ "
+ gridXoffset := 0.
+ self invalidate
+
+! !
+
+!GraphColumnView2D methodsFor:'queries'!
+
+hasVLineAt:anIndex
+ "returns true if a vertical line at an index already exists
+ "
+ ^ vLines includes:anIndex
+!
+
+nearestColumnAtX:x y:y
+ "returns an association containing the nearest column as key and the absolute y-distance
+ to the point x/y. If no columns exists nil is returned
+ "
+ |sX i0 dX dtY data size col|
+
+ (size := columns size) == 0 ifTrue:[^ nil ].
+
+ col := nil.
+ sX := self stepX.
+ i0 := x // sX.
+
+ sX > 1 ifFalse:[
+ dX := 0
+ ] ifTrue:[
+ (dX := x - (i0 * sX)) > 0.5 ifTrue:[dX := dX / sX]
+ ifFalse:[dX := 0]
+ ].
+ i0 := (i0 + 1) min:windowSize.
+
+ (i0 < windowSize and:[dX ~= 0]) ifTrue:[data := Array new:2]
+ ifFalse:[data := Array new:1].
+
+ columns do:[:aCol||vlY scY trY yL yR|
+ aCol shown ifTrue:[
+ vlY := aCol yValuesStartAt:i0 into:data.
+ scY := self scaleYofColumn:aCol.
+ trY := self transYofColumn:aCol.
+ yL := vlY first * scY.
+ yR := vlY last * scY.
+ yL := (yL + trY + (yR - yL * dX)) rounded.
+ yR := (y - yL) abs.
+
+ (col isNil or:[dtY > yR]) ifTrue:[
+ dtY := yR.
+ col := aCol.
+ ]
+ ]
+ ].
+
+ ^ col notNil ifTrue:[Association key:col value:dtY] ifFalse:[nil]
+
+! !
+
+!GraphColumnView2D methodsFor:'scrolling'!
+
+scroll:nIndices
+ "scroll left or right n x-steps. a positive value scrolls to the right
+ a negative value to the left.
+ "
+ |x s dX
+ w "{ Class:SmallInteger }"
+ n "{ Class:SmallInteger }"
+ |
+
+ (shown and:[nIndices ~~ 0]) ifTrue:[
+
+"/ Update V-Lines
+
+ (w := vLines size) ~~ 0 ifTrue:[
+ n := 1.
+
+ w timesRepeat:[
+ x := (vLines at:n) + nIndices.
+
+ (x between:1 and:windowSize) ifTrue:[
+ vLines at:n put:x.
+ n := n + 1.
+ ] ifFalse:[
+ vLines removeIndex:n
+ ]
+ ]
+ ].
+
+"/ Scrolling
+
+ s := self stepX.
+ n := nIndices abs.
+ w := (windowSize - 1 - n * s) rounded.
+
+ w > 30 ifTrue:[
+ x := (nIndices * s) rounded.
+
+ "/ update offset X for grid
+ (showGrid and:[gridX ~~ 0]) ifTrue:[
+ dX := gridXoffset + x.
+ gridXoffset := dX \\ (gridX * self class gridStep).
+
+ dX < 0 ifTrue:[
+ gridXoffset := gridXoffset negated
+ ].
+ ].
+ x := x abs.
+
+ nIndices < 0 ifTrue:[
+ self copyFrom:self x:x y:0 toX:0 y:0 width:w height:height async:false.
+ ] ifFalse:[
+ self copyFrom:self x:0 y:0 toX:x y:0 width:w height:height async:false.
+ w := 0.
+ ].
+ self redrawX:w y:0 width:x height:height.
+ ] ifFalse:[
+ self redrawX:0 y:0 width:width height:height.
+ ]
+ ]
+!
+
+scrollLeft:nIndices
+ "scroll n indices left
+ "
+ self scroll:(nIndices negated)
+!
+
+scrollRight:nIndices
+ "scroll n indices right
+ "
+ self scroll:nIndices
+! !
+
+!GraphColumnView2D methodsFor:'transformations'!
+
+absScaleY:aNumber zoomY:aZoomY
+ "returns y-scale for a scale Y and a zoom factor
+ "
+ ^ (aNumber negated) * zoomY * aZoomY
+!
+
+absTransY:aNumber relativeTo:xAxis zoomY:aZoomY
+ "returns absolute transition Y for a number relative
+ to a x-axis
+ "
+ |zY|
+
+ zY := zoomY * aZoomY.
+ ^ height * xAxis / zY + aNumber * zY
+
+
+
+!
+
+scaleYofColumn:aColumn
+ "returns current y-scale of a column on my view
+ "
+ ^ (aColumn scaleY negated) * zoomY * (aColumn zoomY)
+!
+
+stepX
+ "returns width of X measured in pixels; no fraction returned
+ "
+ |x|
+
+ x := width / (windowSize - 1).
+ ^ x isInteger ifTrue:[x] ifFalse:[x asFloat]
+!
+
+transYofColumn:aColumn
+ "returns current y-transition of a column on my view
+ "
+ ^ self absTransY:(aColumn transY)
+ relativeTo:(aColumn relativeXaxis)
+ zoomY:(aColumn zoomY)
+! !
+
+!GraphColumnView2D methodsFor:'user interaction & notifications'!
+
+doGridExtent:what
+ "change the grid extent factorial 2 (larger or smaller)
+ "
+ |ext|
+
+ ext := self gridExtent.
+
+ what == #larger ifTrue:[
+ ext := ext * 2
+ ] ifFalse:[
+ what == #smaller ifFalse:[
+ ^ self
+ ].
+ ext := ext // 2.
+ (ext x == 0) ifTrue:[gridX ~~ 0 ifTrue:[ext x:1]].
+ (ext y == 0) ifTrue:[gridY ~~ 0 ifTrue:[ext y:1]].
+ ].
+ self gridExtent:ext.
+
+!
+
+doGridStepX:aNumberOrSymbol
+ "change the grid step X
+ "
+ self gridX:(aNumberOrSymbol == #off ifFalse:[aNumberOrSymbol] ifTrue:[0])
+!
+
+doGridStepY:aNumberOrSymbol
+ "change the grid step Y
+ "
+ self gridY:(aNumberOrSymbol == #off ifFalse:[aNumberOrSymbol] ifTrue:[0])
+! !
+
+!GraphColumnView2D class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg2/GraphColumnView2D.st,v 1.1 1998-02-07 15:16:07 ca Exp $'
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/GraphColumnView3D.st Sat Feb 07 16:16:52 1998 +0100
@@ -0,0 +1,806 @@
+GraphColumnView subclass:#GraphColumnView3D
+ instanceVariableNames:'glxView showGraph rotateX rotateY rotateZ rotateXHolder
+ rotateYHolder rotateZHolder zoomZ zoomZHolder'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Graphs'
+!
+
+GLXView subclass:#GLXGraph
+ instanceVariableNames:'graph colorMap glxObjGraphs glxObjGrid maxY minY'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:GraphColumnView3D
+!
+
+
+!GraphColumnView3D class methodsFor:'menu'!
+
+defaultMenu
+ "this window spec was automatically generated by the ST/X MenuEditor"
+
+ "do not manually edit this - the builder may not be able to
+ handle the specification if its corrupted."
+
+ "
+ MenuEditor new openOnClass:self andSelector:#defaultMenu
+ (Menu new fromLiteralArrayEncoding:(self defaultMenu)) startUp
+ "
+
+ <resource: #menu>
+
+ ^
+
+ #(#Menu
+
+ #(
+ #(#MenuItem
+ #'label:' 'Show Columns'
+ #'indication:' #'showGraph:'
+ )
+ #(#MenuItem
+ #'label:' 'Show Grid'
+ #'indication:' #'showGrid:'
+ )
+ #(#MenuItem
+ #'label:' '-'
+ )
+ #(#MenuItem
+ #'label:' 'Zoom Y'
+ #'submenuChannel:' #subMenuZoomY
+ )
+ ) nil
+ nil
+ )
+! !
+
+!GraphColumnView3D class methodsFor:'test'!
+
+cos
+"
+self cos
+"
+ |top list view x|
+
+ top := StandardSystemView extent:800 @ 400.
+ view := GraphColumnView3D origin:0@0 extent:1.0@1.0 in:top.
+ list := OrderedCollection new.
+
+ top label:'2D-View'.
+
+ #( ( 'foo' red )
+ ( 'bar' green )
+ ( 'baz' yellow )
+ ( 'foo 2' blue )
+ ) do:[:slice|
+ |col|
+
+ col := GraphColumn name:(slice at:1).
+ col foregroundColor:(Color perform:(slice at:2)).
+
+ col functionYblock:[:start :anArray|
+ x := (start - 1) * 0.2.
+ 1 to:(anArray size) do:[:i| anArray at:i put:(x cos). x := x + 0.2 ].
+ anArray
+ ].
+ list add:col
+ ].
+
+ view showGrid:true.
+ view columns:list.
+ top open.
+
+
+
+
+
+!
+
+sin
+"
+self sin
+"
+ |top list view x|
+
+ top := StandardSystemView extent:800 @ 400.
+ view := GraphColumnView3D origin:0@0 extent:1.0@1.0 in:top.
+ list := OrderedCollection new.
+
+ top label:'2D-View'.
+
+ #( ( 'foo' red )
+ ( 'bar' green )
+ ( 'baz' yellow )
+ ( 'foo 2' blue )
+ ) do:[:slice|
+ |col|
+
+ col := GraphColumn name:(slice at:1).
+ col foregroundColor:(Color perform:(slice at:2)).
+
+ col functionYblock:[:start :anArray|
+ x := (start - 1) * 0.2.
+ 1 to:(anArray size) do:[:i| anArray at:i put:(x sin). x := x + 0.2 ].
+ anArray
+ ].
+ list add:col
+ ].
+
+ view showGrid:true.
+ view columns:list.
+ top open.
+!
+
+tan
+"
+self tan
+"
+
+ |top list view x step|
+
+ top := StandardSystemView extent:800 @ 400.
+ view := GraphColumnView3D origin:0@0 extent:1.0@1.0 in:top.
+ list := OrderedCollection new.
+
+ top label:'2D-View'.
+
+ step := 0.04.
+
+ #( ( 'foo' red )
+ ( 'bar' green )
+ ( 'baz' yellow )
+ ( 'foo 2' blue )
+ ) do:[:slice|
+ |col|
+
+ col := GraphColumn name:(slice at:1).
+ col foregroundColor:(Color perform:(slice at:2)).
+
+ col functionYblock:[:start :anArray|
+ x := (start - 1) * step.
+ 1 to:(anArray size) do:[:i| anArray at:i put:(x tan). x := x + step ].
+ anArray
+ ].
+ list add:col
+ ].
+
+ view showGrid:true.
+ view columns:list.
+ top open.
+
+
+
+
+
+!
+
+test
+"
+self test
+"
+ |top list view x|
+
+ top := StandardSystemView extent:800 @ 400.
+ view := GraphColumnView3D origin:0@0 extent:1.0@1.0 in:top.
+ list := OrderedCollection new.
+
+ top label:'2D-View'.
+
+ #( red green yellow blue
+ ) keysAndValuesDo:[:idx :aColor|
+ |col|
+
+ col := GraphColumn name:idx.
+ col foregroundColor:(Color perform:aColor).
+
+ col functionYblock:[:start :anArray|
+ x := (start - 1) * 0.2.
+ (idx == 1 or:[idx == 3]) ifTrue:[
+ 1 to:(anArray size) do:[:i| anArray at:i put:(x sin). x := x + 0.2 ].
+ ] ifFalse:[
+ 1 to:(anArray size) do:[:i| anArray at:i put:(x cos). x := x + 0.2 ].
+ ].
+ anArray
+ ].
+ list add:col
+ ].
+
+ view showGrid:true.
+ view columns:list.
+ top open.
+
+
+
+
+
+! !
+
+!GraphColumnView3D methodsFor:'accessing look'!
+
+showGraph
+ "show or hide columns; if the grid is enabled, only the grid will be
+ shown
+ "
+ ^ showGraph
+!
+
+showGraph:aBool
+ "show or hide columns; if the grid is enabled, only the grid will be
+ shown
+ "
+ showGraph ~~ aBool ifTrue:[
+ showGraph := aBool.
+ glxView recomputeGraph.
+ ].
+!
+
+zoomZ
+ "returns the current z-zoom factor
+ "
+ ^ zoomZ
+!
+
+zoomZ:aValue
+ "set the current z-zoom factor; if the argument is nil,
+ the z-zoom is set to 1 ( no zoom ).
+ "
+ |zZ|
+
+ (zZ := self floatFrom:aValue onError:[1]) <= 0 ifTrue:[
+ zZ := 1
+ ].
+
+ zZ = zoomZ ifFalse:[
+ zoomZ := zZ.
+ self invalidateGraph
+ ]
+! !
+
+!GraphColumnView3D methodsFor:'accessing mvc'!
+
+rotateXHolder
+ "returns the valueHolder, which keeps the current rotation X value
+ "
+ ^ rotateXHolder
+
+!
+
+rotateXHolder:aHolder
+ "set the valueHolder, which keeps the current rotation X value
+ "
+ rotateXHolder == aHolder ifFalse:[
+ rotateXHolder notNil ifTrue:[
+ rotateXHolder removeDependent:self
+ ].
+ (rotateXHolder := aHolder) notNil ifTrue:[
+ rotateXHolder addDependent:self
+ ]
+ ].
+ self rotateX:(rotateXHolder value)
+!
+
+rotateYHolder
+ "returns the valueHolder, which keeps the current rotation Y value
+ "
+ ^ rotateYHolder
+
+!
+
+rotateYHolder:aHolder
+ "set the valueHolder, which keeps the current rotation Y value
+ "
+ rotateYHolder == aHolder ifFalse:[
+ rotateYHolder notNil ifTrue:[
+ rotateYHolder removeDependent:self
+ ].
+ (rotateYHolder := aHolder) notNil ifTrue:[
+ rotateYHolder addDependent:self
+ ]
+ ].
+ self rotateY:(rotateYHolder value)
+
+!
+
+rotateZHolder
+ "returns the valueHolder, which keeps the current rotation Z value
+ "
+ ^ rotateZHolder
+
+!
+
+rotateZHolder:aHolder
+ "set the valueHolder, which keeps the current rotation Z value
+ "
+ rotateZHolder == aHolder ifFalse:[
+ rotateZHolder notNil ifTrue:[
+ rotateZHolder removeDependent:self
+ ].
+ (rotateZHolder := aHolder) notNil ifTrue:[
+ rotateZHolder addDependent:self
+ ]
+ ].
+ self rotateZ:(rotateZHolder value)
+
+!
+
+zoomZHolder
+ "returns the valueHolder, which keeps the current zoom Z value
+ "
+ ^ zoomZHolder
+
+!
+
+zoomZHolder:aHolder
+ "set the valueHolder, which keeps the current zoom Z value
+ "
+ zoomZHolder == aHolder ifFalse:[
+ zoomZHolder notNil ifTrue:[
+ zoomZHolder removeDependent:self
+ ].
+ (zoomZHolder := aHolder) notNil ifTrue:[
+ zoomZHolder addDependent:self
+ ]
+ ].
+ self zoomZ:(zoomZHolder value)
+! !
+
+!GraphColumnView3D methodsFor:'change & update'!
+
+update:what with:aPara from:chgObj
+ "catch and handle a change notification of any object
+ "
+ chgObj == rotateXHolder ifTrue:[ ^ self rotateX:(rotateXHolder value) ].
+ chgObj == rotateYHolder ifTrue:[ ^ self rotateY:(rotateYHolder value) ].
+ chgObj == rotateZHolder ifTrue:[ ^ self rotateZ:(rotateZHolder value) ].
+
+ chgObj == zoomZHolder ifTrue:[ ^ self zoomZ:(zoomZHolder value) ].
+
+ super update:what with:aPara from:chgObj
+! !
+
+!GraphColumnView3D methodsFor:'converting'!
+
+rotateValueFrom:aNumber
+ "converts a value to a valid rotation value
+ "
+ |r|
+
+ r := self unsignedIntegerFrom:aNumber onError:[0].
+ ^ r < 360 ifTrue:[r] ifFalse:[r \\ 360]
+! !
+
+!GraphColumnView3D methodsFor:'initialization'!
+
+destroy
+ "remove dependencies
+ "
+ super destroy.
+
+ rotateXHolder removeDependent:self.
+ rotateYHolder removeDependent:self.
+ rotateZHolder removeDependent:self.
+ zoomZHolder removeDependent:self.
+
+!
+
+initialize
+ "setup default values
+ "
+ super initialize.
+
+ rotateX := 45.
+ rotateY := 45.
+ rotateZ := 0.
+ zoomZ := 1.
+
+ showGraph := true.
+ glxView := GLXGraph for:self.
+
+! !
+
+!GraphColumnView3D methodsFor:'protocol'!
+
+colorChanged:what
+ "called if a color changed, #foreground, #background, #grid or #vLines
+ "
+ what == #foreground ifTrue:[
+ glxView recomputeGraph
+ ] ifFalse:[
+ what == #grid ifTrue:[
+ glxView recomputeGrid
+ ] ifFalse:[
+ glxView recomputeWholeGraph
+ ]
+ ]
+!
+
+columnChanged:what with:oldValue from:aColumn
+ "a column changed
+ "
+ (
+ #( lineStyle lineWidth
+ hLineStyle hLineWidth hLineFgColor hLineList
+ scaleY relativeXaxis
+ transY
+ ) includesIdentical:what
+ ) ifTrue:[
+ ^ self
+ ].
+
+ what == #foregroundColor ifTrue:[
+ ^ glxView recomputeGraph
+ ].
+
+ glxView recomputeWholeGraph
+
+!
+
+invalidateGraph
+ "called to set the glxView to invalidate, to force a redraw
+ "
+ glxView invalidate
+!
+
+recomputeWholeGraph
+ "called to force the glxView to recompute all columns and the grid
+ "
+ glxView recomputeWholeGraph
+
+! !
+
+!GraphColumnView3D methodsFor:'rotation'!
+
+rotateX
+ "returns the rotation X value; range: 0 .. 360
+ "
+ ^ rotateX
+!
+
+rotateX:aValue
+ "set the rotation X value; range: 0 .. 360
+ "
+ |r|
+
+ (r := self rotateValueFrom:aValue) ~~ rotateX ifTrue:[
+ rotateX := r.
+ self invalidateGraph
+ ]
+!
+
+rotateY
+ "returns the rotation Y value; range: 0 .. 360
+ "
+ ^ rotateY
+
+!
+
+rotateY:aValue
+ "set the rotation Y value; range: 0 .. 360
+ "
+ |r|
+
+ (r := self rotateValueFrom:aValue) ~~ rotateY ifTrue:[
+ rotateY := r.
+ self invalidateGraph
+ ]
+
+!
+
+rotateZ
+ "returns the rotation Z value; range: 0 .. 360
+ "
+ ^ rotateZ
+
+!
+
+rotateZ:aValue
+ "set the rotation Z value; range: 0 .. 360
+ "
+ |r|
+
+ (r := self rotateValueFrom:aValue) ~~ rotateZ ifTrue:[
+ rotateZ := r.
+ self invalidateGraph
+ ]
+
+! !
+
+!GraphColumnView3D::GLXGraph class methodsFor:'instance creation'!
+
+for:aGraph
+ |graph|
+
+ graph := self extent:(1.0 @ 1.0) in:aGraph.
+ graph for:aGraph.
+ ^ graph
+
+
+! !
+
+!GraphColumnView3D::GLXGraph methodsFor:'drawing'!
+
+redraw
+ "redraw
+ "
+ shown ifTrue:[
+ self redrawInBackBuffer.
+ self swapBuffers.
+ self sensor flushExposeEventsFor:self.
+ ]
+
+!
+
+redrawGraph
+ "draw the graph and spawn the grid dependend on the enabled
+ attributes
+ "
+ |y z x data yVal
+
+ colNr "{ Class:SmallInteger }"
+ noRows "| Class:SmallInteger }"
+ r "{ Class:SmallInteger }"
+ |
+ noRows := graph windowSize.
+ z := 0.0.
+ data := Array new:noRows.
+ maxY := nil.
+
+ graph columns do:[:aCol|
+ aCol shown ifTrue:[
+ yVal := aCol yValuesStartAt:1 into:data.
+ x := 0.0.
+ r := 1.
+
+ maxY isNil ifTrue:[
+ maxY := minY := yVal at:r
+ ].
+ self setColor:(aCol foregroundColor).
+ device glxBeginLineIn:drawableId.
+
+ noRows timesRepeat:[
+ y := yVal at:r.
+ maxY := maxY max:y.
+ minY := minY min:y.
+
+ device glxV3fX:x y:y z:z in:drawableId.
+ x := x + 1.0.
+ r := r + 1.
+ ].
+
+ device glxEndLineIn:drawableId.
+ z := z + 1.0.
+ ]
+ ]
+!
+
+redrawGrid
+ "draw the graph and spawn the grid dependend on the enabled
+ attributes
+ "
+ |y z x visCols data
+
+ noRows "| Class:SmallInteger }"
+ r "{ Class:SmallInteger }"
+ |
+ visCols := graph columns select:[:c| c shown ].
+
+ visCols size < 2 ifTrue:[
+ ^ self
+ ].
+ noRows := graph windowSize.
+ x := 0.0.
+ r := 1.
+ data := Array new:1.
+ maxY := minY := (visCols at:1) yValueAt:1.
+
+ self setColor:(graph gridColor).
+
+ noRows timesRepeat:[
+ device glxBeginLineIn:drawableId.
+ z := 0.0.
+
+ visCols do:[:aCol|
+ y := aCol yValueAt:r.
+ maxY := maxY max:y.
+ minY := minY min:y.
+
+ device glxV3fX:x y:y z:z in:drawableId.
+ z := z + 1.0.
+ ].
+
+ device glxEndLineIn:drawableId.
+ x := x + 1.0.
+ r := r + 1.
+ ].
+
+
+
+
+!
+
+redrawInBackBuffer
+ "redraw in back
+ "
+ |sY sX noCols dY winSize|
+
+ self setColor:(graph backgroundColor).
+ self clear.
+
+ (noCols := graph numberOfVisibleColumns) == 0 ifTrue:[ "/ no shown columns
+ ^ self
+ ].
+
+ winSize := graph windowSize.
+
+ (graph showGrid and:[glxObjGrid isNil]) ifTrue:[
+ self makeObject:(glxObjGrid := self newObjectId).
+ self redrawGrid.
+ self closeObject.
+ ].
+
+ (graph showGraph and:[glxObjGraphs isNil]) ifTrue:[
+ self makeObject:(glxObjGraphs := self newObjectId).
+ self redrawGraph.
+ self closeObject.
+ ].
+
+ dY := (maxY - minY) / 2.
+ sX := 1.9 / winSize.
+ sY := ((0.5 / (dY max:2.0)) min:sX) * graph zoomY.
+
+
+ self pushMatrix.
+
+ self rotateX:(graph rotateX) y:(graph rotateY) z:(graph rotateZ).
+ self scaleX:sX y:sY z:(graph zoomZ * (1.0 / noCols)).
+
+ self translateX:(winSize / -2.0) "/ rotate center line
+ y:(dY - maxY) "/ translate to center
+ z:(noCols / -2.0). "/ rotate center line
+
+ graph showGrid ifTrue:[ self callObject:glxObjGrid ].
+ graph showGraph ifTrue:[ self callObject:glxObjGraphs ].
+ self popMatrix.
+
+
+
+
+
+! !
+
+!GraphColumnView3D::GLXGraph methodsFor:'event handling'!
+
+buttonPress:button x:x y:y
+ "delegate button to graph
+ "
+ graph buttonPress:button x:x y:y
+! !
+
+!GraphColumnView3D::GLXGraph methodsFor:'initialization'!
+
+destroy
+ "remove dependencies
+ "
+ super destroy.
+ self deleteAllObjects.
+
+!
+
+for:aGraph
+ graph := aGraph
+!
+
+initialize
+ "setup default values
+ "
+ super initialize.
+
+ type := #colorIndexDoubleBuffer. "/ works on any device
+ colorMap := Dictionary new.
+ maxY := 1.0.
+ minY := -1.0.
+!
+
+realize
+ "define orthogonal projection; switch to back buffer drawing
+ "
+ super realize.
+ device glxOrthoLeft:-1.0 right:1.0 bottom:-1.0 top:1.0 near:10.0 far:-10.0 in:drawableId.
+ self backBuffer.
+
+!
+
+unrealize
+ "clear colorMap and objects
+ "
+ super unrealize.
+ self deleteAllObjects.
+
+ colorMap := Dictionary new.
+
+! !
+
+!GraphColumnView3D::GLXGraph methodsFor:'private'!
+
+deleteAllObjects
+ "delete all graphical objects
+ "
+ glxObjGraphs notNil ifTrue:[
+ self deleteObject:glxObjGraphs.
+ glxObjGraphs := nil
+ ].
+
+ glxObjGrid notNil ifTrue:[
+ self deleteObject:glxObjGrid.
+ glxObjGrid := nil.
+ ].
+
+ colorMap do:[:aColIndex|
+ ].
+
+!
+
+setColor:aColor
+ |index useCol|
+
+ useCol := aColor ? graph foregroundColor.
+
+ index := colorMap at:useCol ifAbsent:nil.
+
+ index isNil ifTrue:[
+ index := colorMap size + self class numberOfStandardColors.
+ colorMap at:(useCol on:device) put:index.
+
+ self colorRed:(useCol red) green:(useCol green) blue:(useCol blue).
+
+ self mapColor:index
+ red:(useCol redByte)
+ green:(useCol greenByte)
+ blue:(useCol blueByte).
+ ].
+ self color:index.
+
+
+!
+
+stepZ
+ ^ 1.0
+! !
+
+!GraphColumnView3D::GLXGraph methodsFor:'recomputation'!
+
+recomputeGraph
+ "recompute graph and redraw the graph
+ "
+ glxObjGraphs notNil ifTrue:[
+ self deleteObject:glxObjGraphs.
+ glxObjGraphs := nil
+ ].
+ self invalidate.
+!
+
+recomputeGrid
+ "recompute graph and redraw the graph
+ "
+ glxObjGrid notNil ifTrue:[
+ self deleteObject:glxObjGrid.
+ glxObjGrid := nil
+ ].
+ self invalidate.
+
+!
+
+recomputeWholeGraph
+ "recompute columns and grid
+ "
+ self deleteAllObjects.
+ self invalidate
+
+
+! !
+
+!GraphColumnView3D class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libwidg2/GraphColumnView3D.st,v 1.1 1998-02-07 15:16:52 ca Exp $'
+! !