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

SelectionInListView subclass:#MenuView
       instanceVariableNames:'selectors args receiver enableFlags
                              disabledFgColor onOffFlags subMenus
                              subMenuShown'
       classVariableNames:''
       poolDictionaries:''
       category:'Views-Menus'
!

MenuView comment:'

COPYRIGHT (c) 1989-93 by Claus Gittinger
              All Rights Reserved

a menu view used for both pull-down-menus and pop-up-menus
the action to be performed can be defined either as:

1) action:aBlockWithOneArg
   which defines a block to be called with the line number (1..n)
   of the selected line.

2) selectors:selectorArray [args: argarray] receiver:anObject
   which defines the messages to be sent to receiver for each
   line.

It is also possible to define both actionBlock and selectorArray.

%W% %E%

written summer 89 by claus
'!

!MenuView class methodsFor:'initialization'!

initialize
    "setup some defaults - these are usually redefined during startup."

    super initialize.
    DefaultFont := Font family:'helvetica' face:'bold' style:'roman' size:12
! !

!MenuView class methodsFor:'instance creation'!

labels:labels selectors:selArray args:argArray receiver:anObject in:aView
    "create and return a new MenuView in aView
     - receiverObject gets message from selectorArray with argument
       from argArray"

    ^ (self in:aView) labels:labels 
                   selectors:selArray
                        args:argArray
                    receiver:anObject
!

labels:labels selectors:selArray receiver:anObject in:aView
    "create and return a new MenuView in aView
     - receiverObject gets message from selectorArray without argument"

    ^ (self in:aView) labels:labels
                   selectors:selArray
                        args:nil
                    receiver:anObject
!

labels:labels selector:aSelector args:argArray receiver:anObject in:aTopMenu
    "create and return a new MenuView
     - receiverObject gets message aSelector with argument from
       argArray for all entries"

    ^ (self in:aTopMenu) labels:labels
                      selectors:aSelector
                           args:argArray
                       receiver:anObject
!

labels:labels selector:aSelector args:argArray receiver:anObject for:aTopMenu
    "create and return a new MenuView
     - receiverObject gets message aSelector with argument from
       argArray for all entries"

    ^ (self in:(aTopMenu superView)) labels:labels
                                  selectors:aSelector
                                       args:argArray
                                   receiver:anObject
!

labels:labels selectors:selArray args:argArray receiver:anObject for:aTopMenu
    ^ (self in:(aTopMenu superView)) labels:labels
                                  selectors:selArray
                                       args:argArray
                                   receiver:anObject
!

labels:labels selectors:selArray receiver:anObject for:aTopMenu
    ^ (self in:(aTopMenu superView)) labels:labels
                                  selectors:selArray
                                       args:nil
                                   receiver:anObject
! !

!MenuView methodsFor:'initialization'!

initialize
    super initialize.

    disabledFgColor := Color darkGrey.
    self is3D ifTrue:[
        borderWidth := 1.
        self level:1
    ]
!

reinitialize
    "this is called right after snapIn;
     a kind of kludge - reset cursor"

    super reinitialize.
    selection := nil. "self selection:nil."
    self cursor:Cursor hand
!

initEvents
    super initEvents.
    self enableLeaveEvents.
    self enableButtonMotionEvents
!

create
    super create.
    subMenuShown := false.
    self recomputeSize
!

recreate
    super recreate.
    self recomputeSize
! !

!MenuView methodsFor:'accessing'!

labels
    "return the menu-labels"

    ^ list
!

labels:text
    "set the labels to the argument, text"

    (text isKindOf:String) ifTrue:[
        self list:(text asText)
    ] ifFalse:[
        self list:text
    ].
    enableFlags := Array new:(list size).
    enableFlags atAllPut:true.
    self recomputeSize
!

labelAt:indexOrName put:aString
    "change the label at index to be aString"

    |i|

    i := self indexOf:indexOrName.
    list at:i put:aString.
    "create onOff flags, if this label has a check-mark"
    (aString startsWith:'\c') ifTrue:[
        onOffFlags isNil ifTrue:[
            onOffFlags := Array new:(list size)
        ] ifFalse:[
            [onOffFlags size < (list size)] whileTrue:[
                onOffFlags := onOffFlags copyWith:nil
            ]
        ].
        onOffFlags at:i put:false
    ].
    self recomputeSize
!

font:aFont
    "adjust size for new font"

    super font:(aFont on:device).
    self recomputeSize
!

addLabel:aLabel selector:aSelector
    "add another label/selector pair"

    list isNil ifTrue:[
        list := Array with:aLabel
    ] ifFalse:[
        list := list copyWith:aLabel
    ].
    selectors := selectors copyWith:aSelector.
    enableFlags := enableFlags copyWith:true.
    self recomputeSize
!

addLabel:aLabel selector:aSelector arg:anArg
    "add another label/selector/argument trio"

    list isNil ifTrue:[
        list := Array with:aLabel
    ] ifFalse:[
        list := list copyWith:aLabel
    ].
    selectors := selectors copyWith:aSelector.
    args := args copyWith:anArg.
    enableFlags := enableFlags copyWith:true.
    self recomputeSize
!

indexOf:indexOrName
    "return the index of the label named:aName or , if its a symbol
     the index in the selector list"

    (indexOrName isMemberOf:String) ifTrue:[
        ^ list indexOf:indexOrName
    ].
    (indexOrName isMemberOf:Symbol) ifTrue:[
        ^ selectors indexOf:indexOrName
    ].
    ^ indexOrName
!

disable:indexOrName
    "disable an entry"

    |index|

    index := self indexOf:indexOrName.
    index ~~ 0 ifTrue:[
        (enableFlags at:index) ifTrue:[
            enableFlags at:index put:false.
            shown ifTrue:[
                self redrawLine:index
            ]
        ]
    ]
!

enable:indexOrName
    "enable an entry"

    |index|

    index := self indexOf:indexOrName.
    index ~~ 0 ifTrue:[
        (enableFlags at:index) ifFalse:[
            enableFlags at:index put:true.
            shown ifTrue:[
                self redrawLine:index
            ]
        ]
    ]
!

receiver
    "return the receiver of the message"

    ^ receiver
!

selectors
    "return the selector array"

    ^ selectors
!

selectors:anArray
    "set the selector array"

    selectors := anArray
!

selectorAt:indexOrName
    "return an individual selector"

    |i|

    i := self indexOf:indexOrName.
    ^ selectors at:i
!

selectorAt:indexOrName put:aSelector
    "set an individual selector"

    |i|

    i := self indexOf:indexOrName.
    selectors at:i put:aSelector
!

args
    "return the argument array"

    ^ args
!

args:anArray
    "set the argument array"

    args := anArray
!

argsAt:indexOrName put:something
    "set an individual selector"

    args at:(self indexOf:indexOrName) put:something
!

receiver:anObject
    "set the receiver of the message"

    receiver := anObject
!

labels:text selectors:selArray args:argArray receiver:anObject
    "set all relevant stuff"

    self labels:text.
    selectors := selArray.
    args := argArray.
    receiver := anObject
!

checkToggleAt:indexOrName
    "return a check-toggles boolean state"

    |index|

    index := self indexOf:indexOrName.
    onOffFlags isNil ifTrue:[^ false].
    ^ onOffFlags at:index
!

checkToggleAt:indexOrName put:aBoolean
    "set/clear a check-toggle"

    |index|

    onOffFlags isNil ifTrue:[
        onOffFlags := Array new:(list size) withAll:false
    ].
    index := self indexOf:indexOrName.
    onOffFlags at:index put:aBoolean.
    shown ifTrue:[
        self redrawLine:index
    ]
!

subMenuAt:indexOrName
    "return a submenu, or nil"

    subMenus isNil ifTrue:[^ nil].
    ^ subMenus at:(self indexOf:indexOrName)
!

subMenuAt:indexOrName put:aPopUpMenu
    "define a submenu"

    subMenus isNil ifTrue:[
        subMenus := Array new:(list size)
    ].
    subMenus at:(self indexOf:indexOrName) put:aPopUpMenu
! !

!MenuView methodsFor:'private'!

recomputeSize
    |margin2 w h|

    margin2 := margin * 2.
    w := self widthOfContents + leftMargin + leftMargin + margin2.
    h := (self numberOfLines) * fontHeight + (2 * topMargin) + margin2.
    self extent:(w @ h).
    (font device == device) ifTrue:[
        self computeNumberOfLinesShown
    ]
!

setSelectionForX:x y:y
    |newSelection org|

    newSelection := self positionToSelectionX:x y:y.
    newSelection notNil ifTrue:[
        (enableFlags at:newSelection) ifFalse:[
            newSelection := nil
        ] ifTrue:[
            subMenus notNil ifTrue:[
                (subMenus at:newSelection) notNil ifTrue:[
                    org := device translatePoint:(x @ y)
                                            from:(self id)
                                              to:(DisplayRootView new id).
                    subMenuShown := true.
                    (subMenus at:newSelection) showAt:org.
                    "dont select in this case"
                    ^ self
                ]
            ] ifFalse:[
                subMenuShown := false
            ]
        ]
    ].
    self selection:newSelection
! !

!MenuView methodsFor:'showing'!

show
    hidden := false.
    super realize
! !

!MenuView methodsFor:'redrawing'!

drawMarkInVisibleLine:visLineNr with:fg and:bg
    "draw an on-mark"

    |w h y x l check|

    l := self visibleLineToListLine:visLineNr.
    onOffFlags isNil ifTrue:[
        check := false
    ] ifFalse:[
        check := onOffFlags at:l.
    ].

    w := font widthOf:'  '.
    h := font ascent.

    x := (self xOfCol:1 inLine:visLineNr) - leftOffset.
    y := self yOfLine:visLineNr.

    self paint:bg.
    self fillRectangleX:x y:y width:w
                             height:fontHeight.
    self paint:fg.
    check ifTrue:[
        self displayLineFromX:x 
                            y:(y + (h // 2))
                          toX:(x + (w // 3))
                            y:(y + h - 1).

        self displayLineFromX:(x + (w // 3)) 
                            y:(y + h - 1)
                          toX:(x + w - 1)
                            y:y
    ]
!

drawVisibleLine:visLineNr with:fg and:bg
    |line isSpecial special|

    line := self visibleAt:visLineNr.

    isSpecial := false.

    ((line at:1) == $\) ifTrue:[
        special := line at:2.
        (special == $c) ifTrue:[
            isSpecial := true
        ]
    ].
    isSpecial ifFalse:[
        super drawVisibleLine:visLineNr with:fg and:bg
    ] ifTrue:[
        super drawVisibleLine:visLineNr from:3 with:fg and:bg.
        self drawMarkInVisibleLine:visLineNr with:fg and:bg
    ]
!

redrawVisibleLine:visLine col:col
    self redrawVisibleLine:visLine
!

redrawVisibleLine:visLine from:startCol
    self redrawVisibleLine:visLine
!

redrawVisibleLine:visLine from:startCol to:endCol
    self redrawVisibleLine:visLine
!

redrawVisibleLine:visLineNr
    |line lineNr y isSpecial isSeparatingLine mm right|

    line := self visibleAt:visLineNr.

    isSpecial := false.
    (line = '-') ifTrue:[
        isSeparatingLine := true.
        isSpecial := true
    ] ifFalse:[
        (line = '') ifTrue:[
            isSeparatingLine := false.
            isSpecial := true
        ]
    ].
    isSpecial ifFalse:[
        lineNr := self visibleLineToListLine:visLineNr.
        (enableFlags at:lineNr) ifFalse:[
            self drawVisibleLine:visLineNr with:disabledFgColor and:bgColor
        ] ifTrue:[
            super redrawVisibleLine:visLineNr
        ].
        ^ self
    ].

    "handle separating lines"

    y := self yOfLine:visLineNr.
    self is3D ifFalse:[
        self paint:bgColor.
        self fillRectangleX:0 y:y 
                      width:width height:fontHeight
    ].
    isSeparatingLine ifTrue:[
        y := y + (fontHeight // 2).
        self is3D ifFalse:[
            self paint:fgColor.
            self displayLineFromX:0 y:y toX:width y:y
        ] ifTrue:[
            "the inset on each side"
            mm := (device horizontalPixelPerMillimeter * 0.8) rounded.
            right := width - 1 - mm.
            self paint:shadowColor.
            self displayLineFromX:mm y:y toX:right y:y.
            self paint:lightColor.
            y := y + 1.
            self displayLineFromX:mm y:y toX:right y:y
        ]
    ]
!

redrawFromVisibleLine:start to:stop
    "redraw a line range"

    "the natural way to do it is:

    start to:stop do:[:visLine |
        self redrawVisibleLine:visLine
    ]

    but I want to draw the stuff in big chunks for slow machines ..."

    |first current line special index|

    first := start.
    current := start.
    index := self visibleLineToListLine:start.
    index notNil ifTrue:[
        [current <= stop] whileTrue:[
            line := self visibleAt:current.

            special := (line = '-') or:[(line = '') or:[(line at:1) == $\]].
            (special or:[(enableFlags at:index) not]) ifTrue:[
                "a special case"
                (first < current) ifTrue:[
                    super redrawFromVisibleLine:first to:(current - 1)
                ].
                self redrawVisibleLine:current.
                first := current + 1
            ].
            current := current + 1.
            index := index + 1
        ].
        (first < current) ifTrue:[
            super redrawFromVisibleLine:first to:(current - 1)
        ]
    ]
! !

!MenuView methodsFor:'event handling'!

buttonPress:button x:x y:y
    self setSelectionForX:x y:y
!

buttonMotion:state x:x y:y
    self setSelectionForX:x y:y
!

pointerLeave:state
    self setSelectionForX:-1 y:-1. "force deselect"
    subMenuShown ifFalse:[
        self selection:nil
    ]
!

buttonRelease:button x:x y:y
    |theSelector isCheck|

    (x >= 0 and:[x < width]) ifTrue:[
        (y >= 0 and:[y < height]) ifTrue:[
            selection notNil ifTrue:[
                self cursor:Cursor wait.
                actionBlock notNil ifTrue:[
                    actionBlock value:(self selection)
                ].
                selectors notNil ifTrue: [
                    (selectors isKindOf:Symbol) ifFalse:[
                        selection <= (selectors size) ifTrue:[
                            theSelector := selectors at:selection
                        ]
                    ] ifTrue:[
                        theSelector := selectors
                    ].
                    theSelector notNil ifTrue:[
                        isCheck := false.
                        onOffFlags notNil ifTrue:[
                            onOffFlags size >= selection ifTrue:[
                                isCheck := (onOffFlags at:selection) notNil
                            ]
                        ].
                        isCheck ifTrue:[
                            onOffFlags at:selection
                                      put:(onOffFlags at:selection) not.
                            self redrawLine:selection.
                            receiver perform:theSelector
                                        with:(onOffFlags at:selection)
                        ] ifFalse:[
                            args isNil ifTrue:[
                                receiver perform:theSelector
                            ] ifFalse:[
                                receiver perform:theSelector
                                            with:(args at:selection)
                            ]
                        ]
                    ]
                ].
                self cursor:Cursor hand
            ]
        ]
    ]
! !