"
COPYRIGHT (c) 1999 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
"{ Package: 'stx:libwidg2' }"
View subclass:#ListModelView
instanceVariableNames:'list listHolder textStartLeft viewOrigin enabled fgColor bgColor
lineSpacing widthOfContents computeWidthInRange startOfLinesY
autoScroll autoScrollBlock scrollWhenUpdating hasConstantHeight
constantHeight previousExtent renderer'
classVariableNames:'DefaultForegroundColor DefaultBackgroundColor DefaultShadowColor
DefaultLightColor StopRedrawSignal'
poolDictionaries:''
category:'Views-Lists'
!
Object subclass:#Renderer
instanceVariableNames:'view'
classVariableNames:''
poolDictionaries:''
privateIn:ListModelView
!
!ListModelView class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1999 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
documentation
"
This widget is a new improved revision of the good-old ListView.
In contrast to ListView, this one reacts on changes of the
underlying model and performs optimized redraws.
It requires a List (or alike) as model.
This class can only passively display collections of elements.
The class doesn't keep its own list, it works directly on
the model( List or HierarchicalList ).
Each list item is obligated to provide 3 services:
- heightOn:aGC
- widthOn:aGC
- displayOn:aGC x:x y:y
[Instance variables:]
list <List-Model> List or HierarchicalList ...
listHolder <Model> Model, which keeps a List
textStartLeft <Number> left inset of text
viewOrigin <Point> the current origin
enabled <Boolean> widget is enabled/disabeled
fgColor <Color> color to draw characters
bgColor <Color> the background
lineSpacing <Number> pixels between lines
widthOfContents <Number> cached width of widest line
computeWidthInRange <Point> used for recompute width of contents
startOfLinesY <Collection> keeps all the absolute Y-start positions
for each line in the list. The first
entry into the list is the top Y inset.
supportsDisplayInRange <Boolean> set to true if the list elements
supports the service:
#displayOn:x:y:h:
hasConstantHeight <Boolean> true, than each line has the same height
constantHeight <SmallInteger> hasConstantHeight is turned on, this
is the used line height
[author:]
Claus Atzkern
[see also:]
SelectionInListModelView
HierarchicalListView
List
HierarchicalList
"
!
examples
"
[exBegin]
|top list view up index|
list := List new.
top := StandardSystemView new; extent:300@300.
view := ScrollableView for:ListModelView miniScroller:true
origin:0.0@0.0 corner:1.0@1.0 in:top.
view list:list.
top openAndWait.
up := true.
[top shown] whileTrue:[
Delay waitForSeconds:0.2.
up ifTrue:[
index := 1 + (list size).
list add:('element: ', index printString).
up := index < 20
] ifFalse:[
list removeIndex:1.
up := list isEmpty.
]
].
[exEnd]
"
! !
!ListModelView class methodsFor:'initialization'!
initialize
"setup the signals
"
super initialize.
StopRedrawSignal := Notification newSignalMayProceed:true.
StopRedrawSignal nameClass:self message:#stopRedrawSignal.
! !
!ListModelView class methodsFor:'Signal constants'!
stopRedrawSignal
^ StopRedrawSignal
! !
!ListModelView class methodsFor:'defaults'!
defaultRenderer
^ Renderer
!
updateStyleCache
"extract values from the styleSheet and cache them in class variables"
<resource: #style (
#'text.backgroundColor' #'text.foregroundColor'
#'selection.shadowColor' #'selection.lightColor'
#'text.font'
)>
DefaultForegroundColor := StyleSheet colorAt:'text.foregroundColor' default:Black.
DefaultBackgroundColor := StyleSheet colorAt:'text.backgroundColor'.
DefaultShadowColor := StyleSheet colorAt:'selection.shadowColor'.
DefaultLightColor := StyleSheet colorAt:'selection.lightColor'.
DefaultFont := StyleSheet fontAt:'text.font'.
"
self updateStyleCache
"
! !
!ListModelView methodsFor:'accessing'!
list
"get the list of items
"
^ list
!
list:aList
"set the list of items
"
|negatedOrg|
list ~~ aList ifTrue:[
list removeDependent:self.
].
(list := aList) notNil ifTrue:[
list addDependent:self
].
preferredExtent := nil.
widthOfContents := nil.
self realized ifFalse:[^ self].
self recomputeHeightOfContents.
scrollWhenUpdating == #beginOfText ifTrue:[
viewOrigin = (0@0) ifFalse:[
self originWillChange.
negatedOrg := viewOrigin negated.
viewOrigin := (0@0).
self originChanged:negatedOrg.
].
] ifFalse:[
scrollWhenUpdating == #endOfText ifTrue:[
self scrollTo:(0 @ self heightOfContents - self innerHeight) redraw:false
]
].
self invalidate.
self contentsChanged
! !
!ListModelView methodsFor:'accessing-behavior'!
autoScroll
"returns true if auto scrolling is enabled
"
^ autoScroll
!
autoScroll:aBool
"returns true if auto scrolling is enabled
"
autoScroll := aBool ? true.
!
enabled
"returns the enabled state
"
^ enabled
!
enabled:aBoolean
"set the enabled state
"
enabled := aBoolean
!
hasConstantHeight
"user configured; true if each line has the same lineHeight
optimize for scroller update
"
^ hasConstantHeight
!
hasConstantHeight:aBool
"user configured; true if each line has the same lineHeight
optimize for scroller update
"
aBool == hasConstantHeight ifTrue:[
^ self
].
constantHeight := nil.
hasConstantHeight := aBool.
self lostSynchronisation.
!
scrollWhenUpdating:aSymbolOrNil
"define how to scroll, when I get a new text
(via the model or the #contents/#list)
Allowed arguments are:
#keep / nil -> no change
#endOfText -> scroll to the end
#beginOfText -> scroll to the top
The default is #beginOfText.
This may be useful for fields which get new values assigned from
the program (i.e. not from the user)
"
scrollWhenUpdating := aSymbolOrNil
! !
!ListModelView methodsFor:'accessing-items'!
at:anIndex
"return the list element at an index
"
^ list at:anIndex
!
at:anIndex ifAbsent:exceptionBlock
"return the list element at an index if valid.
If the index is invalid, return the result of evaluating
the exceptionblock.
"
list notNil ifTrue:[
^ list at:anIndex ifAbsent:exceptionBlock
].
^ exceptionBlock value
!
findLast:aOneArgBlock
"find the last list entry, for which evaluation of the argument, aOneArgBlock
returns true; return its index or 0 if none detected.
"
list notNil ifTrue:[
^ list findLast:aOneArgBlock
].
^ 0
!
identityIndexOf:anElement
"returns the index of an element or nil
"
list notNil ifTrue:[
^ list identityIndexOf:anElement
].
^ 0
!
last
"returns the last list entry
"
^ list last
! !
!ListModelView methodsFor:'accessing-look'!
backgroundColor
"get the background color
"
^ bgColor
!
backgroundColor:aColor
"set the background color
"
(aColor notNil and:[bgColor ~~ aColor]) ifTrue:[
super viewBackground:bgColor.
self realized ifTrue:[
bgColor := aColor onDevice:device.
self invalidate
] ifFalse:[
bgColor := aColor
]
]
!
font:aFont
"set a new font
"
|oldWidth oldHeight|
(aFont isNil or:[aFont = font]) ifFalse:[
oldWidth := font width.
oldHeight := font height.
super font:aFont.
(font widthOn:device) ~~ oldWidth ifTrue:[ "/ force a recomputation
preferredExtent := nil.
widthOfContents := nil.
].
oldHeight ~~ (font heightOn:device) ifTrue:[
self recomputeHeightOfContents.
].
shown ifTrue:[ self invalidate ]
].
!
foregroundColor
"get the foreground color
"
^ fgColor
!
foregroundColor:aColor
"set the foreground color
"
(aColor notNil and:[fgColor ~~ aColor]) ifTrue:[
self realized ifTrue:[
fgColor := aColor onDevice:device.
self invalidate
] ifFalse:[
fgColor := aColor
]
]
!
lineSpacing
"get the lineSpacing - thats an additional number of pixels,
by which lines are vertically separated.
"
^ lineSpacing
!
lineSpacing:aNumber
"set the lineSpacing - thats an additional number of pixels,
by which lines are vertically separated.
"
lineSpacing ~= aNumber ifTrue:[
lineSpacing := aNumber.
self recomputeHeightOfContents.
shown ifTrue:[
self invalidate
]
]
! !
!ListModelView methodsFor:'accessing-mvc'!
listHolder
"returns the listHolder or nil
"
^ listHolder
!
listHolder:aListHolder
"set a new listHolder
"
listHolder removeDependent:self.
(listHolder := aListHolder) notNil ifTrue:[
listHolder addDependent:self.
].
self list:(listHolder value).
! !
!ListModelView methodsFor:'change & update'!
lineChangedAt:aLnNr with:arg
"line changed at position; check whether line height changed"
|cache
oldHeight "{ Class:SmallInteger }"
dltHeight "{ Class:SmallInteger }" |
(arg == #icon or:[arg == #hierarchy]) ifTrue:[
^ self
].
hasConstantHeight ifTrue:[
self invalidateLineAt:aLnNr.
^ self
].
oldHeight := (self yVisibleOfLine:(aLnNr + 1)) - (self yVisibleOfLine:aLnNr).
dltHeight := (self heightOfLineAt:aLnNr) - oldHeight.
dltHeight == 0 ifTrue:[
self invalidateLineAt:aLnNr.
^ self
].
cache := startOfLinesY.
aLnNr + 1 to:cache size do:[:i|
cache at:i put:((cache at:i) + dltHeight)
].
self invalidate.
!
listChangedInsert:start nItems:nLines
"list changed; items are added
"
|newLines
run "{ Class: SmallInteger }"
newSz "{ Class: SmallInteger }"
cpyHg "{ Class: SmallInteger }"
absY0 "{ Class: SmallInteger }"
absY1 "{ Class: SmallInteger }"
visY0 "{ Class: SmallInteger }"
visY1 "{ Class: SmallInteger }"
orgY "{ Class: SmallInteger }"
dltY "{ Class: SmallInteger }"
maxHg "{ Class: SmallInteger }"
|
nLines == 0 ifTrue:[^ self ].
self listSizeChanged:start nLines:nLines.
shown not ifTrue:[^ self].
newSz := startOfLinesY size + nLines.
(newSz - 1) ~~ self size ifTrue:[
"/
"/ no longer synchrounous
"/
^ self lostSynchronisation
].
newLines := startOfLinesY copy.
newLines addAll:(Array new:nLines) beforeIndex:start + 1.
absY0 := newLines at:start.
absY1 := absY0.
run := start.
nLines timesRepeat:[
absY1 := absY1 + (self heightOfLineAt:run).
run := run + 1.
newLines at:run put:absY1.
].
dltY := absY1 - absY0.
run + 1 to:newSz do:[:i||v|
newLines at:i put:((newLines at:i) + dltY)
].
startOfLinesY := newLines.
orgY := viewOrigin y.
absY1 := absY0 + dltY.
visY0 := absY0 - orgY.
visY1 := absY1 - orgY.
maxHg := height - margin.
absY0 < orgY ifTrue:[
self originWillChange.
viewOrigin y:(dltY + orgY).
self originChanged:(0 @ dltY).
].
(visY0 >= maxHg or:[visY1 <= margin]) ifTrue:[
^ self contentsChanged
].
visY0 := visY0 max:margin.
visY1 := visY1 min:maxHg.
self hasDamage ifTrue:[
self invalidate:(Rectangle left:0
top:visY0
width:width
height:height - visY0).
^ self contentsChanged.
].
(start == self size or:[(cpyHg := maxHg - visY1) < 20]) ifTrue:[
visY1 := maxHg
] ifFalse:[
self catchExpose.
self copyFrom:self x:0 y:visY0
toX:0 y:visY1
width:width height:cpyHg async:true.
self waitForExpose
].
self invalidateX:margin
y:visY0
width:width - margin - margin
height:(visY1 - visY0).
self contentsChanged.
!
listChangedRemove:aStart toIndex:aStop
"list changed; items are removed
"
|noRedraw newLines
size "{ Class: SmallInteger }"
absY0 "{ Class: SmallInteger }"
absY1 "{ Class: SmallInteger }"
visY0 "{ Class: SmallInteger }"
visY1 "{ Class: SmallInteger }"
orgY "{ Class: SmallInteger }"
orgX "{ Class: SmallInteger }"
dltY "{ Class: SmallInteger }"
cpyHg "{ Class: SmallInteger }"
maxHg "{ Class: SmallInteger }"
stop "{ Class: SmallInteger }"
start "{ Class: SmallInteger }"
newSz "{ Class: SmallInteger }"
|
stop := aStop.
start := aStart.
(size := stop - start + 1) == 0 ifTrue:[
^ self
].
self listSizeChanged:start nLines:(size negated).
shown not ifTrue:[^ self].
newSz := startOfLinesY size - size.
(newSz - 1) ~~ self size ifTrue:[
"/
"/ no longer synchrounous
"/
^ self lostSynchronisation
].
absY0 := self yAbsoluteOfLine:start.
absY1 := self yAbsoluteOfLine:stop + 1.
dltY := absY1 - absY0.
newLines := startOfLinesY copy.
newLines removeFromIndex:(start + 1) toIndex:(stop + 1).
(start + 1) to:newSz do:[:i|
absY0 := newLines at:i.
newLines at:i put:(absY0 - dltY).
].
startOfLinesY := newLines.
orgY := viewOrigin y.
orgX := viewOrigin x.
absY0 := self yAbsoluteOfLine:start.
absY1 := absY0 + dltY.
visY0 := absY0 - orgY.
visY1 := absY1 - orgY.
maxHg := height - margin.
(self size == 0 or:[(orgY ~~ 0 and:[self maxViewOriginY == 0])]) ifTrue:[
(orgX ~~ 0 or:[orgY ~~ 0]) ifTrue:[
self originWillChange.
viewOrigin := 0@0.
self originChanged:((orgX @ orgY) negated).
].
self invalidate.
^ self contentsChanged
].
visY0 < margin ifTrue:[
noRedraw := visY1 <= margin.
noRedraw ifTrue:[dltY := dltY negated] ifFalse:[dltY := visY0].
self originWillChange.
viewOrigin y:(dltY + orgY).
self originChanged:(0 @ dltY).
] ifFalse:[
noRedraw := visY0 >= maxHg
].
visY0 := visY0 max:margin.
self hasDamage ifTrue:[
self invalidate:(Rectangle left:0
top:visY0
width:width
height:height - visY0).
noRedraw := true
].
noRedraw ifFalse:[
cpyHg := maxHg - visY1.
cpyHg > 20 ifTrue:[
self catchExpose.
self copyFrom:self x:0 y:visY1 toX:0 y:visY0
width:width height:cpyHg async:true.
self waitForExpose.
visY0 := visY0 + cpyHg.
].
self invalidateX:margin
y:visY0
width:width - margin - margin
height:(maxHg - visY0).
].
self contentsChanged.
!
update:what with:aPara from:chgObj
"catch and handle any notification raised from the list model
or list holder
"
|a1 a2|
chgObj ~~ list ifTrue:[
chgObj == listHolder ifTrue:[
self list:(listHolder value).
] ifFalse:[
super update:what with:aPara from:chgObj
].
^ self
].
aPara isCollection ifFalse:[
what == #at: ifTrue:[self lineChangedAt:aPara with:nil. ^ self].
what == #insert: ifTrue:[self listChangedInsert:aPara nItems:1. ^ self].
what == #remove: ifTrue:[self listChangedRemove:aPara toIndex:aPara. ^ self].
^ self.
].
a1 := aPara at:1.
a2 := aPara at:2.
(a1 == 1 and:[a2 == list size]) ifTrue:[
self list:list. "/ reload full list
^ self
].
what == #at: ifTrue:[self lineChangedAt:a1 with:a2. ^ self].
what == #insertCollection: ifTrue:[self listChangedInsert:a1 nItems:a2. ^ self].
what == #removeFrom: ifTrue:[self listChangedRemove:a1 toIndex:a2. ^ self].
what == #replace: ifTrue:[
a1 to:a2 do:[:i|self lineChangedAt:i with:nil].
^ self
].
! !
!ListModelView methodsFor:'drawing'!
drawFrom:start to:stop x:x y:y w:w
"draw lines from start to stop.
clipping and clearing the background is already done
"
|item
y0 "{ Class:SmallInteger }"
y1 "{ Class:SmallInteger }"
x0 "{ Class:SmallInteger }"
|
self paint:fgColor on:bgColor.
x0 := textStartLeft - viewOrigin x.
y1 := y.
start to:stop do:[:i|
item := self at:i ifAbsent:self. "/ list changed during draw
item == self ifTrue:[^ self].
y0 := y1.
y1 := self yVisibleOfLine:(i + 1).
item notNil ifTrue:[
renderer display:item atX:x0 y:y0 lineHeight:(y1 - y0).
]
]
!
invalidateLineAt:aLineNr
"add a damage to redraw a line specified by its line number to the
input event queue.
"
^ self invalidateLineAt:aLineNr fromX:0.
!
invalidateLineAt:aLineNr fromX:x
"add a damage to redraw a line specified by its line number to the
input event queue.
"
|y0 "{ Class:SmallInteger }"
y1 "{ Class:SmallInteger }"
yB "{ Class:SmallInteger }"
x0 "{ Class:SmallInteger }"
xR "{ Class:SmallInteger }"
|
(shown and:[aLineNr notNil and:[aLineNr > 0]]) ifFalse:[
^ self
].
xR := width - margin.
x0 := x max:margin.
x0 < xR ifFalse:[ ^ self].
yB := height - margin.
y0 := (self yVisibleOfLine:aLineNr) max:margin.
y0 < yB ifTrue:[
y1 := (self yVisibleOfLine:(aLineNr + 1)) min:yB.
y1 > y0 ifTrue:[
self invalidateX:x0 y:y0 width:(xR - x0) height:(y1 - y0) repairNow:false.
]
].
!
redraw
"redraw complete view
"
self redrawX:0 y:0 width:width height:height.
!
redrawX:x y:y width:w height:h
"redraw part of myself immediately, given logical coordinates
"
|start stop yAbs drawFailed|
shown ifFalse:[^ self].
self paint:bgColor.
self fillRectangleX:x y:y width:w height:h.
widthOfContents isNil ifTrue:[
self preferredExtent
].
start := self yVisibleToLineNr:y.
start isNil ifTrue:[ ^ self ].
yAbs := y + h.
stop := self yVisibleToLineNr:yAbs.
stop isNil ifTrue:[
stop := self size.
] ifFalse:[
yAbs == (startOfLinesY at:stop) ifTrue:[
stop := (stop - 1) max:start
].
].
drawFailed := true.
"/ test whether list changed during redraw
stop >= start ifTrue:[
StopRedrawSignal handle:[:ex| ]
do:[ self drawFrom:start to:stop x:x
y:(self yVisibleOfLine:start) w:w.
drawFailed := false. "/ success drawn
]
].
drawFailed ifTrue:[ self invalidate ].
! !
!ListModelView methodsFor:'event handling'!
keyPress:aKey x:x y:y
"a key was pressed - handle page-keys here"
<resource: #keyboard( #PreviousPage #NextPage #HalfPageUp #HalfPageDown
#BeginOfText #EndOfText #ScrollUp #ScrollDown
)>
|n|
self size ~~ 0 ifTrue:[
(aKey == #PreviousPage) ifTrue:[^ self pageUp].
(aKey == #NextPage) ifTrue:[^ self pageDown].
(aKey == #HalfPageUp) ifTrue:[^ self halfPageUp].
(aKey == #HalfPageDown) ifTrue:[^ self halfPageDown].
(aKey == #BeginOfText) ifTrue:[^ self scrollToTop].
(aKey == #EndOfText) ifTrue:[^ self scrollToBottom].
(aKey == #ScrollUp or:[aKey == #ScrollDown]) ifTrue:[
n := 1 + (self sensor compressKeyPressEventsWithKey:aKey).
n := n * self verticalScrollStep.
aKey == #ScrollUp ifTrue:[self scrollUp:n]
ifFalse:[self scrollDown:n].
^ self
].
].
super keyPress:aKey x:x y:y
!
sizeChanged:how
previousExtent := self extent.
super sizeChanged:how.
! !
!ListModelView methodsFor:'event simulation'!
syncronizeEvents
self obsoleteMethodWarning:'no longer supported'.
^ false
!
syncronizeEvents:aBoolean
self obsoleteMethodWarning:'no longer supported'.
! !
!ListModelView methodsFor:'fetch resources'!
colorOnDevice:aColor
"fetch a device colors
"
^ aColor notNil ifTrue:[aColor onDevice:device] ifFalse:[nil]
!
imageOnMyDevice:anImage
"associate image to device and clear pixel mask
returns the new image.
"
|deviceImage|
anImage isNil ifTrue:[^ anImage].
deviceImage := anImage onDevice:device.
deviceImage isImage ifTrue:[
deviceImage clearMaskedPixels.
].
^ deviceImage
"/ |image|
"/
"/ (image := anImage) notNil ifTrue:[
"/ image device ~~ device ifTrue:[
"/ image := image copy.
"/ ].
"/ image := image onDevice:device.
"/ image := image clearMaskedPixels.
"/ ].
"/ ^ image
! !
!ListModelView methodsFor:'focus handling'!
wantsFocusWithButtonPress
"catch the keyboard focus on button click
"
^ true
!
wantsFocusWithPointerEnter
"views which like to take the keyboard focus
when the pointer enters can do so by redefining this
to return true"
^ true
! !
!ListModelView methodsFor:'initialization & release'!
create
"fetch device dependent resources
"
super create.
self fetchResources.
!
initStyle
"setup viewStyle specifics
"
super initStyle.
DefaultForegroundColor isNil ifTrue:[
self updateStyleCache
].
DefaultBackgroundColor notNil ifTrue:[
viewBackground := DefaultBackgroundColor
].
lineSpacing := 0.
textStartLeft := 2.
fgColor := DefaultForegroundColor.
bgColor := viewBackground.
startOfLinesY := OrderedCollection new.
startOfLinesY add:(2 + margin). "/ top inset of first line
DefaultShadowColor notNil ifTrue:[
shadowColor := DefaultShadowColor
].
DefaultLightColor notNil ifTrue:[
lightColor := DefaultLightColor
].
!
initialize
"setup default attributes
"
super initialize.
viewOrigin := 0@0.
bitGravity := #NorthWest.
enabled := true.
autoScroll := true.
scrollWhenUpdating := #beginOfText.
hasConstantHeight := false.
renderer isNil ifTrue:[
renderer := self class defaultRenderer forView:self.
].
!
mapped
"recompute list
"
shown ifFalse:[
self recomputeHeightOfContents.
self contentsChanged.
].
super mapped
!
recreate
"sent after a snapin or a migration, reinit for new device"
super recreate.
self fetchResources.
!
reinitialize
"reinit after snapIn (font geometry might be different)
"
super reinitialize.
self recomputeHeightOfContents.
self contentsChanged.
!
release
"remove dependencies
"
listHolder removeDependent:self.
list removeDependent:self.
super release
! !
!ListModelView methodsFor:'private'!
hasDamage
"return true, if any damage events (i.e. expose or resize) are pending"
^ self sensor hasDamageFor:self
!
yAbsoluteOfLine:aLineNr
"given a lineNr, return y-coordinate absolute
"
|y y2 y1 cash|
cash := startOfLinesY.
(y := cash at:aLineNr ifAbsent:nil) notNil ifTrue:[
^ y
].
"/ recompute a y position
y1 := startOfLinesY at:1 ifAbsent:2.
y2 := startOfLinesY at:2 ifAbsent:10.
^ aLineNr * (y2 - y1) + y1
!
yVisibleOfLine:aLineNr
"given a lineNr, return y-coordinate in view
"
^ (self yAbsoluteOfLine:aLineNr) - viewOrigin y
!
yVisibleToLineNr:yVisible
"returns the line number assigned to a physical y or nil if out of list
"
|cash
yAbs "{ Class: SmallInteger}"
size "{ Class: SmallInteger}"
ictr "{ Class: SmallInteger}"
yRun "{ Class: SmallInteger}"
|
cash := startOfLinesY.
(size := cash size) < 2 ifTrue:[^ nil]. "/ empty list
yAbs := yVisible + viewOrigin y.
yRun := cash at:size.
yAbs >= yRun ifTrue:[
yAbs == yRun ifTrue:[ ^ size - 1].
^ nil "/ out of list
].
constantHeight notNil ifTrue:[
yAbs := yAbs - (cash at:1).
yAbs < constantHeight ifTrue:[ ^ 1 ].
^ yAbs // constantHeight + 1
].
ictr := yAbs // (cash at:2).
ictr < 1 ifTrue:[ ictr := 1 ]
ifFalse:[ ictr := ictr min:size ].
yRun := cash at:ictr.
yRun > yAbs ifTrue:[
[(ictr := ictr - 1) > 0 ] whileTrue:[
yRun := cash at:ictr.
yRun <= yAbs ifTrue:[ ^ ictr ].
].
^ 1
].
[ yRun ~~ yAbs ] whileTrue:[
ictr := ictr + 1.
yRun := cash at:ictr.
yRun > yAbs ifTrue:[ ^ ictr - 1 ].
].
^ ictr
!
yVisibleToRowNr:yVisible
"for protocol compatibility with DSVColumnView"
^ self yVisibleToLineNr:yVisible
! !
!ListModelView methodsFor:'protocol'!
fetchResources
"fetch device colors and ..., to avoid reallocation at redraw time;
*** called after a create or snapin to fetch all device resources
"
fgColor := self colorOnDevice:fgColor.
bgColor := self colorOnDevice:bgColor.
font := font onDevice:device.
!
lineHeightFor:anItem
"returns the computed line height for an item
"
^ lineSpacing + (renderer heightFor:anItem)
!
listSizeChanged:anIndex nLines:noLines
"list size changed; information is stored to recompute the
width if required( preferredExtent, horizontal scroller ... ).
see: widthOfContents
*** if nLines is negative, lines are removed otherwise added.
"
|start "{ Class:SmallInteger }"
stop "{ Class:SmallInteger }"
size "{ Class:SmallInteger }"
|
preferredExtent := nil.
widthOfContents isNil ifTrue:[ "/ recompute whole list
^ self
].
(noLines < 0 or:[(size := self size) <= noLines]) ifTrue:[
widthOfContents := nil. "/ force recompute whole list
^ self
].
stop := anIndex + noLines - 1. "/ recompute a range
start := anIndex.
computeWidthInRange notNil ifTrue:[
start := computeWidthInRange y.
stop < start ifTrue:[stop := start min:size].
start := (computeWidthInRange x) min:anIndex.
].
computeWidthInRange := start@stop
!
lostSynchronisation
"called when the changes derived from the model are faster than the handling
"
shown ifTrue:[
self recomputeHeightOfContents.
self invalidate.
self contentsChanged
].
!
widthOfWidestLineBetween:firstLine and:lastLine
"return the width in pixels of the widest line in a range
"
|item
width "{ Class: SmallInteger }"
|
width := textStartLeft.
firstLine to:lastLine do:[:anIndex|
item := self at:anIndex ifAbsent:nil.
item isNil ifTrue:[^ width + textStartLeft].
width := (renderer widthFor:item) max:width
].
^ width + textStartLeft
! !
!ListModelView methodsFor:'queries'!
isLineVisible:aLineNr
"returns true if the line is visible"
^ self isLineVisible:aLineNr in:self extent
!
isLineVisible:aLineNr in:anExtentPoint
"returns true if the line is visible"
|y|
y := self yVisibleOfLine:aLineNr.
^ (y between:margin and:(anExtentPoint y - margin))
!
size
"returns number of raws
"
^ list size
! !
!ListModelView methodsFor:'recomputation'!
preferredExtent
"returns the preferred extent
"
|x y|
preferredExtent isNil ifTrue:[
y := self heightOfContents.
x := self widthOfContents.
preferredExtent := x@y
].
^ preferredExtent
!
recomputeHeightOfContents
"recompute all the y positions
"
|newList
yAbs "{ Class: SmallInteger }"
lnHg "{ Class: SmallInteger }"
size "{ Class: SmallInteger }"
|
yAbs := startOfLinesY at:1. "/ top inset of first line
size := self size.
newList := OrderedCollection new:(size + 1).
newList add:yAbs.
size == 0 ifTrue:[
startOfLinesY := newList.
^ self
].
hasConstantHeight ifTrue:[
constantHeight notNil ifTrue:[ lnHg := constantHeight ]
ifFalse:[ lnHg := self heightOfLineAt:1 ].
1 to:size do:[:anIndex|
newList add:(yAbs := yAbs + lnHg)
].
startOfLinesY := newList.
^ self
].
1 to:size do:[:anIndex|
lnHg := self heightOfLineAt:anIndex.
newList add:(yAbs := yAbs + lnHg)
].
startOfLinesY := newList.
! !
!ListModelView methodsFor:'scroller interface'!
heightOfContents
"return the height of the contents in pixels
"
^ startOfLinesY last ? 0
!
heightOfLineAt:aLineNr
"returns the total height for a line at an index( including lineSpacing ... )
"
|item|
hasConstantHeight ifTrue:[
constantHeight notNil ifTrue:[ ^ constantHeight ].
item := self at:1 ifAbsent:nil.
item notNil ifTrue:[
constantHeight := self lineHeightFor:item.
^ constantHeight
]
] ifFalse:[
item := self at:aLineNr ifAbsent:nil.
item notNil ifTrue:[
^ self lineHeightFor:item
]
].
^ 4
!
innerHeight
"returns the inner height of the contents shown
"
^ height - margin - margin
!
innerWidth
"returns the inner width of the contents shown
"
^ width - margin - margin
!
maxViewOriginY
"returns the maximum possible y of the view origin
"
^ (self heightOfContents - self innerHeight) max:0
!
verticalScrollStep
"return the amount to scroll when stepping up/down.
"
^ 10
!
viewOrigin
"return the viewOrigin; thats the coordinate of the contents
which is shown topLeft in the view.
"
^ viewOrigin
!
widthOfContents
"return the width of the contents in pixels
"
|range
size "{ Class:SmallInteger }"
start "{ Class:SmallInteger }"
stop "{ Class:SmallInteger }"
|
(widthOfContents notNil and:[computeWidthInRange isNil]) ifTrue:[
^ widthOfContents + textStartLeft
].
range := computeWidthInRange.
computeWidthInRange := nil.
preferredExtent := nil.
shown ifFalse:[ ^ 60 ].
size := self size.
size == 0 ifTrue:[
widthOfContents := 20.
] ifFalse:[
widthOfContents isNil ifTrue:[
widthOfContents := self widthOfWidestLineBetween:1 and:size
] ifFalse:[
start := range x.
stop := range y min:size.
start > stop ifFalse:[
size := self widthOfWidestLineBetween:start and:stop.
widthOfContents < size ifTrue:[
widthOfContents := size
]
]
]
].
^ widthOfContents + textStartLeft
!
xOriginOfContents
"return the horizontal origin of the contents in pixels
"
^ viewOrigin x
!
yOriginOfContents
"return the vertical origin of the contents in pixels
"
^ viewOrigin y
! !
!ListModelView methodsFor:'scrolling'!
halfPageDown
"scroll down half a page
"
self scrollDown:(height // 2).
!
halfPageUp
"scroll up half a page
"
self scrollUp:(height // 2).
!
makeLineVisible:aLnNr
"make the line visible
"
aLnNr notNil ifTrue:[
self scrollToLine:aLnNr
].
!
scrollTo:anOrigin redraw:doRedraw
"change origin to have newOrigin be visible at the top-left.
"
|newOrg dltOrg winGrp
innerWT "{ Class:SmallInteger }"
innerHG "{ Class:SmallInteger }"
h "{ Class:SmallInteger }"
x "{ Class:SmallInteger }"
x0 "{ Class:SmallInteger }"
x1 "{ Class:SmallInteger }"
y "{ Class:SmallInteger }"
w "{ Class:SmallInteger }"
y0 "{ Class:SmallInteger }"
y1 "{ Class:SmallInteger }"
dX "{ Class:SmallInteger }"
dY "{ Class:SmallInteger }"
|
realized ifFalse:[
^ self
].
innerWT := self innerWidth.
innerHG := self innerHeight.
h := viewOrigin y.
(y := anOrigin y) > h ifTrue:[ "/ end of contents
y > (dY := self maxViewOriginY) ifTrue:[
y := dY max:h
]
] ifFalse:[
y := y max:0.
].
(x := anOrigin x) > 0 ifTrue:[
x := x min:(self widthOfContents - innerWT).
].
x := x max:0.
newOrg := (x @ y).
dltOrg := newOrg - viewOrigin.
dX := dltOrg x.
dY := dltOrg y.
(dX == 0 and:[dY == 0]) ifTrue:[
^ self
].
dY := dY abs.
dX := dX abs.
( (dX ~~ 0 and:[dY ~~ 0]) "/ scroll vertical & horizontal
or:[(innerHG - dY < 20 or:[innerWT - dX < 20])] "/ faster to invalidate screen
) ifTrue:[
viewOrigin := newOrg.
self originChanged:dltOrg.
^ self invalidate
].
(winGrp := self windowGroup) notNil ifTrue:[
winGrp processRealExposeEventsFor:self.
].
self originWillChange.
doRedraw ifFalse:[
viewOrigin := newOrg.
^ self originChanged:dltOrg
].
self catchExpose.
viewOrigin := newOrg.
dY ~~ 0 ifTrue:[ "/ SCROLL VERTICAL
y0 := y1 := margin + dY.
h := innerHG - dY.
dltOrg y < 0 ifTrue:[y0 := margin. y := y0]
ifFalse:[y1 := margin. y := y1 + h].
self copyFrom:self x:margin y:y0 toX:margin y:y1 width:innerWT height:h async:true.
self invalidateX:margin y:y width:innerWT height:(innerHG - h).
] ifFalse:[ "/ SCROLL HORIZONTAL
x0 := x1 := dX + margin.
w := innerWT - dX.
dltOrg x < 0 ifTrue:[x0 := x := margin ]
ifFalse:[x1 := margin. x := w].
self copyFrom:self x:x0 y:margin toX:x1 y:margin width:w height:innerHG async:true.
self invalidateX:x y:margin width:(width - w) height:innerHG.
].
self originChanged:dltOrg.
self waitForExpose.
winGrp notNil ifTrue:[
winGrp processRealExposeEventsFor:self.
].
!
scrollToLine:aLineNumber
"make line visible
"
|inHg "{ Class:SmallInteger }"
yTop "{ Class:SmallInteger }"
orgY "{ Class:SmallInteger }"
yBot "{ Class:SmallInteger }"
|
(shown and:[aLineNumber notNil and:[aLineNumber between:1 and:(self size)]]) ifFalse:[
^ self
].
yTop := self yAbsoluteOfLine:aLineNumber.
inHg := self innerHeight.
orgY := viewOrigin y.
yTop > orgY ifTrue:[
yBot := self yAbsoluteOfLine:(aLineNumber + 1).
yBot <= (orgY + inHg) ifTrue:[
^ self
].
].
yTop := (yTop - (inHg // 2)) max:0.
self scrollTo:(viewOrigin x @ yTop).
! !
!ListModelView methodsFor:'scrolling auto'!
startAutoScroll:aBlock distance:aDistance
"setup for auto-scroll (when button-press-moving below view);
- timeDelta for scroll is computed from distance
"
|timeDelta|
(autoScroll and:[aBlock notNil]) ifFalse:[
^ self stopAutoScroll
].
autoScrollBlock notNil ifTrue:[
Processor removeTimedBlock:autoScrollBlock.
] ifFalse:[
self compressMotionEvents:false.
].
timeDelta := 0.5 / (aDistance abs).
autoScrollBlock := [
aBlock value.
Processor addTimedBlock:autoScrollBlock afterSeconds:timeDelta.
].
Processor addTimedBlock:autoScrollBlock afterSeconds:timeDelta.
!
stopAutoScroll
"stop any autoScroll
"
autoScrollBlock notNil ifTrue:[
Processor removeTimedBlock:autoScrollBlock.
autoScrollBlock := nil.
self compressMotionEvents:true.
].
! !
!ListModelView::Renderer class methodsFor:'documentation'!
documentation
"
prepared for ListItemRenderer
.... SelectionItemRenderer ...
goal:
allow the user to redefine the display operation and the dimesion queries
"
! !
!ListModelView::Renderer class methodsFor:'instance creation'!
forView:aView
|renderer|
renderer := self basicNew initialize.
renderer forView:aView.
^ renderer
! !
!ListModelView::Renderer methodsFor:'displaying'!
display:anItem atX:xLeft y:yTop lineHeight:h
"display the item on the view
"
|x0 y0 label|
x0 := xLeft.
y0 := yTop.
anItem isHierarchicalItem ifTrue:[
anItem displayOn:view x:x0 y:y0 h:h
] ifFalse:[
anItem isNil ifTrue:[^ self].
y0 := y0 - ((self heightFor:anItem) + 1 - h // 2).
label := anItem.
label isImageOrForm ifFalse:[
label isNumber ifTrue:[
label := label printString
].
y0 := y0 + view font ascent
].
label displayOn:view x:x0 y:y0
].
! !
!ListModelView::Renderer methodsFor:'instance creation'!
forView:aView
view := aView.
! !
!ListModelView::Renderer methodsFor:'queries-dimensions'!
heightFor:anItem
"returns the height of an item on the view
"
^ anItem heightOn:view
!
widthFor:anItem
"returns the width of an item on the view
"
^ anItem widthOn:view
! !
!ListModelView class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libwidg2/ListModelView.st,v 1.81 2003-08-18 16:49:36 cg Exp $'
! !
ListModelView initialize!