--- 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
- ]
- ]
-
-! !