Fix loong standing bug with some menus not being translated / resolved
This has happened with browser "View" menu when sometimes it had
the slice resolved and sometimes not. It turned out that it was because
the code disabled resources (and therefore slices) resolution when
processing shortcuts, so the menu was created and cached unresolved.
This fixes the issue. eXept apparently run into the same problem.
"{ Package: 'stx:libwidg2' }"
"{ NameSpace: Smalltalk }"
GraphColumnView subclass:#GraphColumnView2D
instanceVariableNames:'colorMap gridXoffset gridX gridY actionBlock doubleClickBlock
buttonReleaseBlock menuAccessBlock'
classVariableNames:''
poolDictionaries:''
category:'Views-Graphs'
!
!GraphColumnView2D class methodsFor:'documentation'!
documentation
"
The class provides all the functionality for showing, scrolling and manipulating graphs
described through to a GraphColumn description. Each change in a graph description
immediately take affect.
[See also:]
GraphColumn
GraphColumnView
GraphColumnView3D
[Author:]
Claus Atzkern
"
! !
!GraphColumnView2D class methodsFor:'defaults'!
gridStep
^ 8
! !
!GraphColumnView2D class methodsFor:'examples'!
test0
"testing references and actions
start with:
self test0
"
|top col view x|
top := StandardSystemView extent:800 @ 400.
view := GraphColumnView2D origin:0@0 extent:1.0@1.0 in:top.
top label:'2D-View'.
col := GraphColumn name:' sqrt(x) '.
col relativeXaxis:0.5.
col lineStyle:#solid.
col hLineStyle:#dashed.
col hLineList:#( 0 ).
col scaleY:40.
col functionYblock:[:start :array|
x := 0.001.
1 to:(array size) do:[:i| array at:i put:(x ln - (0.1*x)). x := x + 0.1 ].
array
].
view showDefaultMenu:true.
view showGrid:true.
view columns:{ col }.
top openAndWait.
!
test1
"testing references 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 referenceAdd: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 time
label butAct button b1 b2|
top := StandardSystemView extent:950 @ 400.
listView := ListView origin:0.0@20 corner:150@1.0 in:top.
graph := GraphColumnView2D origin:150@0 corner:1.0@1.0 in:top.
listView level:1.
(Label origin:2@2 in:top) label:'Delay:'.
time := 0.1.
label := Label origin:82@1 corner:128@19 in:top.
label sizeFixed:true.
label label:(time printString).
label level:1.
butAct := [:dT| time := (time + dT) max:0.0. label label:(time printString) ].
button := (ArrowButton leftIn:top) origin:60@0 extent:20@20.
button action:[butAct value:-0.05].
button autoRepeat:true.
button := (ArrowButton rightIn:top) origin:130@0 extent:20@20.
button action:[butAct value:0.05].
button autoRepeat:true.
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 realized and:[time > 0]) ifTrue:[Delay waitForSeconds:time] ].
[ [top realized] 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:( 'REFERENCES' ).
listView add:( ' Add' ).
#( 7 15 43 90 ) do:[:i| graph referenceAdd:i. pause value].
top realized ifTrue:[Delay waitForSeconds:time].
sav := graph referenceColor.
listView add:( ' Color' ).
graph referenceColor:blue.
pause value.
graph referenceColor:sav.
listView add:( ' Remove' ).
#( 7 15 43 90 ) do:[:i| graph referenceRemove:i. pause value ].
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 realized ifTrue:[Delay waitForSeconds:tmOut]
] ifFalse:[
next := false.
[(next not and:[top realized])] whileTrue:[
Delay waitForSeconds:0.2
]
]
].
[ |sav rsl wsl arg dsc|
[top realized] 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 lblX lblT lblC cbox halt xOrigin|
halt := false.
top := StandardSystemView extent:800 @ 400.
view := GraphColumnView2D origin:0@20 extent:1.0@1.0 in:top.
cbox := CheckBox origin:0@0.0 corner:50@20 in:top.
cbox label:'Stop'.
cbox action:[:v| halt := v].
xOrigin := 1 asValue.
lblX := Label origin:100@0.0 corner:0.4@20 in:top.
lblT := Label origin:0.4@0.0 corner:0.7@20 in:top.
lblC := Label origin:0.7@0.0 corner:1.0@20 in:top.
lblX level:1. lblX adjust:#left.
lblT level:1. lblT adjust:#left.
lblC level:1. lblC adjust:#left.
offs := 0.
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 * 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.
view windowSize:50.
view scrollUpdatesOriginX:true.
view graphOriginXHolder:xOrigin.
top openAndWait.
[ |tm total inc|
inc := 0.
total := 0.
[top realized] whileTrue:[
halt ifFalse:[
lblX label:('X-Offset: ', view graphOriginX printString).
lblT label:('Total Time: ', (total // 1000) printString, '::', (total \\ 1000) printString ).
lblC label:('Runs: ', inc printString).
tm := Time millisecondsToRun:[
xOrigin value:(xOrigin value + step)
].
inc := inc + 1.
total := total + tm.
] ifTrue:[
Delay waitForSeconds:0.2
]
]
] 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: 'Show Grid'
#indication: #showGrid:
)
#(#MenuItem
#label: 'Show References'
#indication: #showReferences:
)
#(#MenuItem
#label: 'Grid Extent'
#enabled: #showGrid
#submenu:
#(#Menu
#(
#(#MenuItem
#label: 'Extent'
#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
)
#(#MenuItem
#label: 'Print'
#value: #doPrint
)
) 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 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
"returns 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
"returns the horizontal size of the grid or 0 if the horizontal grid is disabled
"
^ gridX
!
gridX:aValue
"set the horizontal size of the grid or 0 if the horizontal grid should be invisible
"
|x|
x := self unsignedIntegerFrom:aValue onError:[gridX].
x ~~ gridX ifTrue:[
gridX := x.
self doRecomputeGraph.
]
!
gridY
"returns the vertical size of the grid or 0 if the vertical grid is disabled
"
^ gridY
!
gridY:aValue
"set the vertical size of the grid or 0 if the vertical grid should be invisible
"
|y|
y := self unsignedIntegerFrom:aValue onError:[gridY].
y ~~ gridY ifTrue:[
gridY := y.
self doRecomputeGraph
]
! !
!GraphColumnView2D methodsFor:'change & update'!
changedGraphIn:aColumn what:what from:oldValue
"the graph assigned to the column description 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
"the horizontal lines assigned to the column description 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:'displaying'!
displayOn:aGC
"ST-80 Compatibility
display the receiver in a graphicsContext at 0@0
- this method allows for any object to be displayed in some view
or on a printer
(although the fallBack is to display its printString ...)
"
self displayOn:aGC x:0 y:0
!
displayOn:aGC at:aPoint
"ST-80 Compatibility
display the receiver in a graphicsContext - this method allows
for any object to be displayed on a Printer - for example.
"
self displayOn:aGC x:(aPoint x) y:(aPoint y)
!
displayOn:aGC x:x y:y
"ST-80 Compatibility
display the receiver in a graphicsContext - this method allows
for any object to be displayed on a Printer - for example.
"
|w h|
w := aGC width - x.
h := aGC height - y.
(w > 0 and:[h > 0]) ifTrue:[
self displayOn:aGC x:x y:y w:w h:(h min:height)
] ifFalse:[
self halt
]
!
displayOn:aGC x:x y:y w:w h:h
|n s sX tY list yData maxX maxY oldClip oldTrans|
oldClip := aGC clippingRectangleOrNil.
oldTrans := aGC transformation.
sX := (w / (windowSize - 1)) asFloat.
aGC transformation:(WindowingTransformation scale:1 translation:(x @ y)).
aGC clippingRectangle:(Rectangle left:0 top:0 width:w height:h).
showGrid ifTrue:[
aGC viewBackground ~= gridColor ifTrue:[
aGC paint:gridColor.
] ifFalse:[
aGC paint:(Color green lightened)
].
gridX ~~ 0 ifTrue:[
s := gridX * self class gridStep.
n := 0.
[ n < w ] whileTrue:[ aGC displayLineFromX:n y:0 toX:n y:h. n := n + s ]
].
gridY > 0 ifTrue:[
s := gridY * self class gridStep.
n := 0.
[ n < h ] whileTrue:[ aGC displayLineFromX:0 y:n toX:w y:n. n := n + s ]
]
].
(list := self listOfVisibleRefIndices) isEmpty ifFalse:[
aGC paint:referenceColor.
list do:[:i||rX|
((rX := (i * sX) rounded) >= 0 and:[rX <= w]) ifTrue:[
aGC displayLineFromX:rX y:0 toX:rX y:h
]
]
].
yData := Array new:((w // sX + 2) min:windowSize).
aGC paint:fgColor.
self listOfVisibleColumns do:[:aCol|
tY := zoomY * aCol zoomY.
tY := h * (aCol relativeXaxis) / tY + (aCol transY) * tY.
aGC transformation:(WindowingTransformation scale:(sX @ (self scaleYofColumn:aCol))
translation:(x @ (y + tY))).
(list := aCol hLineList) size ~~ 0 ifTrue:[
list do:[:y|
aGC paint:(aCol hLineFgColor ? fgColor).
aGC lineStyle:aCol hLineStyle.
aGC lineWidth:(aCol hLineWidth).
aGC displayLineFromX:0 y:y toX:(windowSize - 1) y:y.
]
].
(aCol yValuesStartAt:graphOriginX into:yData) keysAndValuesDo:[:i :y|
yData at:i put:(i - 1 @ y)
].
aGC paint:(aCol foregroundColor ? fgColor).
aGC lineStyle:aCol lineStyle.
aGC lineWidth:(aCol lineWidth).
aGC displayPolygon:yData.
].
aGC transformation:oldTrans.
aGC clippingRectangle:oldClip.
aGC lineStyle:#solid.
aGC lineWidth:0.
aGC paint:fgColor.
aGC displayRectangleX:x y:y width:w height:h
!
doPrint
"print the current visible contents on the printer
"
|printer w h|
(printer := Printer new) isNil ifTrue:[
self error:'cannot open printer'.
^ self
].
self withWaitCursorDo:[
Printer writeErrorSignal handle:[:ex |
self warn:('error while printing:\\'
, ex errorString
, '\\(printing with: ' , (Printer printCommand) , ')') withCRs
] do:[
printer setNative:true.
printer nextPutAll:'OriginalState setgstate'; cr.
printer := PSGraphicsContext on:printer origin:(0 @ 0) corner:( 1.0 @ 1.0 ).
w := printer width - printer rightMargin - printer leftMargin.
h := printer height min:height.
self displayOn:printer x:0 y:0 w:w h:h.
].
printer close
].
! !
!GraphColumnView2D methodsFor:'drawing'!
clearColumnAndRedraw:aColumn
"undraw a column and redraw the view without clearing the background
"
shown ifTrue:[
(self sensor hasDamageFor:self) ifTrue:[
self invalidate
] 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 test1
"
|xNext xLast yLast yNext|
ydata size == 0 ifTrue:[^ self].
self paint:aColor.
self lineStyle:aStyle.
self lineWidth:aWidth.
ydata size == 0 ifTrue:[^ self].
xLast := xStart.
yLast := (ydata at:1) * yScale + yTrans.
ydata from:2 do:[:y |
xNext := xLast + xStep.
yNext := y * yScale + yTrans.
self displayLineFromX:xLast rounded y:yLast rounded toX:xNext rounded y:yNext rounded.
xLast := xNext.
yLast := yNext.
].
!
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].
!
drawReferencesFromX:x0 y:y0 to:x1 y:y1
"redraw visible references
"
|x stepX refLines|
refLines := self listOfVisibleRefIndices.
refLines notEmpty ifTrue:[
stepX := self stepX.
self paint:referenceColor.
refLines do:[:anIndex|
x := (anIndex * stepX) rounded.
(x >= x0 and:[x <= x1]) ifTrue:[
self displayLineFromX:x y:y0 toX:x y:y1
]
]
].
!
drawX:x y:y width:w height:h
"redraw without clearing the background
"
|saveClip yValues xStep xStart yScale yTrans
xIndex "{ Class:SmallInteger }"
x0 "{ Class:SmallInteger }"
y0 "{ Class:SmallInteger }"
xMax "{ Class:SmallInteger }"
yMax "{ Class:SmallInteger }"
step "{ Class:SmallInteger }"
gstep "{ Class:SmallInteger }"
start "{ Class:SmallInteger }"
stop "{ Class:SmallInteger }"
|
xStep := self stepX.
xMax := x + w.
yMax := y + h.
x0 := x // xStep.
start := x0 + 1.
stop := (xMax // xStep + 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:[
xStart := start - 1 * xStep.
xIndex := start - 1 + graphOriginX.
yValues := Array new:(stop - start + 1).
"/ Column
columns do:[:aCol|
aCol shown ifTrue:[
yScale := self scaleYofColumn:aCol.
yTrans := self transYofColumn:aCol.
self drawHLC:aCol x:x y:y toX:xMax y:yMax scaleY:yScale transY:yTrans.
self drawGRC:aCol x:xStart step:xStep scaleY:yScale transY:yTrans
ydata:(aCol yValuesStartAt:xIndex into:yValues)
]
].
"/ V-Lines
self drawReferencesFromX:x y:y to:xMax 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 dependent 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 absoluteIndexOfX: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 absoluteIndexOfX:x)
! !
!GraphColumnView2D methodsFor:'initialize'!
initialize
"setup default values
"
super initialize.
gridXoffset := 0.
colorMap := Dictionary 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 onDevice:device)
].
^ fg
!
yDataForColumn:aColumn
"returns collection of visible Y-data for a column
"
^ aColumn yValuesStartAt:graphOriginX into:(Array new:windowSize)
! !
!GraphColumnView2D methodsFor:'protocol'!
doRecomputeGraph
"called to recompute drawable objects and to set the graph to invalidate
"
gridXoffset := 0.
shown ifTrue:[
self invalidate.
]
!
updateColumns:what with:oldValue from:aColumn
"called if the list of columns changed
#size the size of the columns
#color: color changed
or a specific column:( aColumn notNil )
#insert: insert a new column
#remove: remove a column
or a specific attribute derived from the
changed column.
"
|colSY colZY colTY colRX|
shown ifFalse:[
^ self
].
(what == nil or:[self sensor hasDamageFor:self]) ifTrue:[
^ self invalidate
].
aColumn isNil ifTrue:[
^ self doRecomputeGraph
].
what == #insert: ifTrue:[ ^ self redrawColumn:aColumn ].
what == #remove: ifTrue:[ ^ self clearColumnAndRedraw:aColumn ].
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 doRecomputeGraph ]]]].
self undrawColumn:aColumn
scaleY:(self absScaleY:colSY zoomY:colZY)
transY:(self absTransY:colTY
relativeTo:colRX
zoomY:colZY
).
!
updateOriginX:nIndices
"scroll left or right n x-steps. A positive value scrolls to the right
a negative value to the left.
"
|
x "{ Class:SmallInteger }"
w "{ Class:SmallInteger }"
gridDeltaX "{ Class:SmallInteger }"
|
x := (nIndices * self stepX) rounded.
w := width - (x abs).
"/ update offset X for the grid
(showGrid and:[gridX ~~ 0]) ifTrue:[
gridDeltaX := gridXoffset + x.
gridXoffset := gridDeltaX \\ (gridX * self class gridStep).
gridDeltaX < 0 ifTrue:[
gridXoffset := gridXoffset negated
].
].
"/ scrolling & redraw
x := x abs.
self catchExpose.
nIndices < 0 ifTrue:[ "/ scroll left
self copyFrom:self x:x y:0 toX:0 y:0 width:w height:height async:true.
self redrawX:w y:0 width:x height:height.
] ifFalse:[ "/ scroll right
self copyFrom:self x:0 y:0 toX:x y:0 width:w height:height async:true.
self redrawX:0 y:0 width:x height:height.
].
self waitForExpose.
!
updateReferences:what atRelX:relX
"called when the list of references changed.
#remove: the reference at the relative X index is removed
#insert: a reference is inserted at the relative X index
#size the list of references changed
#state visibility state changed
#color the foreground color changed
"
|x|
shown ifTrue:[
showReferences ifFalse:[
what == #state ifTrue:[
self doRecomputeGraph
]
] ifTrue:[
(what == #color or:[what == #state]) ifTrue:[
self drawReferencesFromX:0 y:0 to:width y:height
] ifFalse:[
(what == #insert: or:[what == #remove:]) ifTrue:[
x := (relX * self stepX) rounded.
what == #insert: ifTrue:[
self paint:referenceColor.
self displayLineFromX:x y:0 toX:x y:height
] ifFalse:[
self redrawX:x y:0 width:1 height:height
]
] ifFalse:[
self doRecomputeGraph
]
]
]
]
! !
!GraphColumnView2D methodsFor:'queries'!
absoluteIndexOfX:x
"returns the absolute X value for a visible x
"
^ (x // self stepX) + graphOriginX
!
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 dX dtY data col
i0 "{ Class:SmallInteger }"
|
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].
i0 := i0 + graphOriginX.
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:'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$'
! !