PullDownMenu.st
author claus
Mon, 10 Oct 1994 04:03:47 +0100
changeset 59 450ce95a72a4
parent 38 4b9b70b2cc87
child 60 f3c738c24ce6
permissions -rw-r--r--
*** empty log message ***
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     1
"
5
claus
parents: 3
diff changeset
     2
 COPYRIGHT (c) 1989 by Claus Gittinger
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
     3
	      All Rights Reserved
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     4
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    11
"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    12
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    13
View subclass:#PullDownMenu
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    14
       instanceVariableNames:'menus titles activeMenuNumber
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    15
			      showSeparatingLines topMargin
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    16
			      fgColor bgColor activeFgColor activeBgColor
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    17
			      onLevel offLevel
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    18
			      keepMenu'
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    19
       classVariableNames:'DefaultFont
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    20
			   DefaultViewBackground 
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    21
			   DefaultForegroundColor 
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    22
			   DefaultBackgroundColor
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    23
			   DefaultHilightForegroundColor 
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    24
			   DefaultHilightBackgroundColor
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    25
			   DefaultLevel DefaultHilightLevel
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    26
			   DefaultShadowColor DefaultLightColor'
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    27
       poolDictionaries:''
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    28
       category:'Views-Menus'
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    29
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    30
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    31
PullDownMenu comment:'
5
claus
parents: 3
diff changeset
    32
COPYRIGHT (c) 1989 by Claus Gittinger
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    33
	     All Rights Reserved
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    34
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    35
$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.6 1994-10-10 03:02:41 claus Exp $
3
claus
parents: 0
diff changeset
    36
'!
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    37
3
claus
parents: 0
diff changeset
    38
!PullDownMenu class methodsFor:'documentation'!
claus
parents: 0
diff changeset
    39
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    40
copyright
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    41
"
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    42
 COPYRIGHT (c) 1989 by Claus Gittinger
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    43
	      All Rights Reserved
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    44
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    45
 This software is furnished under a license and may be used
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    46
 only in accordance with the terms of that license and with the
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    47
 inclusion of the above copyright notice.   This software may not
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    48
 be provided or otherwise made available to, or used by, any
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    49
 other person.  No title to or ownership of the software is
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    50
 hereby transferred.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    51
"
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    52
!
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    53
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    54
version
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    55
"
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    56
$Header: /cvs/stx/stx/libwidg/PullDownMenu.st,v 1.6 1994-10-10 03:02:41 claus Exp $
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    57
"
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    58
!
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    59
3
claus
parents: 0
diff changeset
    60
documentation
claus
parents: 0
diff changeset
    61
"
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    62
    PullDown menu provides the top (always visible) part of these menus. 
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    63
    It controls display of its menus, which become visible when one of the 
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    64
    PullDownMenus entries is pressed.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    65
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    66
    Instance variables:
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    67
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    68
    menus                   <aCollection>   the sub menus
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    69
    titles                  <aCollection>   the strings in the menu
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    70
    activeMenuNumber        <Number>        the index of the currently active menu
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    71
    showSeparatingLines     <Boolean>       show separating lines between my menu-strings
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    72
    topMargin               <Number>        number of pixels at top
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    73
    fgColor                 <Color>         color to draw passive menu-titles
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    74
    bgColor                 <Color>         color to draw passive menu-titles
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    75
    activeFgColor           <Color>         color to draw activated menu-titles
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    76
    activeBgColor           <Color>         color to draw activated menu-titles
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    77
    onLevel                 <Integer>       level of entry-buttons when pressed
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    78
    offLevel                <Integer>       level of entry-buttons when released
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
    79
    keepmenu                <Boolean>       if on, pulled menu stays on click,
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    80
					    till clicked again (motif & windows behavior)
3
claus
parents: 0
diff changeset
    81
"
claus
parents: 0
diff changeset
    82
! !
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    83
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    84
!PullDownMenu class methodsFor:'defaults'!
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    85
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    86
updateStyleCache
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    87
    DefaultViewBackground := StyleSheet at:'pullDownMenuViewBackground'.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    88
    DefaultForegroundColor := StyleSheet at:'pullDownMenuForegroundColor' default:Black.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    89
    DefaultBackgroundColor := StyleSheet at:'pullDownMenuBackgroundColor'.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    90
    DefaultHilightForegroundColor := StyleSheet at:'pullDownMenuHilightForegroundColor'.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    91
    DefaultHilightBackgroundColor := StyleSheet at:'pullDownMenuHilightBackgroundColor'.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    92
    DefaultHilightLevel := StyleSheet at:'pullDownMenuHilightLevel' default:-1.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    93
    DefaultLevel := StyleSheet at:'pullDownMenuLevel' default:1.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    94
    DefaultFont := StyleSheet at:'pullDownMenuFont'.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    95
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    96
    DefaultForegroundColor notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    97
	DefaultForegroundColor := DefaultForegroundColor on:Display
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    98
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
    99
    DefaultBackgroundColor notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   100
	DefaultBackgroundColor := DefaultBackgroundColor on:Display
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   101
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   102
    DefaultShadowColor notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   103
	DefaultShadowColor := DefaultShadowColor on:Display
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   104
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   105
    DefaultLightColor notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   106
	DefaultLightColor := DefaultLightColor on:Display
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   107
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   108
    DefaultHilightForegroundColor notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   109
	DefaultHilightForegroundColor := DefaultHilightForegroundColor on:Display
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   110
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   111
    DefaultHilightBackgroundColor notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   112
	DefaultHilightBackgroundColor := DefaultHilightBackgroundColor on:Display
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   113
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   114
    DefaultFont notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   115
	DefaultFont := DefaultFont on:Display
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   116
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   117
! !
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   118
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   119
!PullDownMenu class methodsFor:'instance creation'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   120
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   121
labels:titleArray
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   122
    "create and return a new PullDownMenu"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   123
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   124
    ^ self new labels:titleArray
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   125
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   126
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   127
!PullDownMenu methodsFor:'initialization'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   128
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   129
initialize
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   130
    super initialize.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   131
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   132
    font := font on:device.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   133
    self origin:(0.0 @ 0.0)
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   134
	 extent:(1.0 @ (font height + (font descent * 2)  + topMargin)).
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   135
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   136
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   137
initStyle
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   138
    super initStyle.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   139
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   140
    showSeparatingLines := false.
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   141
    DefaultViewBackground notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   142
	viewBackground := DefaultViewBackground
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   143
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   144
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   145
    DefaultForegroundColor notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   146
	fgColor := DefaultForegroundColor
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   147
    ] ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   148
	fgColor := Black.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   149
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   150
    DefaultBackgroundColor notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   151
	bgColor := DefaultBackgroundColor
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   152
    ] ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   153
	bgColor := viewBackground.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   154
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   155
    onLevel := DefaultHilightLevel.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   156
    offLevel := DefaultLevel.
21
9ef599238fea *** empty log message ***
claus
parents: 5
diff changeset
   157
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   158
    self is3D ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   159
	device hasColors ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   160
	    activeFgColor := Color name:'yellow'
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   161
	] ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   162
	    activeFgColor := White
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   163
	].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   164
	device hasGreyscales ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   165
	    activeBgColor := bgColor.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   166
	] ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   167
	    activeBgColor := fgColor.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   168
	].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   169
	topMargin := 2.
21
9ef599238fea *** empty log message ***
claus
parents: 5
diff changeset
   170
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   171
	((style == #iris) or:[style == #motif]) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   172
	    self level:2.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   173
	    softEdge := true.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   174
	    onLevel := 2.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   175
	    offLevel := 0.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   176
	    activeFgColor := fgColor
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   177
	]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   178
    ] ifFalse:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   179
	activeFgColor := bgColor.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   180
	activeBgColor := fgColor.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   181
	topMargin := 0
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   182
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   183
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   184
    DefaultHilightForegroundColor notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   185
	activeFgColor := DefaultHilightForegroundColor
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   186
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   187
    DefaultHilightBackgroundColor notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   188
	activeBgColor := DefaultHilightBackgroundColor
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   189
    ].
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   190
    DefaultShadowColor notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   191
	shadowColor := DefaultShadowColor on:device
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   192
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   193
    DefaultLightColor notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   194
	lightColor := DefaultLightColor on:device
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   195
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   196
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   197
    bgColor := bgColor on:device.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   198
    fgColor := fgColor on:device.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   199
    activeBgColor := activeBgColor on:device.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   200
    activeFgColor := activeFgColor on:device.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   201
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   202
    keepMenu := (style == #motif) or:[(style == #iris) or:[style == #mswindows]].
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   203
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   204
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   205
initEvents
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   206
    self enableButtonMotionEvents.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   207
    self enableButtonEvents
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   208
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   209
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   210
recreate
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   211
    super create.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   212
    self setMenuOrigins
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   213
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   214
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   215
create
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   216
    super create.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   217
    self setMenuOrigins
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   218
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   219
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   220
!PullDownMenu methodsFor:'accessing'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   221
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   222
showSeparatingLines:aBoolean
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   223
    "turn on/off drawing of separating lines"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   224
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   225
    showSeparatingLines := aBoolean.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   226
    shown ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   227
	self redraw
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   228
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   229
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   230
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   231
numberOfTitles:n
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   232
    "setup blank title-space to be filled in later"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   233
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   234
    menus := Array new:n.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   235
    titles := Array new:n
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   236
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   237
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   238
labels:titleArray
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   239
    "define the menu-titles (group-headers)"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   240
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   241
    |numberOfLabels|
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   242
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   243
    numberOfLabels := titleArray size.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   244
    menus := Array new:numberOfLabels.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   245
    titles := Array new:numberOfLabels.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   246
    1 to:numberOfLabels do:[:index |
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   247
	titles at:index put:(titleArray at:index) printString
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   248
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   249
    shown ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   250
	self clear.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   251
	self redraw
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   252
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   253
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   254
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   255
labels
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   256
    "return the menu-titles (group-headers)"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   257
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   258
    ^ titles
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   259
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   260
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   261
font:aFont
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   262
    "adjust menu-origins when font changes"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   263
3
claus
parents: 0
diff changeset
   264
    super font:(aFont on:device).
claus
parents: 0
diff changeset
   265
    self height:(font height + (font descent * 2)).
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   266
    self setMenuOrigins
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   267
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   268
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   269
menuAt:string
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   270
    "return the menu with the title; return nil if not found"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   271
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   272
    |index|
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   273
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   274
    index := self indexOf:string.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   275
    (index == 0) ifTrue:[^ nil].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   276
    ^ menus at:index
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   277
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   278
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   279
at:aString putMenu:aMenu
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   280
    "set the menu under the title, aString"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   281
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   282
    |index|
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   283
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   284
    index := self indexOf:aString.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   285
    (index == 0) ifTrue:[^ nil].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   286
    aMenu origin:((left + (self titleLenUpTo:index)) 
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   287
		  @
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   288
		  (height + aMenu borderWidth)).
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   289
    aMenu hidden:true.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   290
    menus at:index put:aMenu
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   291
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   292
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   293
at:aString putLabels:labels selectors:selectors args:args receiver:anObject
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   294
    "create and set the menu under the title, aString"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   295
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   296
    |menuView|
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   297
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   298
    menuView := MenuView labels:labels
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   299
		      selectors:selectors
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   300
			   args:args
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   301
		       receiver:anObject
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   302
			    for:self.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   303
    self at:aString putMenu:menuView
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   304
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   305
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   306
at:aString putLabels:labels selector:selector args:args receiver:anObject
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   307
    "create and set the menu under the title, aString"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   308
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   309
    |menuView|
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   310
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   311
    menuView := MenuView labels:labels
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   312
		       selector:selector
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   313
			   args:args
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   314
		       receiver:anObject
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   315
			    for:self.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   316
    self at:aString putMenu:menuView
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   317
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   318
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   319
at:aString putLabels:labels selectors:selectors receiver:anObject
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   320
    "create and set the menu under the title, aString"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   321
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   322
    |menuView|
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   323
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   324
    menuView := MenuView labels:labels
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   325
		      selectors:selectors
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   326
		       receiver:anObject
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   327
			    for:self.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   328
    self at:aString putMenu:menuView
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   329
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   330
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   331
!PullDownMenu methodsFor:'private'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   332
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   333
titleLenUpTo:index
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   334
    "answer len of all title-strings up-to (but excluding) title-index"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   335
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   336
    |len "{ Class: SmallInteger }" |
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   337
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   338
    (index <= 1) ifTrue:[^ 0].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   339
    len := 0.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   340
    titles from:1 to:(index - 1) do:[:string |
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   341
	len := len + (font widthOf:(' ' , string , ' ')).
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   342
	showSeparatingLines ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   343
	    self is3D ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   344
		len := len + 2
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   345
	    ] ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   346
		len := len + 1
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   347
	    ]
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   348
	]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   349
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   350
    ^ len
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   351
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   352
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   353
indexOf:stringOrNumber
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   354
    "return the index of the menu with title; return 0 if not found"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   355
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   356
    (stringOrNumber isMemberOf:SmallInteger) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   357
	^ stringOrNumber
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   358
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   359
    ^ titles indexOf:stringOrNumber
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   360
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   361
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   362
setMenuOrigins
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   363
    "adjust origins of menus when font changes"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   364
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   365
    |index|
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   366
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   367
    (font device == device) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   368
	index := 1.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   369
	menus do:[:aMenu |
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   370
	    aMenu notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   371
		aMenu origin:((left + (self titleLenUpTo:index)) 
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   372
			      @
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   373
			      (height + aMenu borderWidth))
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   374
	    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   375
	    index := index + 1
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   376
	]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   377
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   378
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   379
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   380
!PullDownMenu methodsFor:'hiding/showing menus'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   381
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   382
drawTitle:string x:x selected:selected
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   383
    |yText w|
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   384
3
claus
parents: 0
diff changeset
   385
    yText := ((height - (font height)) // 2) + (font ascent) "+ topMargin".
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   386
    w := font widthOf:string.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   387
    selected ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   388
	self paint:activeBgColor
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   389
    ] ifFalse:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   390
	self paint:bgColor
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   391
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   392
    self fillRectangleX:x y:0 width:w height:height.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   393
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   394
    self is3D ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   395
	self drawEdgesForX:x y:0
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   396
		     width:w
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   397
		    height:height
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   398
		     level:(selected ifTrue:[onLevel] ifFalse:[offLevel])
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   399
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   400
    selected ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   401
	self paint:activeFgColor
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   402
    ] ifFalse:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   403
	self paint:fgColor
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   404
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   405
    self displayString:string x:x y:yText
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   406
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   407
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   408
highlightActiveTitle
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   409
    |x string|
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   410
    activeMenuNumber notNil ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   411
	x := self titleLenUpTo:activeMenuNumber.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   412
	string := ' ' , (titles at:activeMenuNumber) , ' '.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   413
	self drawTitle:string x:x selected:true
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   414
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   415
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   416
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   417
unHighlightActiveTitle
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   418
    |x string|
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   419
    activeMenuNumber notNil ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   420
	x := self titleLenUpTo:activeMenuNumber.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   421
	string := ' ' , (titles at:activeMenuNumber) , ' '.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   422
	self drawTitle:string x:x selected:false
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   423
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   424
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   425
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   426
hideActiveMenuRelease:aBoolean
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   427
    activeMenuNumber notNil ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   428
	(menus at:activeMenuNumber) unrealize.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   429
	self unHighlightActiveTitle.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   430
	aBoolean ifTrue:[device ungrabPointer. self cursor:Cursor normal].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   431
	activeMenuNumber := nil
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   432
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   433
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   434
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   435
hideActiveMenu
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   436
    ^ self hideActiveMenuRelease:true
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   437
!
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   438
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   439
pullMenu:aNumber
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   440
    "activate a menu"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   441
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   442
    |subMenu|
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   443
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   444
    activeMenuNumber notNil ifTrue:[self hideActiveMenuRelease:false].
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   445
    subMenu := menus at:aNumber.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   446
    subMenu notNil ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   447
	activeMenuNumber := aNumber.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   448
	self highlightActiveTitle.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   449
	subMenu deselect.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   450
	subMenu create.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   451
	subMenu saveUnder:true.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   452
	subMenu raise show
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   453
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   454
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   455
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   456
!PullDownMenu methodsFor:'events'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   457
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   458
redraw
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   459
    |string
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   460
     x     "{ Class: SmallInteger }"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   461
     y     "{ Class: SmallInteger }"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   462
     index "{ Class: SmallInteger }" |
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   463
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   464
    shown ifFalse: [ ^ self ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   465
    titles isNil ifTrue:[^ self].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   466
    x := 0.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   467
    y := height "- 1".
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   468
    index := 0.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   469
    titles do:[:title |
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   470
	string := ' ' , title , ' '.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   471
	self drawTitle:string x:x selected:(index == activeMenuNumber).
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   472
	x := x + (font widthOf:string).
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   473
	showSeparatingLines ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   474
	    self is3D ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   475
		self paint:shadowColor.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   476
		self displayLineFromX:x y:0 toX:x y:y.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   477
		x := x + 1.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   478
		self paint:lightColor.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   479
		self displayLineFromX:x y:0 toX:x y:y
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   480
	    ] ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   481
		self paint:fgColor.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   482
		self displayLineFromX:x y:0 toX:x y:y
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   483
	    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   484
	    x := x + 1
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   485
	].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   486
	index := index + 1
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   487
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   488
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   489
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   490
titleIndexForX:x
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   491
    "given a click x-position, return index in title or nil"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   492
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   493
    |string 
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   494
     xstart "{ Class: SmallInteger }"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   495
     xend   "{ Class: SmallInteger }" |
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   496
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   497
    xstart := 0.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   498
    1 to:(titles size) do:[:index |
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   499
	string := ' ' , (titles at:index) , ' '.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   500
	xend := xstart + (font widthOf:string).
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   501
	showSeparatingLines ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   502
	    self is3D ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   503
		xend := xend + 2
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   504
	    ] ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   505
		xend := xend + 1
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   506
	    ]
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   507
	].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   508
	(x between:xstart and:xend) ifTrue:[^ index].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   509
	xstart := xend
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   510
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   511
    ^ nil
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   512
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   513
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   514
buttonPress:button x:x y:y
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   515
    |titleIndex activeMenu activeLeft activeTop|
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   516
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   517
    (y between:0 and:height) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   518
	titleIndex := self titleIndexForX:x.
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   519
    ].
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   520
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   521
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   522
     now, titleIndex is non-nil if pressed within myself
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   523
    "
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   524
    (titleIndex notNil and:[titleIndex ~~ activeMenuNumber]) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   525
	self pullMenu:titleIndex.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   526
	keepMenu ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   527
	    device grabPointerIn:self id.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   528
	    self cursor:Cursor upRightArrow
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   529
	]
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   530
    ] ifFalse:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   531
	keepMenu ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   532
	    titleIndex == activeMenuNumber ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   533
		"same pressed again ... stay"
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   534
		^ self
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   535
	    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   536
	    "moving around below"
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   537
	    activeMenuNumber isNil ifTrue:[^self].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   538
	    activeMenu := menus at:activeMenuNumber.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   539
	    activeLeft := activeMenu left.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   540
	    (x between:activeLeft and:(activeMenu right)) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   541
		activeTop := activeMenu top.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   542
		(y between:activeTop and:(activeMenu bottom)) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   543
		    "moving around in menu"
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   544
		    activeMenu buttonPress:button
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   545
					 x:(x - activeLeft)
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   546
					 y:(y - activeTop).
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   547
		    ^ self
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   548
		]
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   549
	    ].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   550
	].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   551
	self hideActiveMenu
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   552
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   553
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   554
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   555
buttonMotion:button x:x y:y
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   556
    |titleIndex activeMenu activeLeft activeTop|
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   557
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   558
    (y < height) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   559
	"moving around in title line"
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   560
	activeMenuNumber notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   561
	    (menus at:activeMenuNumber) selection:nil
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   562
	].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   563
	titleIndex := self titleIndexForX:x.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   564
	titleIndex notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   565
	    (titleIndex ~~ activeMenuNumber) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   566
		self pullMenu:titleIndex
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   567
	    ]
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   568
	]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   569
    ] ifFalse:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   570
	"moving around below"
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   571
	activeMenuNumber isNil ifTrue:[^self].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   572
	activeMenu := menus at:activeMenuNumber.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   573
	activeLeft := activeMenu left.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   574
	(x between:activeLeft and:(activeMenu right)) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   575
	    activeTop := activeMenu top.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   576
	    (y between:activeTop and:(activeMenu bottom)) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   577
		"moving around in menu"
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   578
		activeMenu buttonMotion:button
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   579
				      x:(x - activeLeft)
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   580
				      y:(y - activeTop).
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   581
		^ self
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   582
	    ]
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   583
	].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   584
	"moved outside menu"
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   585
	activeMenu selection:nil
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   586
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   587
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   588
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   589
buttonRelease:button x:x y:y
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   590
    |activeMenu activeLeft activeTop hideMenu|
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   591
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   592
    hideMenu := false.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   593
    (y >= height) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   594
	"release below title-line"
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   595
	activeMenuNumber isNil ifTrue:[^self].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   596
	activeMenu := menus at:activeMenuNumber.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   597
	activeLeft := activeMenu left.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   598
	"
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   599
	 released in a submenu ?
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   600
	"
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   601
	(x between:activeLeft and:(activeMenu right)) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   602
	    activeTop := activeMenu top.
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   603
	    (y between:activeTop and:(activeMenu bottom)) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   604
		"release in menu"
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   605
		self hideActiveMenu.   
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   606
		activeMenu buttonRelease:button
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   607
				       x:(x - activeLeft)
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   608
				       y:(y - activeTop).
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   609
		^ self
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   610
	    ]
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   611
	].
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   612
	hideMenu := true.
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   613
    ] ifFalse:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   614
	y < 0 ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   615
	    hideMenu := true
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   616
	] ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   617
	    keepMenu ifFalse:[   
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   618
		hideMenu := true
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   619
	    ]
450ce95a72a4 *** empty log message ***
claus
parents: 38
diff changeset
   620
	]
38
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   621
    ].                  
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   622
    hideMenu ifTrue:[
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   623
       self hideActiveMenu.
4b9b70b2cc87 2.10.3 pre-final version
claus
parents: 21
diff changeset
   624
    ]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   625
! !