Commit ac861cb2 authored by John van Groningen's avatar John van Groningen

only draw visible lines during update,

compute line width only for new lines when lines are added
parent 83ed9db0
......@@ -16,6 +16,7 @@ from commondef import strictSeq
, pen :: ![PenAttribute]
, ifilter :: !{#Char} -> Bool // the item filter
, aitems :: ![String] // all items (unfiltered)
, domain :: !Rectangle
}
:: FilteredListBoxId
......@@ -98,6 +99,7 @@ where
, pen = penAtts
, ifilter = const True
, aitems = items
, domain = domain
}
listboxAtts = map toLBCA (filter isListBoxControlAttribute attrs)
......@@ -134,7 +136,7 @@ where
# listboxState = {listboxState & ifilter = filt, items = items}
// refresh...
# (newDomain,ps) = calcControlDomain pen items ps
# (newLook,listboxState)= customlook listboxState
# (newLook,listboxState)= customlook {listboxState & domain=newDomain}
# ps = appPIO (seq
[ setControlViewDomain customId newDomain
, setControlLooks [(customId,True,(True,newLook))]
......@@ -184,42 +186,41 @@ where
= (FOutGetItems items,((listboxState,ls),ps))
// Append elements:
receiver (FInAppendItems newItems) ((listboxState=:{pen,items,aitems,ifilter,lineHeight,initHeight},ls),ps)
# listboxState = {listboxState & items=allItems, aitems = aitems++newItems}
| length newItems`==0
receiver (FInAppendItems newItems) ((listboxState=:{pen,items,aitems,ifilter,lineHeight,initHeight,domain},ls),ps)
# listboxState = {listboxState & items=allFilteredItems, aitems = aitems++newItems}
| isEmpty filteredNewItems
= (FOutAppendItems,((listboxState,ls),ps))
# (newDomain,ps) = calcControlDomain pen allItems ps
# (newLook,listboxState)= customlook listboxState
# (delta,ps) = scrolltoend newDomain ps
# ps = appPIO (seq
# (newDomain,ps) = adjustControlDomain pen filteredNewItems domain ps
# (newLook,listboxState)= customlook {listboxState & domain=newDomain}
# (wdef,ps) = accPIO (getParentWindow customId) ps
# delta = scrolltoend newDomain wdef
# ps = appPIO (seq
[ setControlLooks [(customId,False,(True,newLook))]
, setControlViewDomain customId newDomain
, moveControlViewFrame customId {vx=0, vy=delta}
, if (delta==0) id (moveControlViewFrame customId {vx=0, vy=delta})
]) ps
= (FOutAppendItems,((listboxState,ls),ps))
where
customId = listboxState.listboxId.fcontrolId
newItems` = filter ifilter newItems
allItems = items++newItems`
filteredNewItems = filter ifilter newItems
allFilteredItems = items++filteredNewItems
scrolltoend dom=:{corner2={y=bot}} ps
# (wdef,ps) = accPIO (getParentWindow customId) ps
scrolltoend dom=:{corner2={y=bot}} wdef
| isNothing wdef
= (zero,ps)
= zero
# wdef = fromJust wdef
# (exists,frame) = getControlViewFrame customId wdef
| not exists || isNothing frame
= (zero,ps)
= zero
# frame = fromJust frame
# delta = bot - frame.corner2.y
= (delta,ps)
= bot - frame.corner2.y
// Remove elements:
// Remove all:
receiver (FInCloseAllItems) ((listboxState=:{listboxId,pen,items,selection,lineHeight,initHeight},ls),ps)
# listboxState = {listboxState & items=[], aitems = [], selection=[]}
# (newDomain,ps)= calcControlDomain pen [] ps
# (newLook,listboxState)= customlook listboxState
# (newLook,listboxState)= customlook {listboxState & domain=newDomain}
# ps = appPIO (seq
[ setControlViewDomain listboxId.fcontrolId newDomain
, setControlLooks [(listboxId.fcontrolId,True,(True,newLook))]
......@@ -231,12 +232,8 @@ where
# pen = removeDupAtt (newpen++pen)
# (newDomain,ps) = calcControlDomain pen items ps
# ((lineHeight,initHeight),ps) = accScreenPicture (liheights pen) ps
# listboxState =
{ listboxState
& pen = pen
, lineHeight = lineHeight
, initHeight = initHeight
}
# listboxState
= {listboxState & domain = newDomain, pen = pen, lineHeight = lineHeight, initHeight = initHeight }
# (newLook,listboxState)= customlook listboxState
# ps = appPIO (seq
[ setControlViewDomain listboxId.fcontrolId newDomain
......@@ -251,8 +248,7 @@ where
calcControlDomain :: ![.PenAttribute] ![.{#Char}] !*(PSt .a) -> *(!.Rectangle,!*PSt .a);
calcControlDomain pen items ps
# (newDomain,ps) = accPIO (accScreenPicture calc) ps
= (newDomain,ps)
= accPIO (accScreenPicture calc) ps
where
calc pic
# pic = setPenAttributes pen pic
......@@ -265,6 +261,19 @@ where
# newDomain = {corner1=zero,corner2={x=maxWidth,y=height}} // calculate new domain...
= (newDomain,pic)
adjustControlDomain :: ![.PenAttribute] ![.{#Char}] !.Rectangle !*(PSt .a) -> *(!.Rectangle,!*PSt .a);
adjustControlDomain pen items {corner2={x=oldMaxWidth,y=oldHeight}} ps
= accPIO (accScreenPicture calc) ps
where
calc pic
# pic = setPenAttributes pen pic
# (metrics,pic) = getPenFontMetrics pic
# (itemWidths,pic) = getPenFontStringWidths items pic
# maxWidth = maxList [oldMaxWidth:itemWidths]
# nrItems = length items
# height = oldHeight + nrItems*(fontLineHeight metrics)
# newDomain = {corner1=zero,corner2={x=maxWidth,y=height}} // calculate new domain...
= (newDomain,pic)
removeDupAtt [x:xs] = [x:removeDupAtt (filter (diff x) xs)]
where
......@@ -281,16 +290,22 @@ customlook ls=:{items,selection,pen,lineHeight,initHeight}
= (customlook,ls)
where
customlook _ {newFrame} pict
# pict = setPenAttributes pen pict
# pict = unfill newFrame pict
# (_,pict) = strictSeq [drawline item \\ item <- items] (initHeight,pict)
# pict = strictSeq [drawsel sel \\ sel <- selection] pict
# min_y = newFrame.corner1.y
# max_y = newFrame.corner2.y
# pict = setPenAttributes pen pict
# pict = unfill newFrame pict
# (_,pict) = foldl drawline (initHeight,pict) items
with
drawline (y,p) line
| y<min_y || y-lineHeight>max_y
= (y+lineHeight,p)
= (y+lineHeight,drawAt {x=0,y=y} line p)
# pict = strictSeq [drawsel sel \\ sel <- selection] pict
= pict
where
(x1,x2) = (newFrame.corner1.x,newFrame.corner2.x)
x1 = newFrame.corner1.x
x2 = newFrame.corner2.x
drawsel i = hilite {corner1={x=x1,y=(i-1)*lineHeight}, corner2={x=x2,y=i*lineHeight-1}}
drawline line (y,p)
= (y+lineHeight,drawAt {x=0,y=y} line p)
//--
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment