"

 COPYRIGHT (c) 1997 by eXept Software AG

              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.

"

SimpleView subclass:#MenuPanel

	instanceVariableNames:'adornment shadowView mapTime mustRearrange superMenu

		shortKeyInset selection items groupSizes receiver enableChannel

		menuHolder enabled onLevel offLevel fgColor activeFgColor

		lastActiveMenu activeBgColor disabledFgColor groupDividerSize

		itemSpace fitFirstPanel rightArrow rightArrowShadow

		selectionFrameBrightColor selectionFrameDarkColor

		buttonLightColor buttonShadowColor buttonHalfLightColor

		buttonHalfShadowColor lastButtonSelected'

	classVariableNames:'InitialSelectionQuerySignal DefaultAdornment

		DefaultGroupDividerSize DefaultHilightLevel DefaultLevel

		DefaultItemSpace DefaultForegroundColor DefaultBackgroundColor

		DefaultHilightForegroundColor DefaultHilightBackgroundColor

		DefaultDisabledForegroundColor DefaultFitFirstPanel

		RightArrowForm RightArrowShadowForm SelectionFrameBrightColor

		SelectionFrameDarkColor ButtonActiveLevel ButtonPassiveLevel

		ButtonActiveBackgroundColor ButtonPassiveBackgroundColor

		ButtonLightColor ButtonShadowColor ButtonHalfLightColor

		ButtonHalfShadowColor ButtonEdgeStyle Images LigthenedImages'

	poolDictionaries:''

	category:'Views-Menus'

!

Object subclass:#Item

	instanceVariableNames:'layout menuPanel subMenu adornment rawLabel disabledRawLabel

		enableChannel nameKey accessCharacterPosition value label

		rawImage activeHelpKey submenuChannel startGroup isButton

		isVisible'

	classVariableNames:'HorizontalInset VerticalInset HorizontalButtonInset

		VerticalButtonInset LabelRightOffset ShortcutKeyOffset

		IndicatorOn IndicatorOff'

	poolDictionaries:''

	privateIn:MenuPanel

!

Object subclass:#Adornment

	instanceVariableNames:'indication accessCharacterPosition shortcutKey argument'

	classVariableNames:''

	poolDictionaries:''

	privateIn:MenuPanel::Item

!

!MenuPanel class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1997 by eXept Software AG

              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.

"

!

documentation

"

    a menu panel used for both pull-down-menus and pop-up-menus.

    not yet finished MenuPanel class - this will eventually replace

    most of the MenuView and PopUpMenu stuff.

    (and hopefully be ST-80 compatible ...)

    To create a menu, there exists a MenuEditor which will generate

    a menu specification.

    [author:]

        Claus Atzkern

    [see also:]

        Menu

        MenuItem

        MenuEditor

"

!

examples

"

    start as PullDownMenu

                                                                                [exBegin]

    |top subView mview desc s1 s2 s3 img lbs labels|

    top := StandardSystemView new.

    mview := MenuPanel in:top.

    labels := #( 'foo' 'bar' 'baz' 'test' 'claus' ).

    mview level:2.

    mview verticalLayout:false.

    img := Image fromFile:'bitmaps/SBrowser.xbm'.

    lbs := Array with:'foo' with:'bar' with:img with:'baz' with:'test' with:'ludwig'.

    mview labels:lbs.

    mview shortcutKeyAt:2 put:#Cut.

    mview accessCharacterPositionAt:1 put:1.

    mview accessCharacterPositionAt:2 put:2.

    mview enabledAt:5 put:false.

    mview groupSizes:#( 2 2 ).

    s1 := MenuPanel labels:labels.

    s1 accessCharacterPositionAt:1 put:1.

    s1 accessCharacterPositionAt:2 put:2.

    s1 groupSizes:#( 2 2 ).

    s2 := MenuPanel labels:#( '1' nil '2' '-' '3' '=' '4' ' ' '5' ).

    s3 := MenuPanel labels:lbs.

    s1 subMenuAt:2 put:s2.

    s1 subMenuAt:3 put:(MenuPanel labels:lbs).

    s2 subMenuAt:3 put:s3.

    s3 subMenuAt:3 put:(MenuPanel labels:labels).

    s3 shortcutKeyAt:3 put:$q.

    mview subMenuAt:1 put:s1.

    mview subMenuAt:4 put:(MenuPanel labels:lbs).

    (mview subMenuAt:4) shortcutKeyAt:3 put:#Copy.

    s1 shortcutKeyAt:1 put:#Copy.

    s1 shortcutKeyAt:3 put:#Paste.

    mview subMenuAt:2 put:(MenuPanel labels:labels).

    top extent:(mview preferredExtent).

    top open.

                                                                                [exEnd]

    start as PopUpMenu

                                                                                [exBegin]

    |subView mview desc s1 s2 s3 img lbs labels|

    mview := MenuPanel new.

    labels := #( 'foo' 'bar' 'baz' ).

    mview level:2.

    img := Image fromFile:'bitmaps/SBrowser.xbm'.

    lbs := Array with:'foo' with:'bar' with:img with:'baz' with:'test'.

    mview labels:lbs.

    s1 := MenuPanel labels:labels.

    s2 := MenuPanel labels:#( '1' nil '2' '-' '3' '=' '4' ' ' '5' ).

    s3 := MenuPanel labels:lbs.

    s1 subMenuAt:2 put:s2.

    s1 subMenuAt:3 put:(MenuPanel labels:lbs).

    s2 subMenuAt:3 put:s3.

    s3 subMenuAt:3 put:(MenuPanel labels:labels).

    s3 shortcutKeyAt:3 put:$q.

    mview subMenuAt:1 put:s1.

    mview subMenuAt:4 put:(MenuPanel labels:lbs).

    (mview subMenuAt:4) shortcutKeyAt:3 put:#Copy.

    s1 shortcutKeyAt:1 put:#Copy.

    s1 shortcutKeyAt:3 put:#Paste.

    mview subMenuAt:2 put:(MenuPanel labels:labels).

    mview startUp

                                                                                [exEnd]

    start from menu spec

                                                                                [exBegin]

    |menu|

    menu := MenuPanel menu:

        #(#Menu #( #(#MenuItem 

                    #label: 'File' 

                    #submenu:

                      #(#Menu #(#(#MenuItem #label: 'quit' #value:#quit )     

                                 (#MenuItem 

                                    #label: 'edit' 

                                    #submenu:

                                      #(#Menu #( #(#MenuItem #label: 'edit'  #value:#edit )     

                                                 #(#MenuItem #label: 'close' #value:#close)     

                                               )

                                               nil

                                               nil

                                       )     

                                  )

                                 #(#MenuItem #label: 'help' #value:#help )     

                               )

                               nil

                               nil

                       )     

                 ) 

                #(#MenuItem #label: 'Inspect' #value:#inspectMenu ) 

                #(#MenuItem #label: 'Bar' 

                            #submenu:

                               #(#Menu #( #(#MenuItem #label: 'bar 1' #value:#bar1 )     

                                          #(#MenuItem #label: 'bar 2' #value:#bar2 )     

                                        )

                                        nil

                                        nil

                                )     

                 ) 

              ) 

              #( 2 )

              nil

         ) decodeAsLiteralArray.  

    menu verticalLayout:false.

    Transcript showCR:(menu startUp).

                                                                                [exEnd]

"

! !

!MenuPanel class methodsFor:'instance creation'!

fromSpec:aSpec

    ^ self fromSpec:aSpec receiver:nil

!

fromSpec:aSpec receiver:aReceiver

    |menu|

    aSpec notNil ifTrue:[

        menu := Menu new.

        menu fromLiteralArrayEncoding:aSpec.

    ].

  ^ self menu:menu receiver:aReceiver

!

labels:labels

    ^ self labels:labels nameKeys:nil receiver:nil

!

labels:labels nameKeys:nameKeys

    ^ self labels:labels nameKeys:nameKeys receiver:nil

!

labels:labels nameKeys:nameKeys receiver:aReceiver

    |mview|

    mview := self menu:nil receiver:aReceiver.

    mview labels:labels.

    mview nameKeys:nameKeys.

  ^ mview

!

labels:labels receiver:aReceiver

    ^ self labels:labels nameKeys:nil receiver:aReceiver

!

menu:aMenu

    ^ self menu:aMenu receiver:nil

!

menu:aMenu receiver:aReceiver

    |mview|

    mview := self new.

    mview menu:aMenu.

"/ a menu itself may contain a receiver

"/ thus we do not overwrite the receiver

    aReceiver notNil ifTrue:[

        mview receiver:aReceiver

    ].

  ^ mview

! !

!MenuPanel class methodsFor:'class initialization'!

initialize

    "

    DefaultAdornment := nil.

    self initialize

    "

    InitialSelectionQuerySignal isNil ifTrue:[

        InitialSelectionQuerySignal := QuerySignal new.

    ].

    DefaultAdornment isNil ifTrue:[

        DefaultAdornment := IdentityDictionary new

            at:#showSeparatingLines put:false;

            at:#showGroupDivider    put:true;

            at:#verticalLayout      put:true;

            at:#item                put:nil;

            at:#value               put:nil;

            yourself

    ].

    "Modified: / 15.1.1998 / 23:08:31 / stefan"

!

preSnapshot

    "remove all resources

    "

    Images := nil.

    LigthenedImages := nil.

! !

!MenuPanel class methodsFor:'defaults'!

updateStyleCache

    |menuStyle style font|

    menuStyle := MenuView styleSheet.

    menuStyle isNil ifTrue:[

        "make sure that style sheet is present"

        MenuView updateStyleCache.        

        menuStyle := MenuView styleSheet.

    ].

    style := menuStyle name.

    DefaultForegroundColor := menuStyle colorAt:'pullDownMenu.foregroundColor'.

    DefaultForegroundColor isNil ifTrue:[

        DefaultForegroundColor := menuStyle colorAt:'menu.foregroundColor'

                                            default:Color black.

    ].

    (style == #motif or:[style == #iris]) ifTrue:[

        DefaultBackgroundColor        := DefaultViewBackgroundColor.

        DefaultHilightForegroundColor := DefaultForegroundColor.

        DefaultHilightLevel     := 2.

        DefaultLevel            := 0.

    ] ifFalse:[

        (DefaultHilightLevel := menuStyle at:'pullDownMenu.hilightLevel') isNil ifTrue:[

            DefaultHilightLevel := menuStyle at:'menu.hilightLevel' default:0.

        ].

        DefaultLevel           := menuStyle at:'pullDownMenu.level' default:1.

        DefaultBackgroundColor := menuStyle colorAt:'pullDownMenu.backgroundColor'.

        DefaultBackgroundColor isNil ifTrue:[

            DefaultBackgroundColor := menuStyle colorAt:'menu.backgroundColor'

                                                default:DefaultViewBackgroundColor.

        ].

        DefaultHilightForegroundColor := menuStyle colorAt:'pullDownMenu.hilightForegroundColor'.

        DefaultHilightForegroundColor isNil ifTrue:[

            DefaultHilightForegroundColor := menuStyle colorAt:'menu.hilightForegroundColor'

                                                       default:DefaultBackgroundColor

        ].

    ].

    DefaultDisabledForegroundColor := menuStyle colorAt:'menu.disabledForegroundColor'.

    DefaultDisabledForegroundColor isNil ifTrue:[

        DefaultDisabledForegroundColor := menuStyle colorAt:'button.disabledForegroundColor'

                                                    default:Color darkGray.

    ].

    style == #motif ifTrue:[

        DefaultHilightBackgroundColor := DefaultBackgroundColor

    ] ifFalse:[

        DefaultHilightBackgroundColor := menuStyle colorAt:'pullDownMenu.hilightBackgroundColor'.

        DefaultHilightBackgroundColor isNil ifTrue:[

            DefaultHilightBackgroundColor := menuStyle colorAt:'menu.hilightBackgroundColor'

                                                       default:DefaultBackgroundColor.

        ]

    ].

    DefaultGroupDividerSize := menuStyle at:'menu.groupDividerSize' default:6.

    DefaultItemSpace        := menuStyle at:'menu.itemSpace' default:0.

    DefaultFitFirstPanel    := menuStyle at:'menu.fitFirstPanel' default:true.

    MenuView updateStyleCache.

    DefaultFont := MenuView defaultFont.

"/    font := menuStyle fontAt:'pullDownMenu.font'.

"/    font isNil ifTrue:[font := menuStyle fontAt:'menu.font'].

"/    DefaultFont := font.

    RightArrowForm := SelectionInListView rightArrowFormOn:Display.

    style ~~ #os2 ifTrue:[

        RightArrowShadowForm := SelectionInListView rightArrowShadowFormOn:Display.

    ] ifFalse:[

        RightArrowShadowForm := nil

    ].

    SelectionFrameBrightColor    := Color white.

    SelectionFrameDarkColor      := Color black.

    ButtonActiveLevel            :=  menuStyle at:'button.activeLevel' default: -2.

    ButtonPassiveLevel           :=  menuStyle at:'button.passiveLevel' default: 2.

    ButtonActiveBackgroundColor  :=  menuStyle at:'button.activeBackgroundColor' default: DefaultBackgroundColor.

    ButtonPassiveBackgroundColor := (menuStyle at:'button.backgroundColor') ? (menuStyle at:'viewBackground') ? DefaultBackgroundColor.

    ButtonLightColor             := (menuStyle at:'button.lightColor') ? Color white.

    ButtonShadowColor            := (menuStyle at:'button.shadowColor') ? Color gray.

    ButtonHalfLightColor         :=  menuStyle at:'button.halfLightColor'.

    ButtonHalfShadowColor        :=  menuStyle at:'button.halfShadowColor'.

    ButtonEdgeStyle              :=  menuStyle at:'button.edgeStyle'.

    Item updateStyleCache

! !

!MenuPanel class methodsFor:'image registration'!

image:anImage onDevice:aDevice

"

Images := nil

"

    |device image|

    Images isNil ifTrue:[ Images := IdentityDictionary new ].

    (device := Images at:aDevice ifAbsent:nil) isNil ifTrue:[

        Images at:aDevice put:(device := Dictionary new)

    ].

    (image := device at:anImage ifAbsent:nil) notNil ifTrue:[

        ^ image

    ].

    image := anImage copy onDevice:aDevice.

    image clearMaskedPixels.

    device at:anImage put:image.

    ^ image

    "Modified: / 27.2.1998 / 17:41:37 / cg"

!

lightenedImage:anImage onDevice:aDevice

"

LigthenedImages := nil

"

    |device image|

    LigthenedImages isNil ifTrue:[ LigthenedImages := IdentityDictionary new ].

    (device := LigthenedImages at:aDevice ifAbsent:nil) isNil ifTrue:[

        LigthenedImages at:aDevice put:(device := Dictionary new)

    ].

    (image := device at:anImage ifAbsent:nil) notNil ifTrue:[

        ^ image

    ].

    ((anImage respondsTo:#colorMap) and:[anImage colorMap notNil]) ifTrue:[

        image := anImage copy lightened onDevice:aDevice.

        image clearMaskedPixels.

    ] ifFalse:[

        image := self image:anImage onDevice:aDevice

    ].

    device at:anImage put:image.

    ^ image

! !

!MenuPanel class methodsFor:'private'!

subMenu:aSubMenu

    "create a submenu; can be redifined in derived classes

    "

  ^ (MenuPanel new) menu:aSubMenu.

! !

!MenuPanel class methodsFor:'resources'!

checkedImage

    "ImageEditor openOnClass:self andSelector:#checkedImage"

    <resource: #image>

    ^(Depth2Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(#[255 255 255 255 234 170 170 169 229 85 85 85 228 21 85 5 228 5 84 5 229 1 80 21 229 64 64 85 229 80 1 85 229 84 5 85 229 80 1 85 229 64 64 85 229 1 80 21 228 5 84 5 228 21 85 5 229 85 85 85 213 85 85 85]) ; colorMap:(((Array new:4) at:1 put:((Color black)); at:2 put:((Color white)); at:3 put:((Color grey:49.9962)); at:4 put:((Color grey:66.9978)); yourself)); yourself!

uncheckedImage

    "ImageEditor openOnClass:self andSelector:#uncheckedImage"

    <resource: #image>

    ^(Depth2Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#(2 )); samplesPerPixel:(1); bits:(#[170 170 170 170 149 85 85 84 144 0 0 0 144 0 0 0 144 0 0 0 144 0 0 0 144 0 0 0 144 0 0 0 144 0 0 0 144 0 0 0 144 0 0 0 144 0 0 0 144 0 0 0 144 0 0 0 144 0 0 0 128 0 0 0]) ; colorMap:((OrderedCollection new add:(Color white); add:(Color grey:49.9977); add:(Color grey:66.9978); add:(Color black); yourself)); yourself! !

!MenuPanel methodsFor:'accept'!

accept

    "accept current selected item

    "

    ^ self accept:(self selection)

!

accept:anItem

    "this is the topMenu: accept item

    "

    |value item tgState itemIdx recv|

    self superMenu notNil ifTrue:[

        ^ self topMenu accept:anItem

    ].