"
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
displayedFrames syncronizeEvents autoScroll autoScrollBlock
scrollWhenUpdating'
classVariableNames:'DefaultForegroundColor DefaultBackgroundColor DefaultShadowColor
DefaultLightColor StopRedrawSignal'
poolDictionaries:''
category:'Views-Lists'
!
!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:
displayedFrames <WeakIdentityDictionary>
keep the frames within the widget
syncronizeEvents <Boolean> set to true if list and model changes
should be handled synchronized; an event
will be pushed on the event loop.
on default it is disabled.
[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:false.
! !
!ListModelView class methodsFor:'Signal constants'!
stopRedrawSignal
^ StopRedrawSignal
! !
!ListModelView class methodsFor:'defaults'!
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
"
|size negatedOrg|
self syncFlushEvent:#syncUpdate:with:.
displayedFrames keys do:[:aView| aView destroy].
displayedFrames := WeakIdentityDictionary new.
list ~~ aList ifTrue:[
list removeDependent:self.
].
(list := aList) notNil ifTrue:[
list addDependent:self
].
self recomputeHeightOfContents.
preferredExtent := nil.
widthOfContents := nil.
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
!
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
].
^ nil.
!
identityIndexOf:anElement
"returns the index of an element or nil
"
^ list notNil ifTrue:[list identityIndexOf:anElement]
ifFalse:[0]
! !
!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 on: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 on:device.
self invalidate
] ifFalse:[
fgColor := aColor
]
]
! !
!ListModelView methodsFor:'accessing-mvc'!
listHolder
"returns the listHolder or nil
"
^ listHolder
!
listHolder:aListHolder
"set a new listHolder
"
|newList|
listHolder removeDependent:self.
(listHolder := aListHolder) notNil ifTrue:[
listHolder addDependent:self.
].
self list:(listHolder value).
! !
!ListModelView methodsFor:'accessing-views'!
destroyFrame:aFrame
"destroy a frame
"
aFrame notNil ifTrue:[
displayedFrames removeKey:aFrame ifAbsent:nil.
aFrame destroy.
].
!
registerFrame:aView atLine:aLineNr x:logX width:w
"register a frame for a line and set the origin@corner of the frame
"
|x y h item index|
(item := list at:aLineNr ifAbsent:nil) isNil ifTrue:[
^ self
].
y := self yVisibleOfLine:aLineNr.
x := logX - viewOrigin x.
h := (startOfLinesY at:(aLineNr + 1)) - (startOfLinesY at:aLineNr).
aView origin:(x@y) extent:(w@h).
self addSubView:aView.
displayedFrames at:aView put:item.
realized ifTrue:[aView realize].
! !
!ListModelView methodsFor:'change & update'!
contentsChanged
"contents changed; recompute origin Y of registered views
"
|idx y x|
displayedFrames keysAndValuesDo:[:aFrame :anItem|
(idx := list identityIndexOf:anItem) == 0 ifTrue:[
aFrame beInvisible.
] ifFalse:[
y := self yVisibleOfLine:idx.
x := aFrame origin x.
aFrame origin:(x @ y).
aFrame beVisible.
]
].
super contentsChanged.
!
lineChangedAt:aLnNr with:arg
"line changed at position; check whether line height changed
"
|
oldHeight "{ Class:SmallInteger }"
dltHeight "{ Class:SmallInteger }"
|
(arg notNil and:[(arg == #icon or:[arg == #hierarchy])]) ifTrue:[
^ self
].
oldHeight := (self yVisibleOfLine:(aLnNr + 1)) - (self yVisibleOfLine:aLnNr).
dltHeight := (self heightOfLineAt:aLnNr) - oldHeight.
dltHeight == 0 ifTrue:[
^ self redrawLineAt:aLnNr
].
aLnNr + 1 to:startOfLinesY size do:[:i|
startOfLinesY at:i put:((startOfLinesY at:i) + dltHeight)
].
self invalidate.
!
listChangedInsert:start nItems:nLines
"list changed; items are added
"
|
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) ~~ list size ifTrue:[
"/
"/ no longer synchrounous
"/
^ self lostSynchronisation
].
startOfLinesY addAll:(Array new:nLines) beforeIndex:start + 1.
absY0 := startOfLinesY at:start.
absY1 := absY0.
run := start.
nLines timesRepeat:[
absY1 := absY1 + (self heightOfLineAt:run).
run := run + 1.
startOfLinesY at:run put:absY1.
].
dltY := absY1 - absY0.
run + 1 to:newSz do:[:i||v|
startOfLinesY at:i put:((startOfLinesY at:i) + dltY)
].
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 == list 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
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) ~~ list size ifTrue:[
"/
"/ no longer synchrounous
"/
^ self lostSynchronisation
].
absY0 := self yAbsoluteOfLine:start.
absY1 := self yAbsoluteOfLine:stop + 1.
dltY := absY1 - absY0.
startOfLinesY removeFromIndex:(start + 1) toIndex:(stop + 1).
(start + 1) to:newSz do:[:i|
absY0 := startOfLinesY at:i.
startOfLinesY at:i put:(absY0 - dltY).
].
orgY := viewOrigin y.
orgX := viewOrigin x.
absY0 := self yAbsoluteOfLine:start.
absY1 := absY0 + dltY.
visY0 := absY0 - orgY.
visY1 := absY1 - orgY.
maxHg := height - margin.
(list 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.
!
originChanged:aDelta
"change origin of registered views
"
displayedFrames keys do:[:aFrame|
aFrame origin:(aFrame origin - aDelta)
].
super originChanged:aDelta.
!
syncUpdate:what with:args
"handle synchronous change
"
|a1 a2|
args isCollection ifFalse:[
what == #at: ifTrue:[self lineChangedAt:args with:nil]
ifFalse:[what == #insert: ifTrue:[self listChangedInsert:args nItems:1]
ifFalse:[what == #remove: ifTrue:[self listChangedRemove:args toIndex:args]]]
] ifTrue:[
a1 := args at:1.
a2 := args at:2.
what == #at: ifTrue:[self lineChangedAt:a1 with:a2]
ifFalse:[what == #insertCollection: ifTrue:[self listChangedInsert:a1 nItems:a2]
ifFalse:[what == #removeFrom: ifTrue:[self listChangedRemove:a1 toIndex:a2]
ifFalse:[what == #replace: ifTrue:[
a1 to:a2 do:[:i|self lineChangedAt:i with:nil]
]]]]
]
!
update:what with:aPara from:chgObj
"catch and handle any notification raised from the list model
or list holder
"
chgObj ~~ list ifTrue:[
chgObj == listHolder ifTrue:[
self syncPushEvent:#list: with:(listHolder value)
] ifFalse:[
super update:what with:aPara from:chgObj
].
^ self
].
( #( insert:
remove:
removeFrom:
insertCollection:
at:
replace:
) includes:what
) ifTrue:[
(aPara isCollection and:[(aPara at:1) == 1 and:[(aPara at:2) == list size]]) ifTrue:[
self list:list
] ifFalse:[
self syncPushEvent:#syncUpdate:with: with:what with:aPara
]
]
! !
!ListModelView methodsFor:'drawing'!
displayElement:anItem x:x y:y h:h
"draw a label at x/y; fg/bg colors are already set
"
|ok label
y0 "{ Class: SmallInteger }"
|
anItem isHierarchicalItem ifTrue:[
anItem displayOn:self x:x y:y h:h
] ifFalse:[
y0 := y - ((anItem heightOn:self) + 1 - h // 2).
label := anItem.
label isImageOrForm ifFalse:[
label isNumber ifTrue:[
label := label printString
].
y0 := y0 + font ascent
].
label displayOn:self x:x y:y0
]
!
invalidateX:x y:y width:w height:h
"add a damage to redraw part of the view
"
shown ifTrue:[
self invalidate:(Rectangle left:x top:y width:w height:h)
repairNow:false
]
!
redraw
"redraw complete view
"
self redrawX:0 y:0 width:width height:height.
!
redrawLineAt:aLineNr
"redraw a specific line
"
|y0 "{ Class:SmallInteger }"
y1 "{ Class:SmallInteger }"
yB "{ Class:SmallInteger }"
|
(shown and:[aLineNr notNil]) ifTrue:[
yB := height - margin.
y0 := (self yVisibleOfLine:aLineNr) max:margin.
y0 < yB ifTrue:[
y1 := (self yVisibleOfLine:(aLineNr + 1)) min:yB.
y1 > margin ifTrue:[
self invalidateX:0 y:y0 width:width height:(y1 - y0)
]
]
]
!
redrawX:x y:y width:w height:h
"redraw part of myself immediately, given logical coordinates
"
|savClip start stop yAbs|
shown ifFalse:[^ self].
self paint:bgColor.
self fillRectangleX:x y:y width:w height:h.
widthOfContents isNil ifTrue:[self preferredExtent].
(start := self yVisibleToLineNr:y) isNil ifTrue:[
^ self
].
yAbs := y + h.
(stop := self yVisibleToLineNr:yAbs) isNil ifTrue:[
stop := list size.
] ifFalse:[
yAbs == (startOfLinesY at:stop) ifTrue:[
stop := (stop - 1) max:start
].
].
savClip := clipRect.
self clippingRectangle:(Rectangle left:x top:y width:w height:h).
StopRedrawSignal handle:[:ex| self invalidate.
ex return
] do:[ self drawFrom:start
to:stop
x:x
y:(self yVisibleOfLine:start)
w:w
].
self clippingRectangle:savClip.
! !
!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 sensor|
list 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:[
sensor := self sensor.
n := sensor notNil ifTrue:[1 + (sensor compressKeyPressEventsWithKey:aKey)]
ifFalse:[1].
n := n * self verticalScrollStep.
aKey == #ScrollUp ifTrue:[self scrollUp:n]
ifFalse:[self scrollDown:n].
^ self
].
].
super keyPress:aKey x:x y:y
! !
!ListModelView methodsFor:'event simulation'!
syncFlushEvent:aSelector
"throw away all pending syncronization events for a specific selector
"
|sensor|
(syncronizeEvents and:[(sensor := self sensor) notNil]) ifTrue:[
sensor flushUserEventsFor:self withType:aSelector
]
!
syncPushEvent:aSelector
"if events are synchronized, the message send is pushed into my
event queue and will be performed when its time to handle events.
Otherwise the event is handled immediately
"
|sensor|
(syncronizeEvents and:[(sensor := self sensor) notNil]) ifTrue:[
sensor pushUserEvent:aSelector for:self withArguments:#()
] ifFalse:[
self perform:aSelector
]
!
syncPushEvent:aSelector with:arg
"if events are synchronized, the message send is pushed into my
event queue and will be performed when its time to handle events.
Otherwise the event is handled immediately
"
|sensor|
(syncronizeEvents and:[(sensor := self sensor) notNil]) ifTrue:[
sensor pushUserEvent:aSelector for:self withArguments:(Array with:arg)
] ifFalse:[
self perform:aSelector with:arg
]
!
syncPushEvent:aSelector with:arg1 with:arg2
"if events are synchronized, the message send is pushed into my
event queue and will be performed when its time to handle events.
Otherwise the event is handled immediately
"
|sensor|
(syncronizeEvents and:[(sensor := self sensor) notNil]) ifTrue:[
sensor pushUserEvent:aSelector for:self withArguments:(Array with:arg1 with:arg2)
] ifFalse:[
self perform:aSelector with:arg1 with:arg2
]
!
syncronizeEvents
"if true, all asynchronous events are pushed into my event queue
and will be performed when its time to handle the events.
Otherwise these events are handled immediately. On default disabled.
"
^ syncronizeEvents
!
syncronizeEvents:aBoolean
"if true, all asynchronous events are pushed into my event queue
and will be performed when its time to handle the events.
Otherwise these events are handled immediately. On default disabled.
"
syncronizeEvents := aBoolean ? false.
! !
!ListModelView methodsFor:'fetch resources'!
colorOnDevice:aColor
"fetch a device colors
"
^ aColor notNil ifTrue:[aColor on:device] ifFalse:[nil]
!
imageOnDevice:anImage
"associate image to device and clear pixel mask
returns the new image.
"
|image|
(image := anImage) notNil ifTrue:[
image device ~~ device ifTrue:[
image := image copy.
].
image := image on: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:'initialize / release'!
create
"fetch device dependent resources
"
super create.
self fetchResources.
self recomputeHeightOfContents.
!
destroy
"remove dependencies
"
listHolder removeDependent:self.
list removeDependent:self.
super destroy
!
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.
displayedFrames := WeakIdentityDictionary new.
syncronizeEvents := false.
autoScroll := true.
scrollWhenUpdating := #beginOfText.
!
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.
! !
!ListModelView methodsFor:'private'!
hasDamage
"return true, if any damage events (i.e. expose or resize) are pending.
"
|sensor|
^ (sensor := self sensor) isNil or:[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
"
|eol cash
yAbs "{ Class: SmallInteger}"
yMid "{ Class: SmallInteger}"
size "{ Class: SmallInteger}"
next "{ Class: SmallInteger}"
low "{ Class: SmallInteger}"
high "{ Class: SmallInteger}"
middle "{ Class: SmallInteger}"
|
cash := startOfLinesY.
(size := cash size) == 1 ifTrue:[^ nil]. "/ EMPTY LIST
yAbs := yVisible + viewOrigin y.
eol := cash at:size ifAbsent:nil.
(eol isNil or:[yAbs > eol]) ifTrue:[^ nil]. "/ END OF LIST
middle := size.
size := size - 1.
high := size.
low := 1.
[(next := low + high // 2) ~~ middle] whileTrue:[
(eol := cash at:next ifAbsent:nil) isNil ifTrue:[
^ nil "/ LIST CHANGED
].
middle := next.
yMid := eol.
yMid < yAbs ifTrue:[low := middle]
ifFalse:[high := middle]
].
yAbs < yMid ifTrue:[
^ (middle - 1) max:1.
].
middle < size ifTrue:[
next := middle + 1.
(eol := cash at:next ifAbsent:nil) isNil ifTrue:[
^ nil "/ LIST CHANGED
].
^ eol > yAbs ifTrue:[middle] ifFalse:[next]
].
^ size
! !
!ListModelView methodsFor:'protocol'!
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|
y0 := y1.
y1 := self yVisibleOfLine:(i + 1).
(item := list at:i ifAbsent:nil) notNil ifTrue:[
self displayElement:item x:x0 y:y0 h:(y1 - y0)
]
]
!
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 on:device.
!
heightOfLineAt:aLineNr
"returns the total height for a line at an index( including lineSpacing ... )
"
|item|
item := list at:aLineNr ifAbsent:nil.
^ item notNil ifTrue:[lineSpacing + (item heightOn:self)]
ifFalse:[4]
!
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 := list 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 syncFlushEvent:#syncUpdate:with:.
self recomputeHeightOfContents.
self invalidate.
self contentsChanged
].
!
widthOfWidestLineBetween:firstLine and:lastLine
"return the width in pixels of the widest line in a range
"
|lbl item
width "{ Class: SmallInteger }"
|
width := textStartLeft.
firstLine to:lastLine do:[:anIndex|
item := list at:anIndex ifAbsent:nil.
item isNil ifTrue:[^ width + textStartLeft].
width := (item widthOn:self) max:width
].
^ width + textStartLeft
! !
!ListModelView methodsFor:'queries'!
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 := list size.
newList := OrderedCollection new:(size + 1).
newList add:yAbs.
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
!
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.
size := list 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).
!
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.
!
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:list 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 class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libwidg2/ListModelView.st,v 1.50 2000-09-19 09:05:17 martin Exp $'
! !
ListModelView initialize!