--- a/Make.proto Mon Mar 06 22:06:04 1995 +0100
+++ b/Make.proto Mon Mar 06 22:06:09 1995 +0100
@@ -1,4 +1,4 @@
-# $Header: /cvs/stx/stx/libwidg/Make.proto,v 1.13 1995-02-18 20:15:07 claus Exp $
+# $Header: /cvs/stx/stx/libwidg/Make.proto,v 1.14 1995-03-06 21:06:09 claus Exp $
#
# -------------- no need to change anything below ----------
@@ -25,8 +25,8 @@
ScrollBar.$(O) \
ObjView.$(O) \
PopUpMenu.$(O) \
- DialogBox.$(O) \
- InfoBox.$(O) \
+ DialogBox.$(O) \
+ InfoBox.$(O) \
TextView.$(O) \
HVScrView.$(O) \
SelListV.$(O) \
@@ -70,8 +70,10 @@
RButton.$(O) \
PopUpList.$(O) \
FSaveBox.$(O) \
- ButtonC.$(O) \
- ToggleC.$(O)
+ ButtonC.$(O) \
+ ToggleC.$(O) \
+ VarVPanelC.$(O) \
+ VarHPanelC.$(O)
obsolete: Notifier.$(O) \
ErrNotify.$(O)
@@ -207,5 +209,7 @@
TextContr.$(O): TextContr.st $(CONTROLLER)
ETxtContr.$(O): ETxtContr.st $(I)/TextContr.H $(CONTROLLER)
-ButtonC.$(O): ButtonC.st $(CONTROLLER)
-ToggleC.$(O): ToggleC.st $(I)/ButtonC.H $(CONTROLLER)
+ButtonC.$(O): ButtonC.st $(CONTROLLER)
+ToggleC.$(O): ToggleC.st $(I)/ButtonC.H $(CONTROLLER)
+VarVPanelC.$(O): VarVPanelC.st $(CONTROLLER)
+VarHPanelC.$(O): VarHPanelC.st $(I)/VarVPanelC.H $(CONTROLLER)
--- a/VarHPanel.st Mon Mar 06 22:06:04 1995 +0100
+++ b/VarHPanel.st Mon Mar 06 22:06:09 1995 +0100
@@ -10,6 +10,8 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.4 on 6-mar-1995 at 20:01:46'!
+
VariableVerticalPanel subclass:#VariableHorizontalPanel
instanceVariableNames:''
classVariableNames:'DefaultCursor'
@@ -21,7 +23,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/VarHPanel.st,v 1.11 1995-02-27 10:41:41 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/VarHPanel.st,v 1.12 1995-03-06 21:05:51 claus Exp $
'!
!VariableHorizontalPanel class methodsFor:'documentation'!
@@ -42,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/VarHPanel.st,v 1.11 1995-02-27 10:41:41 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/VarHPanel.st,v 1.12 1995-03-06 21:05:51 claus Exp $
"
!
@@ -100,31 +102,60 @@
"
! !
-!VariableHorizontalPanel methodsFor:'initializing'!
+!VariableHorizontalPanel methodsFor:'private'!
+
+resizeSubviewsFrom:start to:stop
+ "readjust size of some subviews"
+
+ |step nSubviews|
-initCursor
- "set the cursor - a horizontal double arrow"
+ subViews notNil ifTrue:[
+ (start <= stop) ifTrue:[
+ step := 1
+ ] ifFalse:[
+ step := -1
+ ].
+ nSubviews := subViews size.
+ start to:stop by:step do:[:index |
+ |bw view o1 o2 relCorner relOrg newCorner newOrg|
+
+ view := subViews at:index.
+ bw := view borderWidth.
- DefaultCursor notNil ifTrue:[
- cursor := DefaultCursor
- ] ifFalse:[
- cursor := Cursor sourceForm:(Form fromFile:'VHPanel.xbm')
- maskForm:(Form fromFile:'VHPanel_m.xbm')
- hotX:8
- hotY:8.
- "
- if bitmaps are not available, use a standard cursor
- "
- cursor isNil ifTrue:[
- "which one looks better ?"
- cursor := Cursor leftRightArrow
- "cursor := Cursor leftLimitArrow"
- ].
- DefaultCursor := cursor
+ index == 1 ifTrue:[
+ o1 := 0.
+ ] ifFalse:[
+ o1 := barHeight // 2 - bw
+ ].
+ index == nSubviews ifTrue:[
+ o2 := 0.
+ ] ifFalse:[
+ o2 := barHeight // 2 - bw
+ ].
+
+ relCorner := view relativeCorner.
+ relCorner isNil ifTrue:[
+ self error:'subview must have relative corner'
+ ].
+ newCorner := view cornerFromRelativeCorner.
+ newCorner notNil ifTrue:[
+ newCorner x:(newCorner x - o2)
+ ].
+
+ relOrg := view relativeOrigin.
+ relOrg isNil ifTrue:[
+ self error:'subview must have relative origin'
+ ].
+ newOrg := view originFromRelativeOrigin.
+ newOrg notNil ifTrue:[
+ (index ~~ 1) ifTrue:[
+ newOrg x:(newOrg x + o1)
+ ].
+ ].
+ view pixelOrigin:newOrg corner:newCorner
+ ]
]
-! !
-
-!VariableHorizontalPanel methodsFor:'private'!
+!
handleOriginsFrom:start to:stop do:aBlock
"evaluate the argument block for some handle-origins"
@@ -186,198 +217,55 @@
x := x + w
]
]
-!
-
-resizeSubviewsFrom:start to:stop
- "readjust size of some subviews"
-
- |step nSubviews|
-
- subViews notNil ifTrue:[
- (start <= stop) ifTrue:[
- step := 1
- ] ifFalse:[
- step := -1
- ].
- nSubviews := subViews size.
- start to:stop by:step do:[:index |
- |bw view o1 o2 relCorner relOrg newCorner newOrg|
-
- view := subViews at:index.
- bw := view borderWidth.
-
- index == 1 ifTrue:[
- o1 := 0.
- ] ifFalse:[
- o1 := barHeight // 2 - bw
- ].
- index == nSubviews ifTrue:[
- o2 := 0.
- ] ifFalse:[
- o2 := barHeight // 2 - bw
- ].
-
- relCorner := view relativeCorner.
- relCorner isNil ifTrue:[
- self error:'subview must have relative corner'
- ].
- newCorner := view cornerFromRelativeCorner.
- newCorner notNil ifTrue:[
- newCorner x:(newCorner x - o2)
- ].
-
- relOrg := view relativeOrigin.
- relOrg isNil ifTrue:[
- self error:'subview must have relative origin'
- ].
- newOrg := view originFromRelativeOrigin.
- newOrg notNil ifTrue:[
- (index ~~ 1) ifTrue:[
- newOrg x:(newOrg x + o1)
- ].
- ].
- view pixelOrigin:newOrg corner:newCorner
- ]
- ]
! !
-!VariableHorizontalPanel methodsFor:'event handling'!
-
-buttonPress:button x:bx y:by
- "button was pressed - if it hits a handle, start move"
+!VariableHorizontalPanel methodsFor:'initializing'!
- |handle|
-
- ((button == 1) or:[button == #select]) ifTrue:[
- handle := 1.
- self handleOriginsDo:[:hPoint |
- |hx|
+initCursor
+ "set the cursor - a horizontal double arrow"
- hx := hPoint x.
- (bx between:hx and:(hx + barHeight)) ifTrue:[
- movedHandle := handle.
- prev := hx.
- start := bx - hx.
- self noClipByChildren.
- self xoring:[
- trackLine ifTrue:[
- self displayLineFromX:hx+(barHeight // 2) y:0
- toX:hx+(barHeight // 2) y:height.
- ] ifFalse:[
- self fillRectangleX:hx y:0 width:barHeight height:height
- ]
- ].
- self clipByChildren.
- ^ self
- ].
- handle := handle + 1
+ DefaultCursor notNil ifTrue:[
+ cursor := DefaultCursor
+ ] ifFalse:[
+ cursor := Cursor sourceForm:(Form fromFile:'VHPanel.xbm')
+ maskForm:(Form fromFile:'VHPanel_m.xbm')
+ hotX:8
+ hotY:8.
+ "
+ if bitmaps are not available, use a standard cursor
+ "
+ cursor isNil ifTrue:[
+ "which one looks better ?"
+ cursor := Cursor leftRightArrow
+ "cursor := Cursor leftLimitArrow"
].
- movedHandle := nil
- ] ifFalse:[
- super buttonPress:button x:bx y:by
+ DefaultCursor := cursor
]
!
-buttonMotion:buttonMask x:bx y:by
- "mouse-button was moved while pressed;
- clear prev handleBar and draw handle bar at new position"
-
- |xpos limitTop limitBot|
-
- movedHandle isNil ifTrue: [^ self]. "should not happen"
-
- "speedup - if there is already another movement,
- ignore thisone ... "
-
- device synchronizeOutput.
- self buttonMotionEventPending ifTrue:[^ self].
-
- xpos := bx - start.
-
- "see comment in VariableVerticalPanel>>buttonMotion:x:y:"
-
-"/ limitTop := barHeight // 2.
-"/ limitBot := self width - barHeight.
-
- limitTop := 0.
- limitBot := self innerWidth.
-
- movedHandle > 1 ifTrue:[
- limitTop := (subViews at:movedHandle) origin x + (barHeight // 2)
- ].
- movedHandle < (subViews size - 1) ifTrue:[
- limitBot := (subViews at:(movedHandle + 2)) origin x - barHeight
- ].
- limitBot := limitBot - barHeight.
- (xpos < limitTop) ifTrue:[ "check against view limits"
- xpos := limitTop
- ] ifFalse:[
- (xpos > limitBot) ifTrue:[
- xpos := limitBot
- ]
- ].
-
- self noClipByChildren.
- self xoring:[
- trackLine ifTrue:[
- self displayLineFromX:prev+(barHeight // 2) y:0
- toX:prev+(barHeight // 2) y:height.
- self displayLineFromX:xpos+(barHeight // 2) y:0
- toX:xpos+(barHeight // 2) y:height.
- ] ifFalse:[
- self fillRectangleX:prev y:0 width:barHeight height:height.
- self fillRectangleX:xpos y:0 width:barHeight height:height
- ].
- ].
- self clipByChildren.
- prev := xpos
-!
-
-buttonRelease:button x:x y:y
- "end bar-move"
-
- |aboveView belowView aboveIndex belowIndex newX|
-
- ((button == 1) or:[button == #select]) ifTrue:[
- movedHandle isNil ifTrue:[^ self].
-
- "undo the last xor"
-
- self noClipByChildren.
- self xoring:[
- trackLine ifTrue:[
- self displayLineFromX:prev+(barHeight // 2) y:0
- toX:prev+(barHeight // 2) y:height.
- ] ifFalse:[
- self fillRectangleX:prev y:0 width:barHeight height:height
- ].
- ].
- self clipByChildren.
-
- "compute the new relative heights"
-
- aboveIndex := movedHandle.
- belowIndex := movedHandle + 1.
- aboveView := subViews at:aboveIndex.
- belowView := subViews at:belowIndex.
-
- newX := (prev + start / width) asFloat .
- aboveView relativeCorner:newX @ aboveView relativeCorner y.
- belowView relativeOrigin:newX @ belowView relativeOrigin y.
- movedHandle := nil.
-
- self resizeSubviewsFrom:aboveIndex to:belowIndex.
-
- "and redraw handles"
-
- self redrawHandlesFrom:aboveIndex to:belowIndex
- ] ifFalse:[
- super buttonRelease:button x:x y:y
- ]
+defaultControllerClass
+ ^ VariableHorizontalPanelController
! !
!VariableHorizontalPanel methodsFor:'drawing'!
+invertHandleBarAtX:hx y:hy
+ self noClipByChildren.
+ self xoring:[
+ |x|
+
+ trackLine ifTrue:[
+ x := hx + (barHeight // 2).
+ self displayLineFromX:x y:0 toX:x y:height.
+ ] ifFalse:[
+ self fillRectangleX:hx y:0 width:barHeight height:height
+ ]
+ ].
+ self clipByChildren.
+
+
+!
+
drawHandleAtX:hx y:hy
|w x m|
@@ -450,22 +338,5 @@
].
self fillRectangleX:hx y:hy width:barHeight height:barWidth
]
-!
-
-redrawHandlesFrom:start to:stop
- "redraw some handles"
+! !
- subViews notNil ifTrue:[
- self handleOriginsFrom:start to:stop do:[:hPoint |
- self drawHandleAtX:(hPoint x) y:(hPoint y)
- ].
- movedHandle notNil ifTrue:[
- self noClipByChildren.
- self xoring:[
- self fillRectangleX:prev y:0 width:barHeight height:height
- ].
- self clipByChildren
- ]
- ]
-
-! !
--- a/VarVPanel.st Mon Mar 06 22:06:04 1995 +0100
+++ b/VarVPanel.st Mon Mar 06 22:06:09 1995 +0100
@@ -10,16 +10,15 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.4 on 6-mar-1995 at 20:01:51'!
+
View subclass:#VariableVerticalPanel
- instanceVariableNames:'movedHandle prev start
- barHeight barWidth separatingLine
- shadowForm lightForm
- showHandle handlePosition
- handleColor handleStyle noColor
- trackLine redrawLocked'
+ instanceVariableNames:'barHeight barWidth separatingLine
+ shadowForm lightForm showHandle handlePosition handleColor
+ handleStyle noColor trackLine redrawLocked'
classVariableNames:'DefaultShowHandle DefaultHandleStyle DefaultHandlePosition
- DefaultTrackingLine DefaultSeparatingLine DefaultHandleColor
- DefaultCursor'
+ DefaultTrackingLine DefaultSeparatingLine DefaultHandleColor
+ DefaultCursor'
poolDictionaries:''
category:'Views-Layout'
!
@@ -28,7 +27,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/Attic/VarVPanel.st,v 1.13 1995-02-27 10:41:46 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/VarVPanel.st,v 1.14 1995-03-06 21:06:00 claus Exp $
'!
!VariableVerticalPanel class methodsFor:'documentation'!
@@ -49,7 +48,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/Attic/VarVPanel.st,v 1.13 1995-02-27 10:41:46 claus Exp $
+$Header: /cvs/stx/stx/libwidg/Attic/VarVPanel.st,v 1.14 1995-03-06 21:06:00 claus Exp $
"
!
@@ -124,12 +123,6 @@
^ Scroller handleShadowFormOn:aDisplay
!
-lightFormOn:aDisplay
- "use same handle as Scroller"
-
- ^ Scroller handleLightFormOn:aDisplay
-!
-
updateStyleCache
DefaultShowHandle := StyleSheet at:'variablePanelShowHandle' default:true.
DefaultHandleStyle := StyleSheet at:'variablePanelHandleStyle'.
@@ -137,178 +130,34 @@
DefaultTrackingLine := StyleSheet at:'variablePanelTrackingLine' default:false.
DefaultSeparatingLine := StyleSheet at:'variablePanelSeparatingLine' default:false.
DefaultHandleColor := StyleSheet colorAt:'variablePanelHandleColor' default:Black.
-! !
-
-!VariableVerticalPanel methodsFor:'initializing'!
-
-initialize
- super initialize.
- noColor := Color noColor.
!
-initStyle
- |mm|
-
- super initStyle.
-
- handleColor := DefaultHandleColor on:device.
-
- showHandle := DefaultShowHandle.
-
- DefaultHandleStyle isNil ifTrue:[
- handleStyle := style
- ] ifFalse:[
- handleStyle := DefaultHandleStyle
- ].
- handleStyle == #next ifTrue:[
- shadowForm := self class shadowFormOn:device.
- lightForm := self class lightFormOn:device.
-
- self barHeight:(shadowForm height + 2).
- barWidth := shadowForm width.
- ] ifFalse:[
- shadowForm := lightForm := nil.
- ].
-
- handlePosition := DefaultHandlePosition.
- trackLine := DefaultTrackingLine.
- separatingLine := DefaultSeparatingLine.
+lightFormOn:aDisplay
+ "use same handle as Scroller"
- mm := device verticalPixelPerMillimeter.
- self is3D ifTrue:[
- self barHeight:(3 * mm) rounded
- ] ifFalse:[
- self barHeight:(2 * mm) rounded
- ].
- barWidth := (2 * mm) rounded. "motif style width"
- handleStyle == #mswindows ifTrue:[
- barWidth := (ArrowButton new direction:#up) width + 1
- ].
-!
-
-initCursor
- "set the cursor - a double arrow"
-
- DefaultCursor notNil ifTrue:[
- cursor := DefaultCursor
- ] ifFalse:[
- cursor := Cursor sourceForm:(Form fromFile:'VVPanel.xbm')
- maskForm:(Form fromFile:'VVPanel_m.xbm')
- hotX:8
- hotY:8.
- "
- if bitmaps are not available, use a standard cursor
- "
- cursor isNil ifTrue:[
- "which one looks better ?"
- cursor := Cursor upDownArrow
- "cursor := Cursor upLimitArrow"
- ].
- DefaultCursor := cursor
- ]
-!
-
-fixSize
- extentChanged ifTrue:[
- super fixSize.
- self resizeSubviewsFrom:1 to:(subViews size)
- ] ifFalse:[
- super fixSize
- ]
+ ^ Scroller handleLightFormOn:aDisplay
! !
-!VariableVerticalPanel methodsFor:'accessing'!
+!VariableVerticalPanel methodsFor:'drawing'!
-add:aView
- "a view is added; make its size relative (if not already done)"
+redrawHandlesFrom:start to:stop
+ "redraw some handles"
-"obsolete" self halt.
-
- super add:aView.
- shown ifTrue:[
- (superView isNil or:[superView shown]) ifTrue:[
- self setupSubviewSizes
+ subViews notNil ifTrue:[
+ showHandle ifTrue:[
+ self handleOriginsFrom:start to:stop do:[:hPoint |
+ self drawHandleAtX:(hPoint x) y:(hPoint y)
+ ].
]
]
!
-removeSubView:aView
- "a view is removed; adjust other subviews sizes"
-
- super removeSubView:aView.
- shown ifTrue:[
- (superView isNil or:[superView shown]) ifTrue:[
- self setupSubviewSizes
- ]
- ]
-!
-
-barHeight:nPixel
- "set the height of the separating bar"
-
- barHeight := nPixel.
-
- "if screen is very low-res, make certain bar is visible and catchable"
- (barHeight < 4) ifTrue:[
- barHeight := 4
- ].
-
- "make it even so spacing is equally spreadable among subviews"
- barHeight odd ifTrue:[
- barHeight := barHeight + 1
- ]
-!
-
-handlePosition:aSymbol
- "define the position of the handle; the argument aSymbol
- may be one of #left, #right or #center"
-
- handlePosition := aSymbol
-!
-
-handlePosition
- "return the position of the handle"
+redraw
+ "redraw all of the handles"
- ^ handlePosition
-!
-
-style:styleSymbol
- "define the style of the handle;
- styleSymbol may be #motif to draw a little knob or
- anything else to draw scrollBars handleForm"
-
- (styleSymbol ~~ handleStyle) ifTrue:[
- handleStyle := styleSymbol.
- handleStyle == #next ifTrue:[
- shadowForm := self class shadowFormOn:device.
- lightForm := self class lightFormOn:device.
- ] ifFalse:[
- shadowForm := lightForm := nil
- ].
-
- shadowForm notNil ifTrue:[
- (self is3D and:[handleStyle ~~ #motif]) ifTrue:[
- self barHeight:(shadowForm height + 2).
- barWidth := shadowForm width
- ]
- ].
- shown ifTrue:[
- self resizeSubviewsFrom:1 to:(subViews size).
- self redraw
- ]
+ redrawLocked ~~ true ifTrue:[
+ self redrawHandlesFrom:1 to:(subViews size)
]
-! !
-
-!VariableVerticalPanel methodsFor:'drawing'!
-
-drawHandleFormAtX:hx y:hy
- "draw a handles bitmap at hx/hy"
-
- self paint:shadowColor.
- self displayForm:shadowForm x:hx y:hy.
- self paint:lightColor.
- self displayForm:lightForm x:hx y:hy.
- self paint:viewBackground
!
drawHandleAtX:hx y:hy
@@ -386,243 +235,250 @@
]
!
-redrawHandlesFrom:start to:stop
- "redraw some handles"
+lockRedraw
+ redrawLocked := true
+!
+
+unlockRedraw
+ redrawLocked := false
+!
+
+invertHandleBarAtX:hx y:hy
+ self noClipByChildren.
+ self xoring:[
+ |y|
+
+ trackLine ifTrue:[
+ y := hy + (barHeight // 2).
+ self displayLineFromX:0 y:y toX:width y:y.
+ ] ifFalse:[
+ self fillRectangleX:0 y:hy width:width height:barHeight
+ ]
+ ].
+ self clipByChildren.
+!
+
+drawHandleFormAtX:hx y:hy
+ "draw a handles bitmap at hx/hy"
+
+ self paint:shadowColor.
+ self displayForm:shadowForm x:hx y:hy.
+ self paint:lightColor.
+ self displayForm:lightForm x:hx y:hy.
+ self paint:viewBackground
+! !
- subViews notNil ifTrue:[
- showHandle ifTrue:[
- self handleOriginsFrom:start to:stop do:[:hPoint |
- self drawHandleAtX:(hPoint x) y:(hPoint y)
- ].
- movedHandle notNil ifTrue:[
- self noClipByChildren.
- self xoring:[
- |y|
+!VariableVerticalPanel methodsFor:'accessing'!
+
+barHeight
+ "return the height of the separating bar"
+
+ ^ barHeight
+!
+
+barHeight:nPixel
+ "set the height of the separating bar"
+
+ barHeight := nPixel.
- trackLine ifTrue:[
- y := prev+(barHeight // 2).
- self displayLineFromX:0 y:y toX:width y:y.
- ] ifFalse:[
- self fillRectangleX:0 y:prev width:width height:barHeight
- ]
- ].
- self clipByChildren
- ]
+ "if screen is very low-res, make certain bar is visible and catchable"
+ (barHeight < 4) ifTrue:[
+ barHeight := 4
+ ].
+
+ "make it even so spacing is equally spreadable among subviews"
+ barHeight odd ifTrue:[
+ barHeight := barHeight + 1
+ ]
+!
+
+add:aView
+ "a view is added; make its size relative (if not already done)"
+
+"obsolete" self halt.
+
+ super add:aView.
+ shown ifTrue:[
+ (superView isNil or:[superView shown]) ifTrue:[
+ self setupSubviewSizes
]
]
!
-redraw
- "redraw all of the handles"
-
- redrawLocked ~~ true ifTrue:[
- self redrawHandlesFrom:1 to:(subViews size)
- ]
-! !
+removeSubView:aView
+ "a view is removed; adjust other subviews sizes"
-!VariableVerticalPanel methodsFor:'event handling'!
-
-sizeChanged:how
- "tell subviews if I change size"
-
+ super removeSubView:aView.
shown ifTrue:[
- (how == #smaller) ifTrue:[
- self resizeSubviewsFrom:1 to:(subViews size)
- ] ifFalse:[
- self resizeSubviewsFrom:(subViews size) to:1
+ (superView isNil or:[superView shown]) ifTrue:[
+ self setupSubviewSizes
]
]
!
-buttonPress:button x:bx y:by
- "button was pressed - if it hits a handle, start move"
+handlePosition:aSymbol
+ "define the position of the handle; the argument aSymbol
+ may be one of #left, #right or #center"
- |handle|
+ handlePosition := aSymbol
+!
- ((button == 1) or:[button == #select]) ifTrue:[
- handle := 1.
- self handleOriginsDo:[:hPoint |
- |hy|
+handlePosition
+ "return the position of the handle"
+
+ ^ handlePosition
+!
+
+style:styleSymbol
+ "define the style of the handle;
+ styleSymbol may be #motif to draw a little knob or
+ anything else to draw scrollBars handleForm"
- hy := hPoint y.
- (by between:hy and:(hy + barHeight)) ifTrue:[
- movedHandle := handle.
- prev := hy.
- start := by - hy.
- self noClipByChildren.
- self xoring:[
- |y|
+ (styleSymbol ~~ handleStyle) ifTrue:[
+ handleStyle := styleSymbol.
+ handleStyle == #next ifTrue:[
+ shadowForm := self class shadowFormOn:device.
+ lightForm := self class lightFormOn:device.
+ ] ifFalse:[
+ shadowForm := lightForm := nil
+ ].
- trackLine ifTrue:[
- y := hy + (barHeight // 2).
- self displayLineFromX:0 y:y toX:width y:y.
- ] ifFalse:[
- self fillRectangleX:0 y:hy width:width height:barHeight
- ]
- ].
- self clipByChildren.
- ^ self
- ].
- handle := handle + 1
+ shadowForm notNil ifTrue:[
+ (self is3D and:[handleStyle ~~ #motif]) ifTrue:[
+ self barHeight:(shadowForm height + 2).
+ barWidth := shadowForm width
+ ]
].
- movedHandle := nil
+ shown ifTrue:[
+ self resizeSubviewsFrom:1 to:(subViews size).
+ self redraw
+ ]
+ ]
+! !
+
+!VariableVerticalPanel methodsFor:'initializing'!
+
+fixSize
+ extentChanged ifTrue:[
+ super fixSize.
+ self resizeSubviewsFrom:1 to:(subViews size)
] ifFalse:[
- super buttonPress:button x:bx y:by
+ super fixSize
]
!
-buttonMotion:button x:bx y:by
- "mouse-button was moved while pressed;
- clear prev handleBar and draw handle bar at new position"
-
- |ypos limitTop limitBot|
-
- movedHandle isNil ifTrue: [^ self]. "should not happen"
+initStyle
+ |mm|
- "speedup - if there is already another movement,
- ignore thisone ... "
+ super initStyle.
- device synchronizeOutput.
- self buttonMotionEventPending ifTrue:[^ self].
+ handleColor := DefaultHandleColor on:device.
- ypos := by - start.
+ showHandle := DefaultShowHandle.
- "
- the two lines below will not allow resizing down to zero
- (so that some is always visible)
- "
-"/ limitTop := barHeight // 2.
-"/ limitBot := self height - barHeight.
-
- "
- these allow resizing to zero - which is better ?
- "
- limitTop := 0.
- limitBot := self innerHeight.
+ DefaultHandleStyle isNil ifTrue:[
+ handleStyle := style
+ ] ifFalse:[
+ handleStyle := DefaultHandleStyle
+ ].
+ handleStyle == #next ifTrue:[
+ shadowForm := self class shadowFormOn:device.
+ lightForm := self class lightFormOn:device.
- movedHandle > 1 ifTrue:[
- limitTop := (subViews at:movedHandle) origin y + (barHeight // 2)
- ].
- movedHandle < (subViews size - 1) ifTrue:[
- limitBot := (subViews at:(movedHandle + 2)) origin y - barHeight
- ].
- limitBot := limitBot - barHeight.
- (ypos < limitTop) ifTrue:[ "check against view limits"
- ypos := limitTop
+ self barHeight:(shadowForm height + 2).
+ barWidth := shadowForm width.
] ifFalse:[
- (ypos > limitBot) ifTrue:[
- ypos := limitBot
- ]
+ shadowForm := lightForm := nil.
].
- self noClipByChildren.
- self xoring:[
- |halfHeight y|
+ handlePosition := DefaultHandlePosition.
+ trackLine := DefaultTrackingLine.
+ separatingLine := DefaultSeparatingLine.
- trackLine ifTrue:[
- halfHeight := barHeight // 2.
- y := prev + halfHeight.
- self displayLineFromX:0 y:y toX:width y:y.
- y := ypos + halfHeight.
- self displayLineFromX:0 y:y toX:width y:y.
- ] ifFalse:[
- self fillRectangleX:0 y:prev width:width height:barHeight.
- self fillRectangleX:0 y:ypos width:width height:barHeight
- ]
+ mm := device verticalPixelPerMillimeter.
+ self is3D ifTrue:[
+ self barHeight:(3 * mm) rounded
+ ] ifFalse:[
+ self barHeight:(2 * mm) rounded
].
- self clipByChildren.
- prev := ypos
+ barWidth := (2 * mm) rounded. "motif style width"
+ handleStyle == #mswindows ifTrue:[
+ barWidth := (ArrowButton new direction:#up) width + 1
+ ].
+!
+
+initialize
+ super initialize.
+ noColor := Color noColor.
!
-buttonRelease:button x:x y:y
- "end bar-move"
-
- |aboveView belowView aboveIndex belowIndex newY oldY|
-
- ((button == 1) or:[button == #select]) ifTrue:[
- movedHandle isNil ifTrue:[^ self].
-
- "undo the last xor"
-
- self noClipByChildren.
- self xoring:[
- |y|
-
- trackLine ifTrue:[
- y := prev + (barHeight // 2).
- self displayLineFromX:0 y:y toX:width y:y.
- ] ifFalse:[
- self fillRectangleX:0 y:prev width:width height:barHeight
- ].
- ].
- self clipByChildren.
-
- "compute the new relative heights"
+initCursor
+ "set the cursor - a double arrow"
- aboveIndex := movedHandle.
- belowIndex := movedHandle + 1.
- movedHandle := nil.
-
- aboveView := subViews at:aboveIndex.
- belowView := subViews at:belowIndex.
-
- oldY := aboveView relativeCorner y.
- newY := (prev + start / height) asFloat.
- aboveView relativeCorner:aboveView relativeCorner x @ newY.
- belowView relativeOrigin:belowView relativeOrigin x @ newY.
+ DefaultCursor notNil ifTrue:[
+ cursor := DefaultCursor
+ ] ifFalse:[
+ cursor := Cursor sourceForm:(Form fromFile:'VVPanel.xbm')
+ maskForm:(Form fromFile:'VVPanel_m.xbm')
+ hotX:8
+ hotY:8.
+ "
+ if bitmaps are not available, use a standard cursor
+ "
+ cursor isNil ifTrue:[
+ "which one looks better ?"
+ cursor := Cursor upDownArrow
+ "cursor := Cursor upLimitArrow"
+ ].
+ DefaultCursor := cursor
+ ]
+!
- redrawLocked := true.
- oldY > newY ifTrue:[
- self resizeSubviewsFrom:aboveIndex to:belowIndex.
- ] ifFalse:[
- self resizeSubviewsFrom:belowIndex to:aboveIndex.
- ].
- redrawLocked := true.
- self redrawHandlesFrom:aboveIndex to:belowIndex.
- redrawLocked := false.
- ] ifFalse:[
- super buttonRelease:button x:x y:y
- ]
+defaultControllerClass
+ ^ VariableVerticalPanelController
+
+
! !
!VariableVerticalPanel methodsFor:'private'!
-anyNonRelativeSubviews
- "return true, if any of my subviews has no relative origin/extent"
-
- 1 to:(subViews size) do:[:index |
- |view|
+handleOriginsDo:aBlock
+ "evaluate the argument block for every handle-origin"
- view := subViews at:index.
- view relativeExtent isNil ifTrue:[^ true].
- view relativeOrigin isNil ifTrue:[^ true]
- ].
- ^ false
+ self handleOriginsFrom:1 to:(subViews size) do:aBlock
!
-setupSubviewSizes
- "setup subviews sizes (in case of non-relative sizes)"
+handleOriginsFrom:start to:stop do:aBlock
+ "evaluate the argument block for some handle-origins"
- |y h|
+ |x hw hDelta|
- self anyNonRelativeSubviews ifTrue:[
- "there is at least one subview without
- relative origin/extent - setup all subviews
- to spread evenly ..."
-
- y := 0.0.
- h := 1.0 / (subViews size).
-
- 1 to:(subViews size) do:[:index |
- |view|
+ subViews notNil ifTrue:[
+ shadowForm notNil ifTrue:[
+ hw := shadowForm width
+ ] ifFalse:[
+ hw := barWidth
+ ].
+ (handleStyle ~~ #normal and:[handleStyle ~~ #mswindows]) ifTrue:[
+ hDelta := barWidth // 2.
+ ] ifFalse:[
+ hDelta := 0
+ ].
+ (handlePosition == #left) ifTrue:[
+ x := hDelta
+ ] ifFalse:[
+ (handlePosition == #right) ifTrue:[
+ x := width - (1 "2" * hw) - margin - hDelta.
+ ] ifFalse:[
+ x := width - barWidth // 2
+ ]
+ ].
+ (start + 1) to:stop do:[:index |
+ |view y|
view := subViews at:index.
- index == subViews size ifTrue:[
- view origin:(0.0 @ y) corner:(1.0 @ 1.0)
- ] ifFalse:[
- view origin:(0.0 @ y) corner:(1.0 @ (y + h))
- ].
- y := y + h
+ y := view origin y - barHeight + 1.
+ aBlock value:(x @ y)
]
]
!
@@ -680,43 +536,57 @@
]
!
-handleOriginsFrom:start to:stop do:aBlock
- "evaluate the argument block for some handle-origins"
+anyNonRelativeSubviews
+ "return true, if any of my subviews has no relative origin/extent"
+
+ 1 to:(subViews size) do:[:index |
+ |view|
- |x hw hDelta|
+ view := subViews at:index.
+ view relativeExtent isNil ifTrue:[^ true].
+ view relativeOrigin isNil ifTrue:[^ true]
+ ].
+ ^ false
+!
- subViews notNil ifTrue:[
- shadowForm notNil ifTrue:[
- hw := shadowForm width
- ] ifFalse:[
- hw := barWidth
- ].
- (handleStyle ~~ #normal and:[handleStyle ~~ #mswindows]) ifTrue:[
- hDelta := barWidth // 2.
- ] ifFalse:[
- hDelta := 0
- ].
- (handlePosition == #left) ifTrue:[
- x := hDelta
- ] ifFalse:[
- (handlePosition == #right) ifTrue:[
- x := width - (1 "2" * hw) - margin - hDelta.
- ] ifFalse:[
- x := width - barWidth // 2
- ]
- ].
- (start + 1) to:stop do:[:index |
- |view y|
+setupSubviewSizes
+ "setup subviews sizes (in case of non-relative sizes)"
+
+ |y h|
+
+ self anyNonRelativeSubviews ifTrue:[
+ "there is at least one subview without
+ relative origin/extent - setup all subviews
+ to spread evenly ..."
+
+ y := 0.0.
+ h := 1.0 / (subViews size).
+
+ 1 to:(subViews size) do:[:index |
+ |view|
view := subViews at:index.
- y := view origin y - barHeight + 1.
- aBlock value:(x @ y)
+ index == subViews size ifTrue:[
+ view origin:(0.0 @ y) corner:(1.0 @ 1.0)
+ ] ifFalse:[
+ view origin:(0.0 @ y) corner:(1.0 @ (y + h))
+ ].
+ y := y + h
]
]
-!
+! !
+
+!VariableVerticalPanel methodsFor:'event handling'!
+
+sizeChanged:how
+ "tell subviews if I change size"
-handleOriginsDo:aBlock
- "evaluate the argument block for every handle-origin"
+ shown ifTrue:[
+ (how == #smaller) ifTrue:[
+ self resizeSubviewsFrom:1 to:(subViews size)
+ ] ifFalse:[
+ self resizeSubviewsFrom:(subViews size) to:1
+ ]
+ ]
+! !
- self handleOriginsFrom:1 to:(subViews size) do:aBlock
-! !
--- a/VariableHorizontalPanel.st Mon Mar 06 22:06:04 1995 +0100
+++ b/VariableHorizontalPanel.st Mon Mar 06 22:06:09 1995 +0100
@@ -10,6 +10,8 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.4 on 6-mar-1995 at 20:01:46'!
+
VariableVerticalPanel subclass:#VariableHorizontalPanel
instanceVariableNames:''
classVariableNames:'DefaultCursor'
@@ -21,7 +23,7 @@
COPYRIGHT (c) 1992 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/VariableHorizontalPanel.st,v 1.11 1995-02-27 10:41:41 claus Exp $
+$Header: /cvs/stx/stx/libwidg/VariableHorizontalPanel.st,v 1.12 1995-03-06 21:05:51 claus Exp $
'!
!VariableHorizontalPanel class methodsFor:'documentation'!
@@ -42,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/VariableHorizontalPanel.st,v 1.11 1995-02-27 10:41:41 claus Exp $
+$Header: /cvs/stx/stx/libwidg/VariableHorizontalPanel.st,v 1.12 1995-03-06 21:05:51 claus Exp $
"
!
@@ -100,31 +102,60 @@
"
! !
-!VariableHorizontalPanel methodsFor:'initializing'!
+!VariableHorizontalPanel methodsFor:'private'!
+
+resizeSubviewsFrom:start to:stop
+ "readjust size of some subviews"
+
+ |step nSubviews|
-initCursor
- "set the cursor - a horizontal double arrow"
+ subViews notNil ifTrue:[
+ (start <= stop) ifTrue:[
+ step := 1
+ ] ifFalse:[
+ step := -1
+ ].
+ nSubviews := subViews size.
+ start to:stop by:step do:[:index |
+ |bw view o1 o2 relCorner relOrg newCorner newOrg|
+
+ view := subViews at:index.
+ bw := view borderWidth.
- DefaultCursor notNil ifTrue:[
- cursor := DefaultCursor
- ] ifFalse:[
- cursor := Cursor sourceForm:(Form fromFile:'VHPanel.xbm')
- maskForm:(Form fromFile:'VHPanel_m.xbm')
- hotX:8
- hotY:8.
- "
- if bitmaps are not available, use a standard cursor
- "
- cursor isNil ifTrue:[
- "which one looks better ?"
- cursor := Cursor leftRightArrow
- "cursor := Cursor leftLimitArrow"
- ].
- DefaultCursor := cursor
+ index == 1 ifTrue:[
+ o1 := 0.
+ ] ifFalse:[
+ o1 := barHeight // 2 - bw
+ ].
+ index == nSubviews ifTrue:[
+ o2 := 0.
+ ] ifFalse:[
+ o2 := barHeight // 2 - bw
+ ].
+
+ relCorner := view relativeCorner.
+ relCorner isNil ifTrue:[
+ self error:'subview must have relative corner'
+ ].
+ newCorner := view cornerFromRelativeCorner.
+ newCorner notNil ifTrue:[
+ newCorner x:(newCorner x - o2)
+ ].
+
+ relOrg := view relativeOrigin.
+ relOrg isNil ifTrue:[
+ self error:'subview must have relative origin'
+ ].
+ newOrg := view originFromRelativeOrigin.
+ newOrg notNil ifTrue:[
+ (index ~~ 1) ifTrue:[
+ newOrg x:(newOrg x + o1)
+ ].
+ ].
+ view pixelOrigin:newOrg corner:newCorner
+ ]
]
-! !
-
-!VariableHorizontalPanel methodsFor:'private'!
+!
handleOriginsFrom:start to:stop do:aBlock
"evaluate the argument block for some handle-origins"
@@ -186,198 +217,55 @@
x := x + w
]
]
-!
-
-resizeSubviewsFrom:start to:stop
- "readjust size of some subviews"
-
- |step nSubviews|
-
- subViews notNil ifTrue:[
- (start <= stop) ifTrue:[
- step := 1
- ] ifFalse:[
- step := -1
- ].
- nSubviews := subViews size.
- start to:stop by:step do:[:index |
- |bw view o1 o2 relCorner relOrg newCorner newOrg|
-
- view := subViews at:index.
- bw := view borderWidth.
-
- index == 1 ifTrue:[
- o1 := 0.
- ] ifFalse:[
- o1 := barHeight // 2 - bw
- ].
- index == nSubviews ifTrue:[
- o2 := 0.
- ] ifFalse:[
- o2 := barHeight // 2 - bw
- ].
-
- relCorner := view relativeCorner.
- relCorner isNil ifTrue:[
- self error:'subview must have relative corner'
- ].
- newCorner := view cornerFromRelativeCorner.
- newCorner notNil ifTrue:[
- newCorner x:(newCorner x - o2)
- ].
-
- relOrg := view relativeOrigin.
- relOrg isNil ifTrue:[
- self error:'subview must have relative origin'
- ].
- newOrg := view originFromRelativeOrigin.
- newOrg notNil ifTrue:[
- (index ~~ 1) ifTrue:[
- newOrg x:(newOrg x + o1)
- ].
- ].
- view pixelOrigin:newOrg corner:newCorner
- ]
- ]
! !
-!VariableHorizontalPanel methodsFor:'event handling'!
-
-buttonPress:button x:bx y:by
- "button was pressed - if it hits a handle, start move"
+!VariableHorizontalPanel methodsFor:'initializing'!
- |handle|
-
- ((button == 1) or:[button == #select]) ifTrue:[
- handle := 1.
- self handleOriginsDo:[:hPoint |
- |hx|
+initCursor
+ "set the cursor - a horizontal double arrow"
- hx := hPoint x.
- (bx between:hx and:(hx + barHeight)) ifTrue:[
- movedHandle := handle.
- prev := hx.
- start := bx - hx.
- self noClipByChildren.
- self xoring:[
- trackLine ifTrue:[
- self displayLineFromX:hx+(barHeight // 2) y:0
- toX:hx+(barHeight // 2) y:height.
- ] ifFalse:[
- self fillRectangleX:hx y:0 width:barHeight height:height
- ]
- ].
- self clipByChildren.
- ^ self
- ].
- handle := handle + 1
+ DefaultCursor notNil ifTrue:[
+ cursor := DefaultCursor
+ ] ifFalse:[
+ cursor := Cursor sourceForm:(Form fromFile:'VHPanel.xbm')
+ maskForm:(Form fromFile:'VHPanel_m.xbm')
+ hotX:8
+ hotY:8.
+ "
+ if bitmaps are not available, use a standard cursor
+ "
+ cursor isNil ifTrue:[
+ "which one looks better ?"
+ cursor := Cursor leftRightArrow
+ "cursor := Cursor leftLimitArrow"
].
- movedHandle := nil
- ] ifFalse:[
- super buttonPress:button x:bx y:by
+ DefaultCursor := cursor
]
!
-buttonMotion:buttonMask x:bx y:by
- "mouse-button was moved while pressed;
- clear prev handleBar and draw handle bar at new position"
-
- |xpos limitTop limitBot|
-
- movedHandle isNil ifTrue: [^ self]. "should not happen"
-
- "speedup - if there is already another movement,
- ignore thisone ... "
-
- device synchronizeOutput.
- self buttonMotionEventPending ifTrue:[^ self].
-
- xpos := bx - start.
-
- "see comment in VariableVerticalPanel>>buttonMotion:x:y:"
-
-"/ limitTop := barHeight // 2.
-"/ limitBot := self width - barHeight.
-
- limitTop := 0.
- limitBot := self innerWidth.
-
- movedHandle > 1 ifTrue:[
- limitTop := (subViews at:movedHandle) origin x + (barHeight // 2)
- ].
- movedHandle < (subViews size - 1) ifTrue:[
- limitBot := (subViews at:(movedHandle + 2)) origin x - barHeight
- ].
- limitBot := limitBot - barHeight.
- (xpos < limitTop) ifTrue:[ "check against view limits"
- xpos := limitTop
- ] ifFalse:[
- (xpos > limitBot) ifTrue:[
- xpos := limitBot
- ]
- ].
-
- self noClipByChildren.
- self xoring:[
- trackLine ifTrue:[
- self displayLineFromX:prev+(barHeight // 2) y:0
- toX:prev+(barHeight // 2) y:height.
- self displayLineFromX:xpos+(barHeight // 2) y:0
- toX:xpos+(barHeight // 2) y:height.
- ] ifFalse:[
- self fillRectangleX:prev y:0 width:barHeight height:height.
- self fillRectangleX:xpos y:0 width:barHeight height:height
- ].
- ].
- self clipByChildren.
- prev := xpos
-!
-
-buttonRelease:button x:x y:y
- "end bar-move"
-
- |aboveView belowView aboveIndex belowIndex newX|
-
- ((button == 1) or:[button == #select]) ifTrue:[
- movedHandle isNil ifTrue:[^ self].
-
- "undo the last xor"
-
- self noClipByChildren.
- self xoring:[
- trackLine ifTrue:[
- self displayLineFromX:prev+(barHeight // 2) y:0
- toX:prev+(barHeight // 2) y:height.
- ] ifFalse:[
- self fillRectangleX:prev y:0 width:barHeight height:height
- ].
- ].
- self clipByChildren.
-
- "compute the new relative heights"
-
- aboveIndex := movedHandle.
- belowIndex := movedHandle + 1.
- aboveView := subViews at:aboveIndex.
- belowView := subViews at:belowIndex.
-
- newX := (prev + start / width) asFloat .
- aboveView relativeCorner:newX @ aboveView relativeCorner y.
- belowView relativeOrigin:newX @ belowView relativeOrigin y.
- movedHandle := nil.
-
- self resizeSubviewsFrom:aboveIndex to:belowIndex.
-
- "and redraw handles"
-
- self redrawHandlesFrom:aboveIndex to:belowIndex
- ] ifFalse:[
- super buttonRelease:button x:x y:y
- ]
+defaultControllerClass
+ ^ VariableHorizontalPanelController
! !
!VariableHorizontalPanel methodsFor:'drawing'!
+invertHandleBarAtX:hx y:hy
+ self noClipByChildren.
+ self xoring:[
+ |x|
+
+ trackLine ifTrue:[
+ x := hx + (barHeight // 2).
+ self displayLineFromX:x y:0 toX:x y:height.
+ ] ifFalse:[
+ self fillRectangleX:hx y:0 width:barHeight height:height
+ ]
+ ].
+ self clipByChildren.
+
+
+!
+
drawHandleAtX:hx y:hy
|w x m|
@@ -450,22 +338,5 @@
].
self fillRectangleX:hx y:hy width:barHeight height:barWidth
]
-!
-
-redrawHandlesFrom:start to:stop
- "redraw some handles"
+! !
- subViews notNil ifTrue:[
- self handleOriginsFrom:start to:stop do:[:hPoint |
- self drawHandleAtX:(hPoint x) y:(hPoint y)
- ].
- movedHandle notNil ifTrue:[
- self noClipByChildren.
- self xoring:[
- self fillRectangleX:prev y:0 width:barHeight height:height
- ].
- self clipByChildren
- ]
- ]
-
-! !
--- a/VariableVerticalPanel.st Mon Mar 06 22:06:04 1995 +0100
+++ b/VariableVerticalPanel.st Mon Mar 06 22:06:09 1995 +0100
@@ -10,16 +10,15 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.4 on 6-mar-1995 at 20:01:51'!
+
View subclass:#VariableVerticalPanel
- instanceVariableNames:'movedHandle prev start
- barHeight barWidth separatingLine
- shadowForm lightForm
- showHandle handlePosition
- handleColor handleStyle noColor
- trackLine redrawLocked'
+ instanceVariableNames:'barHeight barWidth separatingLine
+ shadowForm lightForm showHandle handlePosition handleColor
+ handleStyle noColor trackLine redrawLocked'
classVariableNames:'DefaultShowHandle DefaultHandleStyle DefaultHandlePosition
- DefaultTrackingLine DefaultSeparatingLine DefaultHandleColor
- DefaultCursor'
+ DefaultTrackingLine DefaultSeparatingLine DefaultHandleColor
+ DefaultCursor'
poolDictionaries:''
category:'Views-Layout'
!
@@ -28,7 +27,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libwidg/VariableVerticalPanel.st,v 1.13 1995-02-27 10:41:46 claus Exp $
+$Header: /cvs/stx/stx/libwidg/VariableVerticalPanel.st,v 1.14 1995-03-06 21:06:00 claus Exp $
'!
!VariableVerticalPanel class methodsFor:'documentation'!
@@ -49,7 +48,7 @@
version
"
-$Header: /cvs/stx/stx/libwidg/VariableVerticalPanel.st,v 1.13 1995-02-27 10:41:46 claus Exp $
+$Header: /cvs/stx/stx/libwidg/VariableVerticalPanel.st,v 1.14 1995-03-06 21:06:00 claus Exp $
"
!
@@ -124,12 +123,6 @@
^ Scroller handleShadowFormOn:aDisplay
!
-lightFormOn:aDisplay
- "use same handle as Scroller"
-
- ^ Scroller handleLightFormOn:aDisplay
-!
-
updateStyleCache
DefaultShowHandle := StyleSheet at:'variablePanelShowHandle' default:true.
DefaultHandleStyle := StyleSheet at:'variablePanelHandleStyle'.
@@ -137,178 +130,34 @@
DefaultTrackingLine := StyleSheet at:'variablePanelTrackingLine' default:false.
DefaultSeparatingLine := StyleSheet at:'variablePanelSeparatingLine' default:false.
DefaultHandleColor := StyleSheet colorAt:'variablePanelHandleColor' default:Black.
-! !
-
-!VariableVerticalPanel methodsFor:'initializing'!
-
-initialize
- super initialize.
- noColor := Color noColor.
!
-initStyle
- |mm|
-
- super initStyle.
-
- handleColor := DefaultHandleColor on:device.
-
- showHandle := DefaultShowHandle.
-
- DefaultHandleStyle isNil ifTrue:[
- handleStyle := style
- ] ifFalse:[
- handleStyle := DefaultHandleStyle
- ].
- handleStyle == #next ifTrue:[
- shadowForm := self class shadowFormOn:device.
- lightForm := self class lightFormOn:device.
-
- self barHeight:(shadowForm height + 2).
- barWidth := shadowForm width.
- ] ifFalse:[
- shadowForm := lightForm := nil.
- ].
-
- handlePosition := DefaultHandlePosition.
- trackLine := DefaultTrackingLine.
- separatingLine := DefaultSeparatingLine.
+lightFormOn:aDisplay
+ "use same handle as Scroller"
- mm := device verticalPixelPerMillimeter.
- self is3D ifTrue:[
- self barHeight:(3 * mm) rounded
- ] ifFalse:[
- self barHeight:(2 * mm) rounded
- ].
- barWidth := (2 * mm) rounded. "motif style width"
- handleStyle == #mswindows ifTrue:[
- barWidth := (ArrowButton new direction:#up) width + 1
- ].
-!
-
-initCursor
- "set the cursor - a double arrow"
-
- DefaultCursor notNil ifTrue:[
- cursor := DefaultCursor
- ] ifFalse:[
- cursor := Cursor sourceForm:(Form fromFile:'VVPanel.xbm')
- maskForm:(Form fromFile:'VVPanel_m.xbm')
- hotX:8
- hotY:8.
- "
- if bitmaps are not available, use a standard cursor
- "
- cursor isNil ifTrue:[
- "which one looks better ?"
- cursor := Cursor upDownArrow
- "cursor := Cursor upLimitArrow"
- ].
- DefaultCursor := cursor
- ]
-!
-
-fixSize
- extentChanged ifTrue:[
- super fixSize.
- self resizeSubviewsFrom:1 to:(subViews size)
- ] ifFalse:[
- super fixSize
- ]
+ ^ Scroller handleLightFormOn:aDisplay
! !
-!VariableVerticalPanel methodsFor:'accessing'!
+!VariableVerticalPanel methodsFor:'drawing'!
-add:aView
- "a view is added; make its size relative (if not already done)"
+redrawHandlesFrom:start to:stop
+ "redraw some handles"
-"obsolete" self halt.
-
- super add:aView.
- shown ifTrue:[
- (superView isNil or:[superView shown]) ifTrue:[
- self setupSubviewSizes
+ subViews notNil ifTrue:[
+ showHandle ifTrue:[
+ self handleOriginsFrom:start to:stop do:[:hPoint |
+ self drawHandleAtX:(hPoint x) y:(hPoint y)
+ ].
]
]
!
-removeSubView:aView
- "a view is removed; adjust other subviews sizes"
-
- super removeSubView:aView.
- shown ifTrue:[
- (superView isNil or:[superView shown]) ifTrue:[
- self setupSubviewSizes
- ]
- ]
-!
-
-barHeight:nPixel
- "set the height of the separating bar"
-
- barHeight := nPixel.
-
- "if screen is very low-res, make certain bar is visible and catchable"
- (barHeight < 4) ifTrue:[
- barHeight := 4
- ].
-
- "make it even so spacing is equally spreadable among subviews"
- barHeight odd ifTrue:[
- barHeight := barHeight + 1
- ]
-!
-
-handlePosition:aSymbol
- "define the position of the handle; the argument aSymbol
- may be one of #left, #right or #center"
-
- handlePosition := aSymbol
-!
-
-handlePosition
- "return the position of the handle"
+redraw
+ "redraw all of the handles"
- ^ handlePosition
-!
-
-style:styleSymbol
- "define the style of the handle;
- styleSymbol may be #motif to draw a little knob or
- anything else to draw scrollBars handleForm"
-
- (styleSymbol ~~ handleStyle) ifTrue:[
- handleStyle := styleSymbol.
- handleStyle == #next ifTrue:[
- shadowForm := self class shadowFormOn:device.
- lightForm := self class lightFormOn:device.
- ] ifFalse:[
- shadowForm := lightForm := nil
- ].
-
- shadowForm notNil ifTrue:[
- (self is3D and:[handleStyle ~~ #motif]) ifTrue:[
- self barHeight:(shadowForm height + 2).
- barWidth := shadowForm width
- ]
- ].
- shown ifTrue:[
- self resizeSubviewsFrom:1 to:(subViews size).
- self redraw
- ]
+ redrawLocked ~~ true ifTrue:[
+ self redrawHandlesFrom:1 to:(subViews size)
]
-! !
-
-!VariableVerticalPanel methodsFor:'drawing'!
-
-drawHandleFormAtX:hx y:hy
- "draw a handles bitmap at hx/hy"
-
- self paint:shadowColor.
- self displayForm:shadowForm x:hx y:hy.
- self paint:lightColor.
- self displayForm:lightForm x:hx y:hy.
- self paint:viewBackground
!
drawHandleAtX:hx y:hy
@@ -386,243 +235,250 @@
]
!
-redrawHandlesFrom:start to:stop
- "redraw some handles"
+lockRedraw
+ redrawLocked := true
+!
+
+unlockRedraw
+ redrawLocked := false
+!
+
+invertHandleBarAtX:hx y:hy
+ self noClipByChildren.
+ self xoring:[
+ |y|
+
+ trackLine ifTrue:[
+ y := hy + (barHeight // 2).
+ self displayLineFromX:0 y:y toX:width y:y.
+ ] ifFalse:[
+ self fillRectangleX:0 y:hy width:width height:barHeight
+ ]
+ ].
+ self clipByChildren.
+!
+
+drawHandleFormAtX:hx y:hy
+ "draw a handles bitmap at hx/hy"
+
+ self paint:shadowColor.
+ self displayForm:shadowForm x:hx y:hy.
+ self paint:lightColor.
+ self displayForm:lightForm x:hx y:hy.
+ self paint:viewBackground
+! !
- subViews notNil ifTrue:[
- showHandle ifTrue:[
- self handleOriginsFrom:start to:stop do:[:hPoint |
- self drawHandleAtX:(hPoint x) y:(hPoint y)
- ].
- movedHandle notNil ifTrue:[
- self noClipByChildren.
- self xoring:[
- |y|
+!VariableVerticalPanel methodsFor:'accessing'!
+
+barHeight
+ "return the height of the separating bar"
+
+ ^ barHeight
+!
+
+barHeight:nPixel
+ "set the height of the separating bar"
+
+ barHeight := nPixel.
- trackLine ifTrue:[
- y := prev+(barHeight // 2).
- self displayLineFromX:0 y:y toX:width y:y.
- ] ifFalse:[
- self fillRectangleX:0 y:prev width:width height:barHeight
- ]
- ].
- self clipByChildren
- ]
+ "if screen is very low-res, make certain bar is visible and catchable"
+ (barHeight < 4) ifTrue:[
+ barHeight := 4
+ ].
+
+ "make it even so spacing is equally spreadable among subviews"
+ barHeight odd ifTrue:[
+ barHeight := barHeight + 1
+ ]
+!
+
+add:aView
+ "a view is added; make its size relative (if not already done)"
+
+"obsolete" self halt.
+
+ super add:aView.
+ shown ifTrue:[
+ (superView isNil or:[superView shown]) ifTrue:[
+ self setupSubviewSizes
]
]
!
-redraw
- "redraw all of the handles"
-
- redrawLocked ~~ true ifTrue:[
- self redrawHandlesFrom:1 to:(subViews size)
- ]
-! !
+removeSubView:aView
+ "a view is removed; adjust other subviews sizes"
-!VariableVerticalPanel methodsFor:'event handling'!
-
-sizeChanged:how
- "tell subviews if I change size"
-
+ super removeSubView:aView.
shown ifTrue:[
- (how == #smaller) ifTrue:[
- self resizeSubviewsFrom:1 to:(subViews size)
- ] ifFalse:[
- self resizeSubviewsFrom:(subViews size) to:1
+ (superView isNil or:[superView shown]) ifTrue:[
+ self setupSubviewSizes
]
]
!
-buttonPress:button x:bx y:by
- "button was pressed - if it hits a handle, start move"
+handlePosition:aSymbol
+ "define the position of the handle; the argument aSymbol
+ may be one of #left, #right or #center"
- |handle|
+ handlePosition := aSymbol
+!
- ((button == 1) or:[button == #select]) ifTrue:[
- handle := 1.
- self handleOriginsDo:[:hPoint |
- |hy|
+handlePosition
+ "return the position of the handle"
+
+ ^ handlePosition
+!
+
+style:styleSymbol
+ "define the style of the handle;
+ styleSymbol may be #motif to draw a little knob or
+ anything else to draw scrollBars handleForm"
- hy := hPoint y.
- (by between:hy and:(hy + barHeight)) ifTrue:[
- movedHandle := handle.
- prev := hy.
- start := by - hy.
- self noClipByChildren.
- self xoring:[
- |y|
+ (styleSymbol ~~ handleStyle) ifTrue:[
+ handleStyle := styleSymbol.
+ handleStyle == #next ifTrue:[
+ shadowForm := self class shadowFormOn:device.
+ lightForm := self class lightFormOn:device.
+ ] ifFalse:[
+ shadowForm := lightForm := nil
+ ].
- trackLine ifTrue:[
- y := hy + (barHeight // 2).
- self displayLineFromX:0 y:y toX:width y:y.
- ] ifFalse:[
- self fillRectangleX:0 y:hy width:width height:barHeight
- ]
- ].
- self clipByChildren.
- ^ self
- ].
- handle := handle + 1
+ shadowForm notNil ifTrue:[
+ (self is3D and:[handleStyle ~~ #motif]) ifTrue:[
+ self barHeight:(shadowForm height + 2).
+ barWidth := shadowForm width
+ ]
].
- movedHandle := nil
+ shown ifTrue:[
+ self resizeSubviewsFrom:1 to:(subViews size).
+ self redraw
+ ]
+ ]
+! !
+
+!VariableVerticalPanel methodsFor:'initializing'!
+
+fixSize
+ extentChanged ifTrue:[
+ super fixSize.
+ self resizeSubviewsFrom:1 to:(subViews size)
] ifFalse:[
- super buttonPress:button x:bx y:by
+ super fixSize
]
!
-buttonMotion:button x:bx y:by
- "mouse-button was moved while pressed;
- clear prev handleBar and draw handle bar at new position"
-
- |ypos limitTop limitBot|
-
- movedHandle isNil ifTrue: [^ self]. "should not happen"
+initStyle
+ |mm|
- "speedup - if there is already another movement,
- ignore thisone ... "
+ super initStyle.
- device synchronizeOutput.
- self buttonMotionEventPending ifTrue:[^ self].
+ handleColor := DefaultHandleColor on:device.
- ypos := by - start.
+ showHandle := DefaultShowHandle.
- "
- the two lines below will not allow resizing down to zero
- (so that some is always visible)
- "
-"/ limitTop := barHeight // 2.
-"/ limitBot := self height - barHeight.
-
- "
- these allow resizing to zero - which is better ?
- "
- limitTop := 0.
- limitBot := self innerHeight.
+ DefaultHandleStyle isNil ifTrue:[
+ handleStyle := style
+ ] ifFalse:[
+ handleStyle := DefaultHandleStyle
+ ].
+ handleStyle == #next ifTrue:[
+ shadowForm := self class shadowFormOn:device.
+ lightForm := self class lightFormOn:device.
- movedHandle > 1 ifTrue:[
- limitTop := (subViews at:movedHandle) origin y + (barHeight // 2)
- ].
- movedHandle < (subViews size - 1) ifTrue:[
- limitBot := (subViews at:(movedHandle + 2)) origin y - barHeight
- ].
- limitBot := limitBot - barHeight.
- (ypos < limitTop) ifTrue:[ "check against view limits"
- ypos := limitTop
+ self barHeight:(shadowForm height + 2).
+ barWidth := shadowForm width.
] ifFalse:[
- (ypos > limitBot) ifTrue:[
- ypos := limitBot
- ]
+ shadowForm := lightForm := nil.
].
- self noClipByChildren.
- self xoring:[
- |halfHeight y|
+ handlePosition := DefaultHandlePosition.
+ trackLine := DefaultTrackingLine.
+ separatingLine := DefaultSeparatingLine.
- trackLine ifTrue:[
- halfHeight := barHeight // 2.
- y := prev + halfHeight.
- self displayLineFromX:0 y:y toX:width y:y.
- y := ypos + halfHeight.
- self displayLineFromX:0 y:y toX:width y:y.
- ] ifFalse:[
- self fillRectangleX:0 y:prev width:width height:barHeight.
- self fillRectangleX:0 y:ypos width:width height:barHeight
- ]
+ mm := device verticalPixelPerMillimeter.
+ self is3D ifTrue:[
+ self barHeight:(3 * mm) rounded
+ ] ifFalse:[
+ self barHeight:(2 * mm) rounded
].
- self clipByChildren.
- prev := ypos
+ barWidth := (2 * mm) rounded. "motif style width"
+ handleStyle == #mswindows ifTrue:[
+ barWidth := (ArrowButton new direction:#up) width + 1
+ ].
+!
+
+initialize
+ super initialize.
+ noColor := Color noColor.
!
-buttonRelease:button x:x y:y
- "end bar-move"
-
- |aboveView belowView aboveIndex belowIndex newY oldY|
-
- ((button == 1) or:[button == #select]) ifTrue:[
- movedHandle isNil ifTrue:[^ self].
-
- "undo the last xor"
-
- self noClipByChildren.
- self xoring:[
- |y|
-
- trackLine ifTrue:[
- y := prev + (barHeight // 2).
- self displayLineFromX:0 y:y toX:width y:y.
- ] ifFalse:[
- self fillRectangleX:0 y:prev width:width height:barHeight
- ].
- ].
- self clipByChildren.
-
- "compute the new relative heights"
+initCursor
+ "set the cursor - a double arrow"
- aboveIndex := movedHandle.
- belowIndex := movedHandle + 1.
- movedHandle := nil.
-
- aboveView := subViews at:aboveIndex.
- belowView := subViews at:belowIndex.
-
- oldY := aboveView relativeCorner y.
- newY := (prev + start / height) asFloat.
- aboveView relativeCorner:aboveView relativeCorner x @ newY.
- belowView relativeOrigin:belowView relativeOrigin x @ newY.
+ DefaultCursor notNil ifTrue:[
+ cursor := DefaultCursor
+ ] ifFalse:[
+ cursor := Cursor sourceForm:(Form fromFile:'VVPanel.xbm')
+ maskForm:(Form fromFile:'VVPanel_m.xbm')
+ hotX:8
+ hotY:8.
+ "
+ if bitmaps are not available, use a standard cursor
+ "
+ cursor isNil ifTrue:[
+ "which one looks better ?"
+ cursor := Cursor upDownArrow
+ "cursor := Cursor upLimitArrow"
+ ].
+ DefaultCursor := cursor
+ ]
+!
- redrawLocked := true.
- oldY > newY ifTrue:[
- self resizeSubviewsFrom:aboveIndex to:belowIndex.
- ] ifFalse:[
- self resizeSubviewsFrom:belowIndex to:aboveIndex.
- ].
- redrawLocked := true.
- self redrawHandlesFrom:aboveIndex to:belowIndex.
- redrawLocked := false.
- ] ifFalse:[
- super buttonRelease:button x:x y:y
- ]
+defaultControllerClass
+ ^ VariableVerticalPanelController
+
+
! !
!VariableVerticalPanel methodsFor:'private'!
-anyNonRelativeSubviews
- "return true, if any of my subviews has no relative origin/extent"
-
- 1 to:(subViews size) do:[:index |
- |view|
+handleOriginsDo:aBlock
+ "evaluate the argument block for every handle-origin"
- view := subViews at:index.
- view relativeExtent isNil ifTrue:[^ true].
- view relativeOrigin isNil ifTrue:[^ true]
- ].
- ^ false
+ self handleOriginsFrom:1 to:(subViews size) do:aBlock
!
-setupSubviewSizes
- "setup subviews sizes (in case of non-relative sizes)"
+handleOriginsFrom:start to:stop do:aBlock
+ "evaluate the argument block for some handle-origins"
- |y h|
+ |x hw hDelta|
- self anyNonRelativeSubviews ifTrue:[
- "there is at least one subview without
- relative origin/extent - setup all subviews
- to spread evenly ..."
-
- y := 0.0.
- h := 1.0 / (subViews size).
-
- 1 to:(subViews size) do:[:index |
- |view|
+ subViews notNil ifTrue:[
+ shadowForm notNil ifTrue:[
+ hw := shadowForm width
+ ] ifFalse:[
+ hw := barWidth
+ ].
+ (handleStyle ~~ #normal and:[handleStyle ~~ #mswindows]) ifTrue:[
+ hDelta := barWidth // 2.
+ ] ifFalse:[
+ hDelta := 0
+ ].
+ (handlePosition == #left) ifTrue:[
+ x := hDelta
+ ] ifFalse:[
+ (handlePosition == #right) ifTrue:[
+ x := width - (1 "2" * hw) - margin - hDelta.
+ ] ifFalse:[
+ x := width - barWidth // 2
+ ]
+ ].
+ (start + 1) to:stop do:[:index |
+ |view y|
view := subViews at:index.
- index == subViews size ifTrue:[
- view origin:(0.0 @ y) corner:(1.0 @ 1.0)
- ] ifFalse:[
- view origin:(0.0 @ y) corner:(1.0 @ (y + h))
- ].
- y := y + h
+ y := view origin y - barHeight + 1.
+ aBlock value:(x @ y)
]
]
!
@@ -680,43 +536,57 @@
]
!
-handleOriginsFrom:start to:stop do:aBlock
- "evaluate the argument block for some handle-origins"
+anyNonRelativeSubviews
+ "return true, if any of my subviews has no relative origin/extent"
+
+ 1 to:(subViews size) do:[:index |
+ |view|
- |x hw hDelta|
+ view := subViews at:index.
+ view relativeExtent isNil ifTrue:[^ true].
+ view relativeOrigin isNil ifTrue:[^ true]
+ ].
+ ^ false
+!
- subViews notNil ifTrue:[
- shadowForm notNil ifTrue:[
- hw := shadowForm width
- ] ifFalse:[
- hw := barWidth
- ].
- (handleStyle ~~ #normal and:[handleStyle ~~ #mswindows]) ifTrue:[
- hDelta := barWidth // 2.
- ] ifFalse:[
- hDelta := 0
- ].
- (handlePosition == #left) ifTrue:[
- x := hDelta
- ] ifFalse:[
- (handlePosition == #right) ifTrue:[
- x := width - (1 "2" * hw) - margin - hDelta.
- ] ifFalse:[
- x := width - barWidth // 2
- ]
- ].
- (start + 1) to:stop do:[:index |
- |view y|
+setupSubviewSizes
+ "setup subviews sizes (in case of non-relative sizes)"
+
+ |y h|
+
+ self anyNonRelativeSubviews ifTrue:[
+ "there is at least one subview without
+ relative origin/extent - setup all subviews
+ to spread evenly ..."
+
+ y := 0.0.
+ h := 1.0 / (subViews size).
+
+ 1 to:(subViews size) do:[:index |
+ |view|
view := subViews at:index.
- y := view origin y - barHeight + 1.
- aBlock value:(x @ y)
+ index == subViews size ifTrue:[
+ view origin:(0.0 @ y) corner:(1.0 @ 1.0)
+ ] ifFalse:[
+ view origin:(0.0 @ y) corner:(1.0 @ (y + h))
+ ].
+ y := y + h
]
]
-!
+! !
+
+!VariableVerticalPanel methodsFor:'event handling'!
+
+sizeChanged:how
+ "tell subviews if I change size"
-handleOriginsDo:aBlock
- "evaluate the argument block for every handle-origin"
+ shown ifTrue:[
+ (how == #smaller) ifTrue:[
+ self resizeSubviewsFrom:1 to:(subViews size)
+ ] ifFalse:[
+ self resizeSubviewsFrom:(subViews size) to:1
+ ]
+ ]
+! !
- self handleOriginsFrom:1 to:(subViews size) do:aBlock
-! !