VariableVerticalPanel.st
author claus
Mon, 06 Feb 1995 01:55:07 +0100
changeset 79 6d917a89f7b7
parent 70 14443a9ea4ec
child 95 7535cfca9509
permissions -rw-r--r--
*** empty log message ***

"
 COPYRIGHT (c) 1991 by Claus Gittinger
	      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.
"

View subclass:#VariableVerticalPanel
	 instanceVariableNames:'movedHandle prev start
				barHeight barWidth separatingLine
				shadowForm lightForm
				showHandle handlePosition 
				handleColor handleStyle noColor
				trackLine redrawLocked'
	 classVariableNames:'DefaultShowHandle DefaultHandleStyle DefaultHandlePosition
			     DefaultTrackingLine DefaultSeparatingLine DefaultHandleColor'
	 poolDictionaries:''
	 category:'Views-Layout'
!

VariableVerticalPanel comment:'
COPYRIGHT (c) 1991 by Claus Gittinger
	      All Rights Reserved

$Header: /cvs/stx/stx/libwidg/VariableVerticalPanel.st,v 1.12 1995-02-06 00:54:57 claus Exp $
'!

!VariableVerticalPanel class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1991 by Claus Gittinger
	      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.
"
!

version
"
$Header: /cvs/stx/stx/libwidg/VariableVerticalPanel.st,v 1.12 1995-02-06 00:54:57 claus Exp $
"
!

documentation
"
    a View to separate its subviews vertically by a movable bar;
    the size-ratios of the subviews can be changed by moving this bar.

    The bar-handle is either an exposed knob (style == #motif)
    or the forms defined in Scroller (style ~~ #motif)
    or nothing.

    The subvies dimensions MUST be given as relative sizes;
    typically creation is done as:

	p := VariableVerticalPanel in:superView.
	v1 := <someViewClass> origin:0.0 @ 0.0
			      corner:1.0 @ 0.5
				  in:p.
	v2 := <someViewClass> origin:0.0 @ 0.5 
			      corner:1.0 @ 0.8 
				  in:p.
	v3 := <someViewClass> origin:0.0 @ 0.8 
			      corner:1.0 @ 1.0
				  in:p.

"
!

examples
"
   example:
	|top p v1 v2 v3|

	top := StandardSystemView new.
	top extent:300@300.

	p := VariableVerticalPanel 
		 origin:0.0 @ 0.0
		 corner:1.0 @ 1.0
		 in:top.
	v1 := ScrollableView for:SelectionInListView in:p.
	v1 origin:0.0 @ 0.0 corner:1.0 @ 0.5.
	v1 list:(FileDirectory directoryNamed:'/etc') contents.
	v1 action:[:selNr |
		|fullName stream text|
		fullName := '/etc/' , v1 selectionValue.
		stream := fullName asFilename readStream.
		stream notNil ifTrue:[
		    text := stream contents.
		    v2 contents:text.
		    v3 contents:text
		]
	].

	v2 := TextView 
		 origin:0.0 @ 0.5 corner:1.0 @ 0.8 in:p.

	v3 := ScrollableView 
		 for:TextView 
		 in:p.
	v3 origin:0.0 @ 0.8 corner:1.0 @ 1.0.
	top open
"
! !

!VariableVerticalPanel class methodsFor:'defaults'!

shadowFormOn:aDisplay
    "use same handle as Scroller"

    ^ Scroller handleShadowFormOn:aDisplay
!

lightFormOn:aDisplay
    "use same handle as Scroller"

    ^ Scroller handleLightFormOn:aDisplay
!

updateStyleCache
    DefaultShowHandle := StyleSheet at:'variablePanelShowHandle' default:true.
    DefaultHandleStyle := StyleSheet at:'variablePanelHandleStyle'.
    DefaultHandlePosition := StyleSheet at:'variablePanelHandlePosition' default:#right.
    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.

    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"

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

initEvents
    self enableButtonEvents.
    self enableButtonMotionEvents
!

fixSize 
    extentChanged ifTrue:[
	super fixSize.
	self resizeSubviewsFrom:1 to:(subViews size)
    ] ifFalse:[
	super fixSize
    ]
! !

!VariableVerticalPanel methodsFor:'accessing'!

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

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"

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

!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
    "draw a single handle at hx/hy"

    |h y m|

    shadowForm notNil ifTrue:[
	h := shadowForm height
    ] ifFalse:[
	h := barHeight - 4
    ].

"/    self paint:viewBackground.
"/    self fillRectangleX:margin y:hy 
"/                  width:(width - margin - margin) 
"/                  height:barHeight.

    (handleStyle ~~ #normal and:[handleStyle ~~ #mswindows]) ifTrue:[
	m := (barHeight - h) // 2.
	shadowForm isNil ifTrue:[
	    y := hy + (barHeight // 2).
	    separatingLine ifTrue:[
		self paint:shadowColor.
		self displayLineFromX:margin y:y toX:(width - margin) y:y.
		y := y + 1.
		self paint:lightColor.
		self displayLineFromX:margin y:y toX:(width - margin) y:y.
	    ].
	    self paint:viewBackground.
	    self fillRectangleX:(hx - barWidth) y:hy 
			 width:(barWidth + barWidth) 
			 height:h.

	    y := hy.   
	    handleStyle == #st80 ifTrue:[
		y := y - 1
	    ].
	    self drawEdgesForX:(hx - barWidth)
			     y:(y + m)
			 width:(barWidth + barWidth)
			height:h 
			 level:2.
	    handleStyle == #iris ifTrue:[
		self paint:handleColor.
		self fillDeviceRectangleX:(hx - barWidth + 2)
					y:(y + m + 2)
				    width:(barWidth + barWidth - 4)
				   height:h - 4
	    ]
	] ifFalse:[
	    y := hy.
	    self drawHandleFormAtX:hx y:(y + m)
	].
	handleStyle == #st80 ifTrue:[
	    y := hy - 1.
	    self paint:lightColor.
	    self displayLineFromX:margin y:y toX:(width - margin - margin - 1) y:y.
	    self displayLineFromX:0 y:hy toX:0 y:(hy + barHeight - 1).
	    y := hy + barHeight - 2.
	    self paint:shadowColor.
	    self displayLineFromX:margin y:y toX:(width - margin) y:y.
		"uncomment the -1 if you dont like the notch at the right end"
		"                            VVV"
	    self displayLineFromX:width-1 y:hy" "-1" " toX:width-1 y:(hy + barHeight - 1).
	].
    ] ifFalse:[
	y := hy + barHeight - 1.
	self paint:handleColor.
	separatingLine ifTrue:[
	    self displayLineFromX:0 y:hy+1 toX:width y:hy+1.
	    self displayLineFromX:0 y:y toX:width y:y.
	].
	self fillRectangleX:hx y:hy width:barWidth height:barHeight
    ]
!

redrawHandlesFrom:start to:stop
    "redraw some handles"

    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|

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

redraw
    "redraw all of the handles"

    redrawLocked ~~ true ifTrue:[
	self redrawHandlesFrom:1 to:(subViews size)
    ]
! !

!VariableVerticalPanel methodsFor:'event handling'!

sizeChanged:how
    "tell subviews if I change size"

    shown ifTrue:[
	(how == #smaller) ifTrue:[
	    self resizeSubviewsFrom:1 to:(subViews size)
	] ifFalse:[
	    self resizeSubviewsFrom:(subViews size) to:1
	]
    ]
!

buttonPress:button x:bx y:by
    "button was pressed - if it hits a handle, start move"

    |handle|

    ((button == 1) or:[button == #select]) ifTrue:[
	handle := 1.
	self handleOriginsDo:[:hPoint |
	    |hy|

	    hy := hPoint y.
	    (by between:hy and:(hy + barHeight)) ifTrue:[
		movedHandle := handle.
		prev := hy.
		start := by - 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.
		^ self
	    ].
	    handle := handle + 1
	].
	movedHandle := nil
    ] ifFalse:[
	super buttonPress:button x:bx y:by
    ]
!

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"

    "speedup - if there is already another movement, 
     ignore thisone ... "

    device synchronizeOutput.
    self buttonMotionEventPending ifTrue:[^ self].

    ypos := by - start.

    "
     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.

    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
    ] ifFalse:[
	(ypos > limitBot) ifTrue:[
	    ypos := limitBot
	]
    ].

    self noClipByChildren.
    self xoring:[
	|halfHeight y|

	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
	]
    ].
    self clipByChildren.
    prev := ypos
!

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"

	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.

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

!VariableVerticalPanel methodsFor:'private'!

anyNonRelativeSubviews
    "return true, if any of my subviews has no relative origin/extent"

    1 to:(subViews size) do:[:index |
	|view|

	view := subViews at:index.
	view relativeExtent isNil ifTrue:[^ true].
	view relativeOrigin isNil ifTrue:[^ true]
    ].
    ^ false
!

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

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 relOrg relCorner newOrg newCorner|

	    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 y:(newCorner y - o2)
	    ].

	    relOrg := view relativeOrigin.
	    relOrg isNil ifTrue:[
		self error:'subview must have relative origin'
	    ].
	    newOrg := view originFromRelativeOrigin.
	    newOrg notNil ifTrue:[
		(index ~~ 1) ifTrue:[  
		    newOrg y:(newOrg y + o1)
		].
	    ].
	    view pixelOrigin:newOrg corner:newCorner
	]
    ]
!

handleOriginsFrom:start to:stop do:aBlock
    "evaluate the argument block for some handle-origins"

    |x hw hDelta|

    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.
	    y := view origin y - barHeight + 1.
	    aBlock value:(x @ y)
	]
    ]
!

handleOriginsDo:aBlock
    "evaluate the argument block for every handle-origin"

    self handleOriginsFrom:1 to:(subViews size) do:aBlock
! !