ColorMenu.st
author Claus Gittinger <cg@exept.de>
Tue, 11 May 2004 14:50:21 +0200
changeset 2704 0a09fd78eb54
parent 2497 0beadb2a951c
child 2935 e3fa9d1a7a64
permissions -rw-r--r--
ColorEditDialog made public
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
422
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
     1
"
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
     2
 COPYRIGHT (c) 1995 by eXept Software AG
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
     3
              All Rights Reserved
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
     4
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
     5
 This software is furnished under a license and may be used
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
     6
 only in accordance with the terms of that license and with the
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
     8
 be provided or otherwise made available to, or used by, any
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
     9
 other person.  No title to or ownership of the software is
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    10
 hereby transferred.
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    11
"
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    12
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    13
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    14
1803
ad801646be62 category change
Claus Gittinger <cg@exept.de>
parents: 1676
diff changeset
    15
"{ Package: 'stx:libtool2' }"
ad801646be62 category change
Claus Gittinger <cg@exept.de>
parents: 1676
diff changeset
    16
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    17
MenuPanel subclass:#ColorMenu
2183
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
    18
	instanceVariableNames:'enabledChannel labelsAreColored'
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
    19
	classVariableNames:''
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    20
	poolDictionaries:''
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    21
	category:'Interface-UIPainter'
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    22
!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    23
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    24
!ColorMenu class methodsFor:'documentation'!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    25
422
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    26
copyright
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    27
"
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    28
 COPYRIGHT (c) 1995 by eXept Software AG
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    29
              All Rights Reserved
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    30
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    31
 This software is furnished under a license and may be used
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    32
 only in accordance with the terms of that license and with the
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    33
 inclusion of the above copyright notice.   This software may not
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    34
 be provided or otherwise made available to, or used by, any
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    35
 other person.  No title to or ownership of the software is
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    36
 hereby transferred.
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    37
"
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    38
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    39
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    40
!
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    41
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    42
documentation
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    43
"
2183
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
    44
    A simple ColorMenu used by the UIPainter
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    45
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    46
    [see also:]
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    47
        UIPainter
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    48
        ColorMenuSpec
422
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    49
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    50
    [author:]
b28cfebfef40 added copyrights
Claus Gittinger <cg@exept.de>
parents: 412
diff changeset
    51
        Claus Atzkern
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    52
"
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    53
!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    54
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    55
examples
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    56
"
2183
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
    57
  very simple example
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    58
                                                                                [exBegin]                                      
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    59
    |tool top channel|
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    60
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    61
    top := StandardSystemView new.
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    62
    top extent:250@30.
2183
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
    63
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    64
    channel := (Color red) asValue.
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    65
    tool := self origin:0.0@0.0 corner:1.0@1.0 in:top.
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    66
    tool model:channel.
2183
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
    67
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    68
    top open.
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    69
                                                                                [exEnd]
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    70
"
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    71
! !
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    72
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    73
!ColorMenu class methodsFor:'menu spec'!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    74
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
    75
colorDefinition
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
    76
    "color definitions used to build a color menu
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    77
    "
583
4753eec71973 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 476
diff changeset
    78
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
    79
  ^ #(
668
774e55692416 remove labels in top menu
ca
parents: 666
diff changeset
    80
        #(  gray
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
    81
            gray:
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
    82
            #(  white
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
    83
                veryLightGray
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
    84
                lightGray
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
    85
                gray 
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
    86
                darkGray 
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
    87
                veryDarkGray 
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
    88
                black 
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
    89
             )
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
    90
        )
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
    91
668
774e55692416 remove labels in top menu
ca
parents: 666
diff changeset
    92
        #(  red
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
    93
            red:
854
591cc5592fdf more harmonic color palettes
tz
parents: 832
diff changeset
    94
            #( lightened 100 87 67 50 33)
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
    95
         )
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
    96
668
774e55692416 remove labels in top menu
ca
parents: 666
diff changeset
    97
        #(  green
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
    98
            green:
854
591cc5592fdf more harmonic color palettes
tz
parents: 832
diff changeset
    99
            #( lightened 100 87 67 50 33)
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   100
         )
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   101
668
774e55692416 remove labels in top menu
ca
parents: 666
diff changeset
   102
        #(  blue
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   103
            blue:
854
591cc5592fdf more harmonic color palettes
tz
parents: 832
diff changeset
   104
            #( lightened 100 87 67 50 33)
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   105
         )
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   106
668
774e55692416 remove labels in top menu
ca
parents: 666
diff changeset
   107
        #(  cyan
854
591cc5592fdf more harmonic color palettes
tz
parents: 832
diff changeset
   108
            cyan:
591cc5592fdf more harmonic color palettes
tz
parents: 832
diff changeset
   109
            #( lightened 100 87 67 50 33)
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   110
        )
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   111
668
774e55692416 remove labels in top menu
ca
parents: 666
diff changeset
   112
        #(  magenta
854
591cc5592fdf more harmonic color palettes
tz
parents: 832
diff changeset
   113
            magenta:
591cc5592fdf more harmonic color palettes
tz
parents: 832
diff changeset
   114
            #( lightened 100 87 67 50 33)
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   115
        )
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   116
668
774e55692416 remove labels in top menu
ca
parents: 666
diff changeset
   117
        #(  yellow
854
591cc5592fdf more harmonic color palettes
tz
parents: 832
diff changeset
   118
            yellow:
591cc5592fdf more harmonic color palettes
tz
parents: 832
diff changeset
   119
            #( lightened 100 87 67 50 33)
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   120
        )
806
abed5a47e545 separators removed and color orange added
tz
parents: 692
diff changeset
   121
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   122
    )
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   123
!
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   124
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   125
colorMenu:labelAreColored value:aValue
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   126
    "returns a color menu
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   127
    "
1410
be0e2a06be7c unused local removed
Claus Gittinger <cg@exept.de>
parents: 1372
diff changeset
   128
    |menu mainCol style e|
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   129
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   130
    menu  := Menu new.
1372
54d8812de860 care for good contrast in color-menus
Claus Gittinger <cg@exept.de>
parents: 1119
diff changeset
   131
    style := (labelAreColored == false) 
54d8812de860 care for good contrast in color-menus
Claus Gittinger <cg@exept.de>
parents: 1119
diff changeset
   132
                ifTrue:[#backgroundColor] 
54d8812de860 care for good contrast in color-menus
Claus Gittinger <cg@exept.de>
parents: 1119
diff changeset
   133
                ifFalse:[#color].
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   134
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   135
    self colorDefinition do:[:aSlice|
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   136
        |size colOp color item smenu|
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   137
668
774e55692416 remove labels in top menu
ca
parents: 666
diff changeset
   138
        mainCol := Color perform:(aSlice at:1).
774e55692416 remove labels in top menu
ca
parents: 666
diff changeset
   139
        item    := MenuItem labeled:(Text string:'  ' emphasis:(#backgroundColor->mainCol)).
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   140
        smenu   := Menu new.
668
774e55692416 remove labels in top menu
ca
parents: 666
diff changeset
   141
        colOp   := aSlice at:2.
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   142
668
774e55692416 remove labels in top menu
ca
parents: 666
diff changeset
   143
        (aSlice at:3) do:[:el||sitem label|
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   144
            el isSymbol ifTrue:[
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   145
                color := el == #lightened ifTrue:[mainCol perform:el] ifFalse:[Color perform:el].
854
591cc5592fdf more harmonic color palettes
tz
parents: 832
diff changeset
   146
                self colorDefinition first ~~ aSlice 
591cc5592fdf more harmonic color palettes
tz
parents: 832
diff changeset
   147
                    ifTrue: [label := (colOp upTo: $:), ' ', el] 
591cc5592fdf more harmonic color palettes
tz
parents: 832
diff changeset
   148
                    ifFalse:[label := el].
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   149
            ] ifFalse:[
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   150
                el isNumber ifTrue:[
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   151
                    color := Color perform:colOp with:el.
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   152
                    label := colOp, ' ', el printString.
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   153
                ] ifFalse:[
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   154
                    color := Color perform:colOp with:(el at:1) with:(el at:2) with:(el at:3).
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   155
                    label := ''.
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   156
                    colOp keywords keysAndValuesDo:[:i :c| label := label, ' ', c, ' ' , (el at:i) printString ].
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   157
                ]
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   158
            ].
1372
54d8812de860 care for good contrast in color-menus
Claus Gittinger <cg@exept.de>
parents: 1119
diff changeset
   159
            e := style->color.
54d8812de860 care for good contrast in color-menus
Claus Gittinger <cg@exept.de>
parents: 1119
diff changeset
   160
            style == #backgroundColor ifTrue:[
54d8812de860 care for good contrast in color-menus
Claus Gittinger <cg@exept.de>
parents: 1119
diff changeset
   161
                color brightness < 0.5 ifTrue:[
54d8812de860 care for good contrast in color-menus
Claus Gittinger <cg@exept.de>
parents: 1119
diff changeset
   162
                    e := Array with:e
54d8812de860 care for good contrast in color-menus
Claus Gittinger <cg@exept.de>
parents: 1119
diff changeset
   163
                               with:(#color->Color white) 
54d8812de860 care for good contrast in color-menus
Claus Gittinger <cg@exept.de>
parents: 1119
diff changeset
   164
                ]
54d8812de860 care for good contrast in color-menus
Claus Gittinger <cg@exept.de>
parents: 1119
diff changeset
   165
            ].
54d8812de860 care for good contrast in color-menus
Claus Gittinger <cg@exept.de>
parents: 1119
diff changeset
   166
            sitem := MenuItem 
54d8812de860 care for good contrast in color-menus
Claus Gittinger <cg@exept.de>
parents: 1119
diff changeset
   167
                        labeled:(Text 
54d8812de860 care for good contrast in color-menus
Claus Gittinger <cg@exept.de>
parents: 1119
diff changeset
   168
                                    string:('Color ', label)
54d8812de860 care for good contrast in color-menus
Claus Gittinger <cg@exept.de>
parents: 1119
diff changeset
   169
                                    emphasis:e).
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   170
            sitem argument:color.
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   171
            sitem value:aValue.
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   172
            smenu addItem:sitem.
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   173
        ].
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   174
        item submenu:smenu.
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   175
        item value:nil.
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   176
        menu addItem:item        
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   177
    ].
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   178
    ^ menu
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   179
"
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   180
(ColorMenu colorMenu:true  value:nil) startUp
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   181
(ColorMenu colorMenu:false value:#aSelector:) startUp
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   182
"
592
c7813cfa8794 add more colors
ca
parents: 583
diff changeset
   183
! !
c7813cfa8794 add more colors
ca
parents: 583
diff changeset
   184
1808
e8628b502a49 methodCategory change
Claus Gittinger <cg@exept.de>
parents: 1803
diff changeset
   185
!ColorMenu methodsFor:'accepting'!
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   186
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   187
accept:anItem
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   188
    "accept current selected item"
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   189
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   190
    |item holder color|
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   191
2183
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
   192
    ((item := super accept:anItem) notNil and: [item nameKey ~~ #def]) 
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   193
    ifTrue:
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   194
    [
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   195
        (holder := self colorHolder) == item ifTrue:
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   196
        [
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   197
            enabledChannel value ifTrue:[color := self color]
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   198
        ] 
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   199
        ifFalse:
1057
db1bd14803e3 free color definition added
tz
parents: 895
diff changeset
   200
        [  
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   201
            color := item argument.
692
fbf4503f8bc5 selection bug fixed
tz
parents: 668
diff changeset
   202
            holder label:(Text string:'   ' emphasis:(#backgroundColor->color)).
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   203
        ].
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   204
        model notNil ifTrue:[model value:color]
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   205
    ]
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   206
! !
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   207
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   208
!ColorMenu methodsFor:'accessing'!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   209
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   210
color
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   211
    "get current color"
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   212
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   213
    |firstEmphasis|
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   214
    (firstEmphasis := (self colorHolder label emphasis at:1)) isAssociation ifTrue: [^firstEmphasis value].
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   215
    ^(firstEmphasis at: 1) value 
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   216
!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   217
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   218
color:aColor
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   219
    "set current color"
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   220
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   221
    |holder label|
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   222
2184
16d3b72ca431 use inherited functionality
Claus Gittinger <cg@exept.de>
parents: 2183
diff changeset
   223
    aColor isColor ifFalse:[
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   224
        enabledChannel value:false
2184
16d3b72ca431 use inherited functionality
Claus Gittinger <cg@exept.de>
parents: 2183
diff changeset
   225
    ] ifTrue:[
16d3b72ca431 use inherited functionality
Claus Gittinger <cg@exept.de>
parents: 2183
diff changeset
   226
        self 
16d3b72ca431 use inherited functionality
Claus Gittinger <cg@exept.de>
parents: 2183
diff changeset
   227
            disabledRedrawDo:
16d3b72ca431 use inherited functionality
Claus Gittinger <cg@exept.de>
parents: 2183
diff changeset
   228
                [                 
16d3b72ca431 use inherited functionality
Claus Gittinger <cg@exept.de>
parents: 2183
diff changeset
   229
                    holder := self colorHolder.     
16d3b72ca431 use inherited functionality
Claus Gittinger <cg@exept.de>
parents: 2183
diff changeset
   230
                    label  := Text string: '   ' emphasis:(#backgroundColor->aColor).
16d3b72ca431 use inherited functionality
Claus Gittinger <cg@exept.de>
parents: 2183
diff changeset
   231
                    enabledChannel value:true.
16d3b72ca431 use inherited functionality
Claus Gittinger <cg@exept.de>
parents: 2183
diff changeset
   232
                    holder label:label.
16d3b72ca431 use inherited functionality
Claus Gittinger <cg@exept.de>
parents: 2183
diff changeset
   233
                    model value: aColor
16d3b72ca431 use inherited functionality
Claus Gittinger <cg@exept.de>
parents: 2183
diff changeset
   234
                ]
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   235
    ]
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   236
!
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   237
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   238
labelsAreColored: aBoolean
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   239
    "sets whether labels or their backgrounds will be colored"
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   240
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   241
    labelsAreColored := aBoolean ? false.
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   242
    self setupMenu
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   243
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   244
! !
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   245
1818
fe99c5c721e9 category changes
Claus Gittinger <cg@exept.de>
parents: 1816
diff changeset
   246
!ColorMenu methodsFor:'accessing-channels'!
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   247
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   248
model:aValueHolder
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   249
    "set my color channel"
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   250
2184
16d3b72ca431 use inherited functionality
Claus Gittinger <cg@exept.de>
parents: 2183
diff changeset
   251
    super model:aValueHolder.
2183
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
   252
    model notNil ifTrue:[
2186
05b16a66bb3d updateFromModel
Claus Gittinger <cg@exept.de>
parents: 2184
diff changeset
   253
        self updateFromModel
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   254
    ]
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   255
! !
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   256
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   257
!ColorMenu methodsFor:'change & update'!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   258
2186
05b16a66bb3d updateFromModel
Claus Gittinger <cg@exept.de>
parents: 2184
diff changeset
   259
updateFromModel
2184
16d3b72ca431 use inherited functionality
Claus Gittinger <cg@exept.de>
parents: 2183
diff changeset
   260
    self color:(model value)
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   261
! !
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   262
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   263
!ColorMenu methodsFor:'initialization'!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   264
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   265
destroy
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   266
    "release color channel dependency"
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   267
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   268
    self model:nil.
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   269
    super destroy
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   270
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   271
!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   272
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   273
initialize
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   274
    "setup menu"
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   275
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   276
    super initialize.
2254
ebd685bcba77 starting removing #menuAdornmentAt:
ca
parents: 2186
diff changeset
   277
    labelsAreColored    := false.
ebd685bcba77 starting removing #menuAdornmentAt:
ca
parents: 2186
diff changeset
   278
    verticalLayout      := false.    
ebd685bcba77 starting removing #menuAdornmentAt:
ca
parents: 2186
diff changeset
   279
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   280
    self fitFirstPanel:false.
895
d1c9210e796b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 854
diff changeset
   281
    enabledChannel := ValueHolder with:false.
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   282
    self setupMenu.
895
d1c9210e796b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 854
diff changeset
   283
d1c9210e796b checkin from browser
Claus Gittinger <cg@exept.de>
parents: 854
diff changeset
   284
    "Modified: / 21.5.1998 / 03:07:26 / cg"
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   285
!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   286
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   287
setupMenu
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   288
    "setup menu"
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   289
    |menu item|
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   290
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   291
    menu := self class colorMenu:labelsAreColored value:nil.
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   292
    menu itemsDo:[:el| el isButton:true].
2183
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
   293
    menu 
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
   294
        addItem:(
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
   295
            (MenuItem labeled:'...') 
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
   296
                value: 
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
   297
                    [
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
   298
                        |defineColor|
2704
0a09fd78eb54 ColorEditDialog made public
Claus Gittinger <cg@exept.de>
parents: 2497
diff changeset
   299
                        defineColor := ColorEditDialog new color: self color.
2183
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
   300
                        defineColor open.
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
   301
                        defineColor accept value ifTrue: [self color: defineColor color]
1057
db1bd14803e3 free color definition added
tz
parents: 895
diff changeset
   302
2183
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
   303
                    ];
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
   304
                nameKey:#def;
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
   305
                isButton: true) 
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
   306
        beforeIndex:8.
1057
db1bd14803e3 free color definition added
tz
parents: 895
diff changeset
   307
    menu addItem:(MenuItem labeled:'') beforeIndex:8.
806
abed5a47e545 separators removed and color orange added
tz
parents: 692
diff changeset
   308
    menu addItem:(MenuItem labeled:' ') beforeIndex:5.
abed5a47e545 separators removed and color orange added
tz
parents: 692
diff changeset
   309
    menu addItem:(MenuItem labeled:' ') beforeIndex:2.
abed5a47e545 separators removed and color orange added
tz
parents: 692
diff changeset
   310
    menu addItem:(MenuItem labeled:' ') beforeIndex:1.
abed5a47e545 separators removed and color orange added
tz
parents: 692
diff changeset
   311
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   312
    item := MenuItem labeled:(Text string:'   ' emphasis:(#backgroundColor->DefaultViewBackgroundColor)).
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   313
    item value:#selection.
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   314
    menu addItem:item beforeIndex:1.
806
abed5a47e545 separators removed and color orange added
tz
parents: 692
diff changeset
   315
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   316
    self menu:menu.
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   317
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   318
    self do:[:anItem|
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   319
        (anItem submenu) notNil ifTrue:[
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   320
            anItem enabled:enabledChannel.
666
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   321
        ] ifFalse:[
801db9028157 provides a basic color menu reused by
ca
parents: 664
diff changeset
   322
            anItem value == #selection ifTrue:[anItem indication:enabledChannel] 
1057
db1bd14803e3 free color definition added
tz
parents: 895
diff changeset
   323
                                      ifFalse:[anItem enabled:false]. 
2183
5c69691590eb code cleanup; now inherit model instVar.
Claus Gittinger <cg@exept.de>
parents: 2167
diff changeset
   324
            anItem nameKey == #def ifTrue:[anItem enabled:enabledChannel] 
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   325
        ]
664
53f8cdd4462c *** empty log message ***
tz
parents: 617
diff changeset
   326
    ]
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   327
! !
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   328
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   329
!ColorMenu methodsFor:'private'!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   330
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   331
colorHolder
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   332
    "returns the item which keeps the selected color in its label
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   333
    "
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   334
  ^ self itemAt:#selection
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   335
! !
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   336
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   337
!ColorMenu class methodsFor:'documentation'!
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   338
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   339
version
2704
0a09fd78eb54 ColorEditDialog made public
Claus Gittinger <cg@exept.de>
parents: 2497
diff changeset
   340
    ^ '$Header: /cvs/stx/stx/libwidg2/ColorMenu.st,v 1.33 2004-05-11 12:50:21 cg Exp $'
412
a8ad581658ec intitial checkin
ca
parents:
diff changeset
   341
! !