--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/PullDMenu.st Fri Jul 16 11:44:44 1993 +0200
@@ -0,0 +1,461 @@
+"
+ COPYRIGHT (c) 1989-93 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 activeMenuNumber
+ showSeparatingLines topMargin
+ fgColor bgColor activeFgColor activeBgColor
+ onLevel offLevel'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Menus'
+!
+
+PullDownMenu comment:'
+
+COPYRIGHT (c) 1989-93 by Claus Gittinger
+ All Rights Reserved
+
+%W% %E%
+
+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
+
+written summer 89 by claus
+'!
+
+!PullDownMenu class methodsFor:'instance creation'!
+
+labels:titleArray
+ "create and return a new PullDownMenu"
+
+ ^ self new labels:titleArray
+! !
+
+!PullDownMenu methodsFor:'initialization'!
+
+initialize
+ super initialize.
+
+ font := font on:device.
+ self origin:(0.0 @ 0.0)
+ extent:(1.0 @ (font height + (font descent * 2))).
+!
+
+initStyle
+ super initStyle.
+
+ showSeparatingLines := false.
+ fgColor := Black.
+ bgColor := viewBackground.
+ self is3D ifTrue:[
+ device hasColors ifTrue:[
+ activeFgColor := Color name:'yellow'
+ ] ifFalse:[
+ activeFgColor := White
+ ].
+ device hasGreyscales ifTrue:[
+ activeBgColor := bgColor.
+ ] ifFalse:[
+ activeBgColor := fgColor.
+ ].
+ topMargin := 2
+ ] ifFalse:[
+ activeFgColor := bgColor.
+ activeBgColor := fgColor.
+ topMargin := 0
+ ].
+ onLevel := -1.
+ offLevel := 1
+!
+
+initEvents
+ self enableButtonMotionEvents.
+ self enableButtonEvents
+!
+
+recreate
+ super create.
+ self setMenuOrigins
+!
+
+create
+ super create.
+ self setMenuOrigins
+! !
+
+!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
+!
+
+font:aFont
+ "adjust menu-origins when font changes"
+
+ super font:aFont.
+ 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
+!
+
+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 isMemberOf:SmallInteger) ifTrue:[
+ ^ stringOrNumber
+ ].
+ ^ 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
+ ]
+!
+
+hideActiveMenu
+ activeMenuNumber notNil ifTrue:[
+ (menus at:activeMenuNumber) unrealize.
+ self unHighlightActiveTitle.
+ activeMenuNumber := nil
+ ]
+!
+
+pullMenu:aNumber
+ "activate a menu"
+
+ |subMenu|
+
+ activeMenuNumber notNil ifTrue:[self hideActiveMenu].
+ subMenu := menus at:aNumber.
+ subMenu notNil ifTrue:[
+ activeMenuNumber := aNumber.
+ self highlightActiveTitle.
+ subMenu deselect.
+ subMenu create.
+ subMenu saveUnder:true.
+ subMenu raise show
+ ]
+! !
+
+!PullDownMenu methodsFor:'events'!
+
+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|
+
+ titleIndex := self titleIndexForX:x.
+ titleIndex notNil ifTrue:[
+ self pullMenu:titleIndex
+ ]
+!
+
+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 hideActiveMenu.
+ 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|
+
+ (y >= height) ifTrue:[
+ "release below title-line"
+ 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:[
+ "release in menu"
+ self hideActiveMenu.
+ activeMenu buttonRelease:button
+ x:(x - activeLeft)
+ y:(y - activeTop).
+ ^ self
+ ]
+ ]
+ ].
+ self hideActiveMenu
+! !