"
 COPYRIGHT (c) 1989 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:#PullDownMenu
       instanceVariableNames:'menus titles selectors activeMenuNumber
			      showSeparatingLines topMargin
			      fgColor bgColor activeFgColor activeBgColor
			      onLevel offLevel edgeStyle
			      keepMenu'
       classVariableNames:'DefaultFont
			   DefaultViewBackground 
			   DefaultForegroundColor 
			   DefaultBackgroundColor
			   DefaultHilightForegroundColor 
			   DefaultHilightBackgroundColor
			   DefaultLevel DefaultHilightLevel
			   DefaultShadowColor DefaultLightColor 
			   DefaultEdgeStyle DefaultKeepMenu'
       poolDictionaries:''
       category:'Views-Menus'
!

PullDownMenu comment:'
COPYRIGHT (c) 1989 by Claus Gittinger
	     All Rights Reserved

$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.11 1995-02-22 01:21:31 claus Exp $
'!

!PullDownMenu class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1989 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/PullDownMenu.st,v 1.11 1995-02-22 01:21:31 claus Exp $
"
!

documentation
"
    PullDown menu provides the top (always visible) part of these menus. 
    It controls display of its menus, which become visible when one of the 
    PullDownMenus entries is pressed.

    Instance variables:

    menus                   <aCollection>   the sub menus
    titles                  <aCollection>   the strings in the menu
    activeMenuNumber        <Number>        the index of the currently active menu
    showSeparatingLines     <Boolean>       show separating lines between my menu-strings
    topMargin               <Number>        number of pixels at top
    fgColor                 <Color>         color to draw passive menu-titles
    bgColor                 <Color>         color to draw passive menu-titles
    activeFgColor           <Color>         color to draw activated menu-titles
    activeBgColor           <Color>         color to draw activated menu-titles
    onLevel                 <Integer>       level of entry-buttons when pressed
    offLevel                <Integer>       level of entry-buttons when released
    keepmenu                <Boolean>       if on, pulled menu stays on click,
					    till clicked again (motif & windows behavior)


    StyleSheet values:

    pullDownMenuViewBackground              view background Color
					    default: menuViewBackground

    pullDownMenuForegroundColor             foreground drawing color
					    default: menuForegroundColor

    pullDownMenuBackgroundColor             background drawing color
					    default: menuBackgroundColor

    pullDownMenuHilightForegroundColor      active foreground drawing color
					    default: menuHilightForegroundColor

    pullDownMenuHilightBackgroundColor      active background drawing color
					    default: menuHilightBackgroundColor

    pullDownMenuHilightLevel                level (3D only) when active
					    default: menuHilightLevel

    pullDownMenuEdgeStyle                   edge style (nil or #soft)

    pullDownMenuKeepMenu                    if true, menu stays open until button
					    is pressed again (motif behavior)
					    if false, menu closes on release (default)

    pullDownMenuLevel                       level (3D only)

    pullDownMenuFont                        font
					    default: menuFont
"
! !

!PullDownMenu class methodsFor:'defaults'!

updateStyleCache
    DefaultViewBackground := StyleSheet colorAt:'pullDownMenuViewBackground'.
    DefaultViewBackground isNil ifTrue:[
	DefaultViewBackground := StyleSheet colorAt:'menuViewBackground'.
    ].
    DefaultForegroundColor := StyleSheet colorAt:'pullDownMenuForegroundColor'.
    DefaultForegroundColor isNil ifTrue:[
	DefaultForegroundColor := StyleSheet colorAt:'menuForegroundColor'.
    ].
    DefaultBackgroundColor := StyleSheet colorAt:'pullDownMenuBackgroundColor'.
    DefaultBackgroundColor isNil ifTrue:[
	DefaultViewBackground notNil ifTrue:[
	    DefaultBackgroundColor := DefaultViewBackground
	] ifFalse:[
	    DefaultBackgroundColor := StyleSheet colorAt:'menuBackgroundColor'.
	]
    ].
    DefaultHilightForegroundColor := StyleSheet colorAt:'pullDownMenuHilightForegroundColor'.
    DefaultHilightForegroundColor isNil ifTrue:[
	DefaultHilightForegroundColor := StyleSheet colorAt:'menuHilightForegroundColor'.
    ].
    DefaultHilightBackgroundColor := StyleSheet colorAt:'pullDownMenuHilightBackgroundColor'.
    DefaultHilightBackgroundColor isNil ifTrue:[
	DefaultHilightBackgroundColor := StyleSheet colorAt:'menuHilightBackgroundColor'.
    ].
    DefaultHilightLevel := StyleSheet at:'pullDownMenuHilightLevel'.
    DefaultHilightLevel isNil ifTrue:[
	DefaultHilightLevel := StyleSheet at:'menuHilightLevel' default:0.
    ].
    DefaultEdgeStyle := StyleSheet at:'pullDownMenuEdgeStyle'.
    DefaultKeepMenu := StyleSheet at:'pullDownMenuKeepMenu' default:false.
    DefaultLevel := StyleSheet at:'pullDownMenuLevel' default:1.
    DefaultFont := StyleSheet fontAt:'pullDownMenuFont'.
    DefaultFont isNil ifTrue:[
	DefaultFont := StyleSheet fontAt:'menuFont'.
    ].
! !

!PullDownMenu class methodsFor:'instance creation'!

labels:titleArray
    "create and return a new PullDownMenu"

    ^ self new labels:titleArray
! !

!PullDownMenu methodsFor:'initialize / release'!

initialize
    super initialize.

    font := font on:device.
    self origin:(0.0 @ 0.0)
	 extent:(1.0 @ (font height + (font descent * 2)  + topMargin)).
!

initStyle
    super initStyle.

    showSeparatingLines := false.
    DefaultViewBackground notNil ifTrue:[
	viewBackground := DefaultViewBackground on:device
    ].

    DefaultFont notNil ifTrue:[
	font := DefaultFont on:device
    ].
    DefaultForegroundColor notNil ifTrue:[
	fgColor := DefaultForegroundColor
    ] ifFalse:[
	fgColor := Black.
    ].
    DefaultBackgroundColor notNil ifTrue:[
	bgColor := DefaultBackgroundColor
    ] ifFalse:[
	bgColor := viewBackground.
    ].
    onLevel := DefaultHilightLevel.
    offLevel := DefaultLevel.

    self is3D ifTrue:[
	device hasColors ifTrue:[
	    activeFgColor := Color name:'yellow'
	] ifFalse:[
	    activeFgColor := White
	].
	device hasGreyscales ifTrue:[
	    activeBgColor := bgColor.
	] ifFalse:[
	    activeBgColor := fgColor.
	].
	topMargin := 2.

	((StyleSheet name == #iris) or:[StyleSheet name == #motif]) ifTrue:[
	    self level:2.
	    onLevel := 2.
	    offLevel := 0.
	    activeFgColor := fgColor
	]
    ] ifFalse:[
	activeFgColor := bgColor.
	activeBgColor := fgColor.
	topMargin := 0
    ].

    edgeStyle := DefaultEdgeStyle.
    keepMenu := DefaultKeepMenu.

    DefaultHilightForegroundColor notNil ifTrue:[
	activeFgColor := DefaultHilightForegroundColor
    ].
    DefaultHilightBackgroundColor notNil ifTrue:[
	activeBgColor := DefaultHilightBackgroundColor
    ].
    DefaultShadowColor notNil ifTrue:[
	shadowColor := DefaultShadowColor on:device
    ].
    DefaultLightColor notNil ifTrue:[
	lightColor := DefaultLightColor on:device
    ].

    bgColor := bgColor on:device.
    fgColor := fgColor on:device.
    activeBgColor := activeBgColor on:device.
    activeFgColor := activeFgColor on:device.
!

initEvents
    self enableButtonMotionEvents.
    self enableButtonEvents
!

recreate
    super create.
    self setMenuOrigins
!

create
    super create.
    self setMenuOrigins
!

destroy
    super destroy.
    "
     have to destroy the menus manually here,
     since they are no real subviews of myself
    "
    menus notNil ifTrue:[
	menus do:[:m |
	    m notNil ifTrue:[m destroy]
	].
	menus := nil
    ]
! !

!PullDownMenu methodsFor:'accessing'!

showSeparatingLines:aBoolean
    "turn on/off drawing of separating lines"

    showSeparatingLines := aBoolean.
    shown ifTrue:[
	self redraw
    ]
!

numberOfTitles:n
    "setup blank title-space to be filled in later"

    menus := Array new:n.
    titles := Array new:n
!

labels:titleArray
    "define the menu-titles (group-headers)"

    |numberOfLabels|

    numberOfLabels := titleArray size.
    menus := Array new:numberOfLabels.
    titles := Array new:numberOfLabels.
    1 to:numberOfLabels do:[:index |
	titles at:index put:(titleArray at:index) printString
    ].
    shown ifTrue:[
	self clear.
	self redraw
    ]
!

labels
    "return the menu-titles (group-headers)"

    ^ titles
!

selectors:selectorArray
    "define the menu-selectors. These are used as accesskey only
     in menuAt: accesses. This makes PullDownMenu accesss
     somewhat more compatible to PopUpMenus."

    selectors := selectorArray.
!

font:aFont
    "adjust menu-origins when font changes"

    super font:(aFont on:device).
    self height:(font height + (font descent * 2)).
    self setMenuOrigins
!

menuAt:string
    "return the menu with the title; return nil if not found"

    |index|

    index := self indexOf:string.
    (index == 0) ifTrue:[^ nil].
    ^ menus at:index
!

at:aString putMenu:aMenu
    "set the menu under the title, aString"

    |index|

    index := self indexOf:aString.
    (index == 0) ifTrue:[^ nil].
    aMenu origin:((left + (self titleLenUpTo:index)) 
		  @
		  (height + aMenu borderWidth)).
    aMenu hidden:true.
    menus at:index put:aMenu.
    aMenu masterView:self.
!

at:aString putLabels:labels selectors:selectors args:args receiver:anObject
    "create and set the menu under the title, aString"

    |menuView|

    menuView := MenuView labels:labels
		      selectors:selectors
			   args:args
		       receiver:anObject
			    for:self.
    self at:aString putMenu:menuView
!

at:aString putLabels:labels selector:selector args:args receiver:anObject
    "create and set the menu under the title, aString"

    |menuView|

    menuView := MenuView labels:labels
		       selector:selector
			   args:args
		       receiver:anObject
			    for:self.
    self at:aString putMenu:menuView
!

at:aString putLabels:labels selectors:selectors receiver:anObject
    "create and set the menu under the title, aString"

    |menuView|

    menuView := MenuView labels:labels
		      selectors:selectors
		       receiver:anObject
			    for:self.
    self at:aString putMenu:menuView
! !

!PullDownMenu methodsFor:'private'!

titleLenUpTo:index
    "answer len of all title-strings up-to (but excluding) title-index"

    |len "{ Class: SmallInteger }" |

    (index <= 1) ifTrue:[^ 0].
    len := 0.
    titles from:1 to:(index - 1) do:[:string |
	len := len + (font widthOf:(' ' , string , ' ')).
	showSeparatingLines ifTrue:[
	    self is3D ifTrue:[
		len := len + 2
	    ] ifFalse:[
		len := len + 1
	    ]
	]
    ].
    ^ len
!

indexOf:stringOrNumber
    "return the index of the menu with title; return 0 if not found.
     stringOrNumber may be a number, a selector from the selectorArray
     or a string from the title array."

    |idx|

    stringOrNumber isNumber ifTrue:[
	^ stringOrNumber
    ].
    selectors notNil ifTrue:[
	idx := selectors indexOf:stringOrNumber.
	idx ~~ 0 ifTrue:[^ idx].
    ].
    ^ titles indexOf:stringOrNumber
!

setMenuOrigins
    "adjust origins of menus when font changes"

    |index|

    (font device == device) ifTrue:[
	index := 1.
	menus do:[:aMenu |
	    aMenu notNil ifTrue:[
		aMenu origin:((left + (self titleLenUpTo:index)) 
			      @
			      (height + aMenu borderWidth))
	    ].
	    index := index + 1
	]
    ]
! !

!PullDownMenu methodsFor:'hiding/showing menus'!

drawTitle:string x:x selected:selected
    |yText w|

    yText := ((height - (font height)) // 2) + (font ascent) "+ topMargin".
    w := font widthOf:string.
    selected ifTrue:[
	self paint:activeBgColor
    ] ifFalse:[
	self paint:bgColor
    ].
    self fillRectangleX:x y:0 width:w height:height.

    self is3D ifTrue:[
	self drawEdgesForX:x y:0
		     width:w
		    height:height
		     level:(selected ifTrue:[onLevel] ifFalse:[offLevel])
    ].
    selected ifTrue:[
	self paint:activeFgColor
    ] ifFalse:[
	self paint:fgColor
    ].
    self displayString:string x:x y:yText
!

highlightActiveTitle
    |x string|
    activeMenuNumber notNil ifTrue:[
	x := self titleLenUpTo:activeMenuNumber.
	string := ' ' , (titles at:activeMenuNumber) , ' '.
	self drawTitle:string x:x selected:true
    ]
!

unHighlightActiveTitle
    |x string|
    activeMenuNumber notNil ifTrue:[
	x := self titleLenUpTo:activeMenuNumber.
	string := ' ' , (titles at:activeMenuNumber) , ' '.
	self drawTitle:string x:x selected:false
    ]
!

hideActiveMenuRelease:aBoolean
    activeMenuNumber notNil ifTrue:[
	(menus at:activeMenuNumber) unrealize.
	self unHighlightActiveTitle.
	aBoolean ifTrue:[device ungrabPointer. self cursor:Cursor normal].
	activeMenuNumber := nil
    ]
!

hideActiveMenu
    ^ self hideActiveMenuRelease:true
!

pullMenu:aNumber
    "activate a menu"

    |subMenu|

    activeMenuNumber notNil ifTrue:[self hideActiveMenuRelease:false].
    subMenu := menus at:aNumber.
    subMenu notNil ifTrue:[
	activeMenuNumber := aNumber.
	self highlightActiveTitle.
	subMenu deselect.
	subMenu create.
	subMenu saveUnder:true.
	subMenu raise show
    ]
!

regainControl
    keepMenu ifTrue:[
	device grabPointerInView:self.
	self cursor:Cursor upRightArrow
    ]
! !

!PullDownMenu methodsFor:'event handling'!

redraw
    |string
     x     "{ Class: SmallInteger }"
     y     "{ Class: SmallInteger }"
     index "{ Class: SmallInteger }" |

    shown ifFalse: [ ^ self ].
    titles isNil ifTrue:[^ self].
    x := 0.
    y := height "- 1".
    index := 0.
    titles do:[:title |
	string := ' ' , title , ' '.
	self drawTitle:string x:x selected:(index == activeMenuNumber).
	x := x + (font widthOf:string).
	showSeparatingLines ifTrue:[
	    self is3D ifTrue:[
		self paint:shadowColor.
		self displayLineFromX:x y:0 toX:x y:y.
		x := x + 1.
		self paint:lightColor.
		self displayLineFromX:x y:0 toX:x y:y
	    ] ifFalse:[
		self paint:fgColor.
		self displayLineFromX:x y:0 toX:x y:y
	    ].
	    x := x + 1
	].
	index := index + 1
    ]
!

titleIndexForX:x
    "given a click x-position, return index in title or nil"

    |string 
     xstart "{ Class: SmallInteger }"
     xend   "{ Class: SmallInteger }" |

    xstart := 0.
    1 to:(titles size) do:[:index |
	string := ' ' , (titles at:index) , ' '.
	xend := xstart + (font widthOf:string).
	showSeparatingLines ifTrue:[
	    self is3D ifTrue:[
		xend := xend + 2
	    ] ifFalse:[
		xend := xend + 1
	    ]
	].
	(x between:xstart and:xend) ifTrue:[^ index].
	xstart := xend
    ].
    ^ nil
!

buttonPress:button x:x y:y
    |titleIndex activeMenu activeLeft activeTop|

    (y between:0 and:height) ifTrue:[
	titleIndex := self titleIndexForX:x.
    ].

    "
     now, titleIndex is non-nil if pressed within myself
    "
    (titleIndex notNil and:[titleIndex ~~ activeMenuNumber]) ifTrue:[
	self pullMenu:titleIndex.
	keepMenu ifTrue:[
	    device grabPointerInView:self.
	    self cursor:Cursor upRightArrow
	]
    ] ifFalse:[
	keepMenu ifTrue:[
	    titleIndex == activeMenuNumber ifTrue:[
		"same pressed again ... stay"
		^ self
	    ].
	    "moving around below"
	    activeMenuNumber isNil ifTrue:[^self].
	    activeMenu := menus at:activeMenuNumber.
	    activeLeft := activeMenu left.
	    (x between:activeLeft and:(activeMenu right)) ifTrue:[
		activeTop := activeMenu top.
		(y between:activeTop and:(activeMenu bottom)) ifTrue:[
		    "moving around in menu"
		    activeMenu buttonPress:button
					 x:(x - activeLeft)
					 y:(y - activeTop).
		    ^ self
		]
	    ].
	].
	self hideActiveMenu
    ]
!

buttonMotion:button x:x y:y
    |titleIndex activeMenu activeLeft activeTop|

    (y < height) ifTrue:[
	"moving around in title line"
	activeMenuNumber notNil ifTrue:[
	    (menus at:activeMenuNumber) selection:nil
	].
	titleIndex := self titleIndexForX:x.
	titleIndex notNil ifTrue:[
	    (titleIndex ~~ activeMenuNumber) ifTrue:[
		self pullMenu:titleIndex
	    ]
	]
    ] ifFalse:[
	"moving around below"
	activeMenuNumber isNil ifTrue:[^self].
	activeMenu := menus at:activeMenuNumber.
	activeLeft := activeMenu left.
	(x between:activeLeft and:(activeMenu right)) ifTrue:[
	    activeTop := activeMenu top.
	    (y between:activeTop and:(activeMenu bottom)) ifTrue:[
		"moving around in menu"
		activeMenu buttonMotion:button
				      x:(x - activeLeft)
				      y:(y - activeTop).
		^ self
	    ]
	].
	"moved outside menu"
	activeMenu selection:nil
    ]
!

buttonRelease:button x:x y:y
    |activeMenu activeLeft activeTop hideMenu|

    hideMenu := false.
    (y >= height) ifTrue:[
	"release below title-line"
	activeMenuNumber isNil ifTrue:[^self].
	activeMenu := menus at:activeMenuNumber.
	activeLeft := activeMenu left.
	"
	 released in a submenu ?
	"
	(x between:activeLeft and:(activeMenu right)) ifTrue:[
	    activeTop := activeMenu top.
	    (y between:activeTop and:(activeMenu bottom)) ifTrue:[
		"release in menu"
		self hideActiveMenu.   
		activeMenu buttonRelease:button
				       x:(x - activeLeft)
				       y:(y - activeTop).
		^ self
	    ]
	].
	hideMenu := true.
    ] ifFalse:[
	y < 0 ifTrue:[
	    hideMenu := true
	] ifFalse:[
	    keepMenu ifFalse:[   
		hideMenu := true
	    ]
	]
    ].                  
    hideMenu ifTrue:[
       self hideActiveMenu.
    ]
! !