ColorEditor.st
changeset 1837 2ebd7244e50a
child 1838 170a0f24260b
equal deleted inserted replaced
1836:1bb281ec7437 1837:2ebd7244e50a
       
     1 "{ Package: 'stx:libtool2' }"
       
     2 
       
     3 SimpleDialog subclass:#ColorEditor
       
     4 	instanceVariableNames:'red green blue hue light saturation colorNameHolder'
       
     5 	classVariableNames:''
       
     6 	poolDictionaries:''
       
     7 	category:'Interface-UIPainter'
       
     8 !
       
     9 
       
    10 !ColorEditor class methodsFor:'documentation'!
       
    11 
       
    12 documentation
       
    13 "
       
    14     An edit-dialog for colors.
       
    15 "
       
    16 !
       
    17 
       
    18 examples
       
    19 "
       
    20                                                                                 [exBegin]                                      
       
    21     |editor color|
       
    22 
       
    23     editor := ColorEditor new.
       
    24     editor color:(Color green).
       
    25     editor open.
       
    26     editor accepted ifTrue:[
       
    27         editor color inspect.
       
    28     ]
       
    29                                                                                 [exEnd]
       
    30 "
       
    31 ! !
       
    32 
       
    33 !ColorEditor class methodsFor:'interface specs'!
       
    34 
       
    35 windowSpec
       
    36     "This resource specification was automatically generated
       
    37      by the UIPainter of ST/X."
       
    38 
       
    39     "Do not manually edit this!! If it is corrupted,
       
    40      the UIPainter may not be able to read the specification."
       
    41 
       
    42     "
       
    43      UIPainter new openOnClass:ColorEditor andSelector:#windowSpec
       
    44      ColorEditor new openInterface:#windowSpec
       
    45      ColorEditor open
       
    46     "
       
    47 
       
    48     <resource: #canvas>
       
    49 
       
    50     ^ 
       
    51      #(FullSpec
       
    52         name: windowSpec
       
    53         window: 
       
    54        (WindowSpec
       
    55           label: 'Define Color'
       
    56           name: 'Define Color'
       
    57           min: (Point 340 260)
       
    58           max: (Point nil 260)
       
    59           bounds: (Rectangle 0 0 453 260)
       
    60         )
       
    61         component: 
       
    62        (SpecCollection
       
    63           collection: (
       
    64            (VerticalPanelViewSpec
       
    65               name: 'RGBLabelPanel'
       
    66               layout: (LayoutFrame 0 0 0 0 58 0 76 0)
       
    67               horizontalLayout: fit
       
    68               verticalLayout: spreadSpace
       
    69               horizontalSpace: 3
       
    70               verticalSpace: 3
       
    71               component: 
       
    72              (SpecCollection
       
    73                 collection: (
       
    74                  (LabelSpec
       
    75                     label: 'Red:'
       
    76                     name: 'RedLabel'
       
    77                     translateLabel: true
       
    78                     adjust: right
       
    79                     useDefaultExtent: true
       
    80                   )
       
    81                  (LabelSpec
       
    82                     label: 'Green:'
       
    83                     name: 'GreenLabel'
       
    84                     translateLabel: true
       
    85                     adjust: right
       
    86                     useDefaultExtent: true
       
    87                   )
       
    88                  (LabelSpec
       
    89                     label: 'Blue:'
       
    90                     name: 'BlueLabel'
       
    91                     translateLabel: true
       
    92                     adjust: right
       
    93                     useDefaultExtent: true
       
    94                   )
       
    95                  )
       
    96                
       
    97               )
       
    98             )
       
    99            (VerticalPanelViewSpec
       
   100               name: 'RGBSliderPanel'
       
   101               layout: (LayoutFrame 62 0 0 0 -166 1 76 0)
       
   102               horizontalLayout: fit
       
   103               verticalLayout: spreadSpace
       
   104               horizontalSpace: 3
       
   105               verticalSpace: 3
       
   106               component: 
       
   107              (SpecCollection
       
   108                 collection: (
       
   109                  (SliderSpec
       
   110                     name: 'RedSlider'
       
   111                     tabable: false
       
   112                     model: red
       
   113                     orientation: horizontal
       
   114                     stop: 255
       
   115                     step: 1
       
   116                     backgroundColor: (Color 100.0 0.0 0.0)
       
   117                     extent: (Point 225 16)
       
   118                   )
       
   119                  (SliderSpec
       
   120                     name: 'GreenSlider'
       
   121                     tabable: false
       
   122                     model: green
       
   123                     orientation: horizontal
       
   124                     stop: 255
       
   125                     step: 1
       
   126                     backgroundColor: (Color 0.0 100.0 0.0)
       
   127                     extent: (Point 225 16)
       
   128                   )
       
   129                  (SliderSpec
       
   130                     name: 'BlueSlider'
       
   131                     tabable: false
       
   132                     model: blue
       
   133                     orientation: horizontal
       
   134                     stop: 255
       
   135                     step: 1
       
   136                     backgroundColor: (Color 0.0 0.0 100.0)
       
   137                     extent: (Point 225 16)
       
   138                   )
       
   139                  )
       
   140                
       
   141               )
       
   142             )
       
   143            (VerticalPanelViewSpec
       
   144               name: 'RGBFieldPanel'
       
   145               layout: (LayoutFrame -161 1 0 0 -123 1 76 0)
       
   146               horizontalLayout: fit
       
   147               verticalLayout: spreadSpace
       
   148               horizontalSpace: 3
       
   149               verticalSpace: 3
       
   150               component: 
       
   151              (SpecCollection
       
   152                 collection: (
       
   153                  (InputFieldSpec
       
   154                     name: 'RedField'
       
   155                     model: red
       
   156                     type: numberInRange
       
   157                     numChars: 3
       
   158                     minValue: 0
       
   159                     maxValue: 255
       
   160                     acceptOnPointerLeave: false
       
   161                     extent: (Point 38 20)
       
   162                   )
       
   163                  (InputFieldSpec
       
   164                     name: 'GreenField'
       
   165                     model: green
       
   166                     type: numberInRange
       
   167                     numChars: 3
       
   168                     minValue: 0
       
   169                     maxValue: 255
       
   170                     acceptOnPointerLeave: false
       
   171                     extent: (Point 38 20)
       
   172                   )
       
   173                  (InputFieldSpec
       
   174                     name: 'BlueField'
       
   175                     model: blue
       
   176                     type: numberInRange
       
   177                     numChars: 3
       
   178                     minValue: 0
       
   179                     maxValue: 255
       
   180                     acceptOnPointerLeave: false
       
   181                     extent: (Point 38 20)
       
   182                   )
       
   183                  )
       
   184                
       
   185               )
       
   186             )
       
   187            (VerticalPanelViewSpec
       
   188               name: 'HLSLabelPanel'
       
   189               layout: (LayoutFrame 0 0 86 0 58 0 163 0)
       
   190               horizontalLayout: fit
       
   191               verticalLayout: spreadSpace
       
   192               horizontalSpace: 3
       
   193               verticalSpace: 3
       
   194               component: 
       
   195              (SpecCollection
       
   196                 collection: (
       
   197                  (LabelSpec
       
   198                     label: 'Hue:'
       
   199                     name: 'Label1'
       
   200                     translateLabel: true
       
   201                     adjust: right
       
   202                     useDefaultExtent: true
       
   203                   )
       
   204                  (LabelSpec
       
   205                     label: 'Light:'
       
   206                     name: 'Label2'
       
   207                     translateLabel: true
       
   208                     adjust: right
       
   209                     useDefaultExtent: true
       
   210                   )
       
   211                  (LabelSpec
       
   212                     label: 'Sat:'
       
   213                     name: 'Label3'
       
   214                     translateLabel: true
       
   215                     adjust: right
       
   216                     useDefaultExtent: true
       
   217                   )
       
   218                  )
       
   219                
       
   220               )
       
   221             )
       
   222            (VerticalPanelViewSpec
       
   223               name: 'HLSSliderPanel'
       
   224               layout: (LayoutFrame 62 0 86 0 -166 1 163 0)
       
   225               horizontalLayout: fit
       
   226               verticalLayout: spreadSpace
       
   227               horizontalSpace: 3
       
   228               verticalSpace: 3
       
   229               component: 
       
   230              (SpecCollection
       
   231                 collection: (
       
   232                  (SliderSpec
       
   233                     name: 'Slider1'
       
   234                     tabable: false
       
   235                     model: hue
       
   236                     orientation: horizontal
       
   237                     stop: 359
       
   238                     step: 1
       
   239                     keyboardStep: 1
       
   240                     extent: (Point 225 16)
       
   241                   )
       
   242                  (SliderSpec
       
   243                     name: 'Slider2'
       
   244                     tabable: false
       
   245                     model: light
       
   246                     orientation: horizontal
       
   247                     step: 1
       
   248                     backgroundColor: (Color 66.9993 66.9993 66.9993)
       
   249                     keyboardStep: 1
       
   250                     extent: (Point 225 16)
       
   251                   )
       
   252                  (SliderSpec
       
   253                     name: 'Slider3'
       
   254                     tabable: false
       
   255                     model: saturation
       
   256                     orientation: horizontal
       
   257                     step: 1
       
   258                     backgroundColor: (Color 66.9993 66.9993 66.9993)
       
   259                     keyboardStep: 1
       
   260                     extent: (Point 225 16)
       
   261                   )
       
   262                  )
       
   263                
       
   264               )
       
   265             )
       
   266            (VerticalPanelViewSpec
       
   267               name: 'HLSFieldPanel'
       
   268               layout: (LayoutFrame -161 1 86 0 -123 1 163 0)
       
   269               horizontalLayout: fit
       
   270               verticalLayout: spreadSpace
       
   271               horizontalSpace: 3
       
   272               verticalSpace: 3
       
   273               component: 
       
   274              (SpecCollection
       
   275                 collection: (
       
   276                  (InputFieldSpec
       
   277                     name: 'EntryField1'
       
   278                     model: hue
       
   279                     type: numberInRange
       
   280                     numChars: 3
       
   281                     minValue: 0
       
   282                     maxValue: 359
       
   283                     acceptOnPointerLeave: false
       
   284                     extent: (Point 38 20)
       
   285                   )
       
   286                  (InputFieldSpec
       
   287                     name: 'EntryField2'
       
   288                     model: light
       
   289                     type: numberInRange
       
   290                     numChars: 3
       
   291                     minValue: 0
       
   292                     maxValue: 100
       
   293                     acceptOnPointerLeave: false
       
   294                     extent: (Point 38 20)
       
   295                   )
       
   296                  (InputFieldSpec
       
   297                     name: 'EntryField3'
       
   298                     model: saturation
       
   299                     type: numberInRange
       
   300                     numChars: 3
       
   301                     minValue: 0
       
   302                     maxValue: 100
       
   303                     acceptOnPointerLeave: false
       
   304                     extent: (Point 38 20)
       
   305                   )
       
   306                  )
       
   307                
       
   308               )
       
   309             )
       
   310            (ViewSpec
       
   311               name: 'Box1'
       
   312               layout: (LayoutFrame -117 1 4 0.0 -3 1.0 -39 1.0)
       
   313               level: 1
       
   314               component: 
       
   315              (SpecCollection
       
   316                 collection: (
       
   317                  (LabelSpec
       
   318                     label: 'Preview'
       
   319                     name: 'PreviewBox'
       
   320                     layout: (LayoutFrame 2 0.0 2 0.0 -2 1.0 -2 1.0)
       
   321                     level: -1
       
   322                     translateLabel: true
       
   323                   )
       
   324                  )
       
   325                
       
   326               )
       
   327             )
       
   328            (LabelSpec
       
   329               label: 'Color Name:'
       
   330               name: 'ColorNameLabel'
       
   331               layout: (LayoutFrame 0 0 190 0 106 0 212 0)
       
   332               translateLabel: true
       
   333               adjust: right
       
   334             )
       
   335            (InputFieldSpec
       
   336               name: 'ColorNameField'
       
   337               layout: (LayoutFrame 110 0 190 0 -123 1 212 0)
       
   338               model: colorNameHolder
       
   339               immediateAccept: true
       
   340               acceptOnReturn: true
       
   341               acceptOnTab: true
       
   342               acceptOnLostFocus: true
       
   343               acceptOnPointerLeave: false
       
   344             )
       
   345            (HorizontalPanelViewSpec
       
   346               name: 'HorizontalPanel1'
       
   347               layout: (LayoutFrame 0 0.0 -32 1 0 1.0 0 1.0)
       
   348               horizontalLayout: fitSpace
       
   349               verticalLayout: centerMax
       
   350               horizontalSpace: 3
       
   351               verticalSpace: 3
       
   352               reverseOrderIfOKAtLeft: true
       
   353               component: 
       
   354              (SpecCollection
       
   355                 collection: (
       
   356                  (ActionButtonSpec
       
   357                     label: 'Cancel'
       
   358                     name: 'CancelButton'
       
   359                     translateLabel: true
       
   360                     resizeForLabel: false
       
   361                     tabable: true
       
   362                     model: cancel
       
   363                     useDefaultExtent: true
       
   364                   )
       
   365                  (ActionButtonSpec
       
   366                     label: 'OK'
       
   367                     name: 'OKButton'
       
   368                     translateLabel: true
       
   369                     resizeForLabel: false
       
   370                     tabable: true
       
   371                     model: accept
       
   372                     isDefault: true
       
   373                     defaultable: true
       
   374                     useDefaultExtent: true
       
   375                   )
       
   376                  )
       
   377                
       
   378               )
       
   379             )
       
   380            )
       
   381          
       
   382         )
       
   383       )
       
   384 ! !
       
   385 
       
   386 !ColorEditor methodsFor:'accessing'!
       
   387 
       
   388 color
       
   389     ^Color redByte:(red value) greenByte:(green value) blueByte:(blue value)
       
   390 !
       
   391 
       
   392 color:aColor 
       
   393     aColor notNil ifTrue:[
       
   394         self red value:aColor redByte.
       
   395         self green value:aColor greenByte.
       
   396         self blue value:aColor blueByte.
       
   397     ]
       
   398 !
       
   399 
       
   400 colorName
       
   401     ^ colorNameHolder value
       
   402 ! !
       
   403 
       
   404 !ColorEditor methodsFor:'actions'!
       
   405 
       
   406 colorChanged
       
   407     |box clr|
       
   408 
       
   409     box := self componentAt: #PreviewBox.
       
   410     box isNil ifTrue:[^ self "called before setup"].
       
   411 
       
   412     clr := self color.
       
   413     box backgroundColor:clr.
       
   414     box foregroundColor:(clr brightness < 0.5 
       
   415                             ifTrue:[Color white] 
       
   416                             ifFalse:[Color black]).
       
   417 !
       
   418 
       
   419 colorNameChanged
       
   420     "compute rgb and hls (if possible)"
       
   421 
       
   422     |clr h|
       
   423 
       
   424     clr := Color name:colorNameHolder value ifIllegal:nil.
       
   425     clr isNil ifTrue:[
       
   426         ^ self
       
   427     ].
       
   428 
       
   429     red   value:clr redByte withoutNotifying:self.
       
   430     green value:clr greenByte withoutNotifying:self.
       
   431     blue  value:clr blueByte withoutNotifying:self.
       
   432 
       
   433     h := clr hue.
       
   434     h notNil ifTrue:[
       
   435         hue        value:(h rounded) withoutNotifying:self.
       
   436     ].
       
   437     light      value:(clr light rounded) withoutNotifying:self.
       
   438     saturation value:(clr saturation rounded) withoutNotifying:self.
       
   439 
       
   440     self colorChanged
       
   441 !
       
   442 
       
   443 hlsSliderChanged
       
   444     "compute rgb"
       
   445 
       
   446     Color withRGBFromHue:hue value light:light value saturation:saturation value do:[:r :g :b |
       
   447         red    value:(r * 255 / 100) rounded withoutNotifying:self.
       
   448         green  value:(g * 255 / 100) rounded withoutNotifying:self.
       
   449         blue   value:(b * 255 / 100) rounded withoutNotifying:self.
       
   450     ].
       
   451     colorNameHolder value:'' withoutNotifying:self.
       
   452     self colorChanged
       
   453 !
       
   454 
       
   455 rgbSliderChanged
       
   456     "compute hls"
       
   457 
       
   458     |r g b|
       
   459 
       
   460     r := self red value.
       
   461     g := self green value.
       
   462     b := self blue value.
       
   463 
       
   464     Color withHLSFromRed:(r * 100 / 255) green:(g * 100 / 255) blue:(b * 100 / 255) do:[:h :l :s |
       
   465         h isNil ifTrue:[
       
   466             "/ achromatic
       
   467         ] ifFalse:[
       
   468             self hue    value:(h rounded) withoutNotifying:self.
       
   469         ].
       
   470         self light      value:(l rounded) withoutNotifying:self.
       
   471         self saturation value:(s rounded) withoutNotifying:self.
       
   472     ].
       
   473     self colorNameHolder value:'' withoutNotifying:self.
       
   474     self colorChanged
       
   475 ! !
       
   476 
       
   477 !ColorEditor methodsFor:'aspects'!
       
   478 
       
   479 blue
       
   480     blue isNil ifTrue:[
       
   481         blue := 0 asValue.
       
   482         blue addDependent:self.
       
   483     ].
       
   484     ^blue
       
   485 !
       
   486 
       
   487 colorNameHolder
       
   488     colorNameHolder isNil ifTrue:[
       
   489         colorNameHolder := '' asValue.
       
   490         colorNameHolder addDependent:self.
       
   491     ].
       
   492     ^colorNameHolder
       
   493 !
       
   494 
       
   495 green
       
   496     green isNil ifTrue:[
       
   497         green := 0 asValue.
       
   498         green addDependent:self.
       
   499     ].
       
   500     ^green
       
   501 !
       
   502 
       
   503 hue
       
   504     hue isNil ifTrue:[
       
   505         hue := 0 asValue.
       
   506         hue addDependent:self.
       
   507     ].
       
   508     ^hue
       
   509 !
       
   510 
       
   511 light
       
   512     light isNil ifTrue:[
       
   513         light := 0 asValue.
       
   514         light addDependent:self.
       
   515     ].
       
   516     ^light
       
   517 !
       
   518 
       
   519 red
       
   520     red isNil ifTrue:[
       
   521         red := 0 asValue.
       
   522         red addDependent:self.
       
   523     ].
       
   524     ^red
       
   525 !
       
   526 
       
   527 saturation
       
   528     saturation isNil ifTrue:[
       
   529         saturation := 0 asValue.
       
   530         saturation addDependent:self.
       
   531     ].
       
   532     ^saturation
       
   533 ! !
       
   534 
       
   535 !ColorEditor methodsFor:'change & update'!
       
   536 
       
   537 update:something with:aParameter from:changedObject
       
   538     (changedObject == red
       
   539     or:[changedObject == green
       
   540     or:[changedObject == blue]]) ifTrue:[
       
   541         ^ self rgbSliderChanged
       
   542     ].
       
   543 
       
   544     (changedObject == hue
       
   545     or:[changedObject == light
       
   546     or:[changedObject == saturation]]) ifTrue:[
       
   547         ^ self hlsSliderChanged
       
   548     ].
       
   549 
       
   550     (changedObject == colorNameHolder) ifTrue:[
       
   551         ^ self colorNameChanged
       
   552     ].
       
   553 
       
   554     ^ super update:something with:aParameter from:changedObject
       
   555 ! !
       
   556 
       
   557 !ColorEditor methodsFor:'startup & release'!
       
   558 
       
   559 postBuildWith:aBuilder
       
   560     super postBuildWith:aBuilder.
       
   561     self colorChanged.
       
   562 
       
   563     "Modified: / 6.9.1998 / 22:55:25 / cg"
       
   564 ! !
       
   565 
       
   566 !ColorEditor class methodsFor:'documentation'!
       
   567 
       
   568 version
       
   569     ^ '$Header$'
       
   570 ! !