VariableHorizontalPanel.st
changeset 99 abb8fe62848f
parent 95 7535cfca9509
child 105 3d064ba4a0cc
--- 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
-	]
-    ]
-
-! !