Button.st
author claus
Thu, 26 Jan 1995 17:05:02 +0100
changeset 74 9d0d6a11939e
parent 62 7cc1e330da47
child 77 565b052f5277
permissions -rw-r--r--
last version before introduction of controller
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
     1
"
4
88eb91574867 *** empty log message ***
claus
parents: 2
diff changeset
     2
 COPYRIGHT (c) 1989 by Claus Gittinger
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
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
Label subclass:#Button
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    14
       instanceVariableNames:'activeLogo passiveLogo
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    15
			      pressActionBlock releaseActionBlock
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    16
			      actionWhenPressed  
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    17
			      enabled pressed active entered
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    18
			      autoRepeat repeatBlock
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    19
			      onLevel offLevel
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    20
			      initialDelay repeatDelay
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    21
			      disabledFgColor
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    22
			      activeFgColor activeBgColor
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    23
			      enteredFgColor enteredBgColor
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    24
			      isReturnButton
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    25
			      shadowForm lightForm
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
    26
			      formColor formShadowColor formLightColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
    27
			      edgeStyle halfShadowColor halfLightColor'
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
    28
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    29
      classVariableNames:'ReturnForm ReturnLightForm ReturnShadowForm 
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    30
		DefaultFont DefaultActiveLevel
74
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
    31
		DefaultPassiveLevel DefaultEdgeStyle DefaultFont DefaultBorderWidth
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    32
		DefaultForegroundColor DefaultBackgroundColor
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    33
		DefaultDisabledForegroundColor DefaultDisabledBackgroundColor
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    34
		DefaultEnteredForegroundColor DefaultEnteredBackgroundColor
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    35
		DefaultActiveForegroundColor DefaultActiveBackgroundColor
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
    36
		DefaultReturnButtonHasImage DefaultReturnButtonHasBorder
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
    37
		DefaultShadowColor DefaultLightColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
    38
		DefaultHalfShadowColor DefaultHalfLightColor'
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    39
       poolDictionaries:''
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    40
       category:'Views-Interactors'
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    41
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    42
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    43
Button comment:'
4
88eb91574867 *** empty log message ***
claus
parents: 2
diff changeset
    44
COPYRIGHT (c) 1989 by Claus Gittinger
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    45
	      All Rights Reserved
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    46
74
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
    47
$Header: /cvs/stx/stx/libwidg/Button.st,v 1.13 1995-01-26 16:04:47 claus Exp $
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    48
'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    49
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    50
!Button class methodsFor:'documentation'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    51
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    52
copyright
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    53
"
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    54
 COPYRIGHT (c) 1989 by Claus Gittinger
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    55
	      All Rights Reserved
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    56
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    57
 This software is furnished under a license and may be used
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    58
 only in accordance with the terms of that license and with the
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    59
 inclusion of the above copyright notice.   This software may not
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    60
 be provided or otherwise made available to, or used by, any
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    61
 other person.  No title to or ownership of the software is
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    62
 hereby transferred.
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    63
"
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    64
!
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    65
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    66
version
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    67
"
74
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
    68
$Header: /cvs/stx/stx/libwidg/Button.st,v 1.13 1995-01-26 16:04:47 claus Exp $
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    69
"
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    70
!
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    71
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    72
documentation
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    73
"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    74
    Buttons are Labels which do something when pressed/released.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    75
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    76
    Instance variables:
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    77
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    78
      activeLogo              <StringOrImage> logo to show when active (pressed)
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    79
      passiveLogo             <StringOrImage> logo to show when passive (released)
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    80
					      default is nil for both, so the normal logo is used
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    81
					      (see superclass: Label)
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    82
      pressActionBlock        <Block>         block to evaluate when pressed (default: noop)
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    83
      releaseActionBlock      <Block>         block to evaluate when released (default: noop)
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    84
      actionWhenPressed       <Boolean>       controls if the action should be executed on
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
    85
					      press or on release (default: on release).
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    86
      enabled                 <Boolean>       pressing is allowed (default: true)
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    87
      pressed                 <Boolean>       true if currently pressed (read-only)
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    88
      entered                 <Boolean>       true if the cursor is currently in this view
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    89
      autoRepeat              <Boolean>       auto-repeats when pressed long enough (default: false)
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    90
      onLevel                 <Integer>       level when pressed (3D only) (default: depends on style)
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    91
      offLevel                <Integer>       level when released (3D only) (default: depends on style)
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    92
      initialDelay            <Number>        seconds till first auto-repeat (default: 0.2)
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    93
      repeatDelay             <Number>        seconds of repeat intervall (default: 0.025)
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    94
      disabledFgColor         <Color>         color used to draw logo when disabled (default: depends on style)
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    95
      activeFgColor           <Color>         color to draw logo when pressed (default: depends on style)
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    96
      activeBgColor           <Color>         bg color when pressed (default: depends on style)
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    97
      enteredFgColor          <Color>         fg color to draw logo when cursor entered (default: depends on style)
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
    98
      enteredBgColor          <Color>         bg color when cursor entered (default: depends on style)
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
    99
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   100
      isReturnButton          <Boolean>       true if this button is also activated by the
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   101
					      return key - if true, it will draw a return-bitmap 
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   102
					      in addition to the logo (default: false)
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   103
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   104
      shadowForm              <Form>          form to display in addition to buttons label (returnbutton only)
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   105
      lightForm               <Form>          light part of shadowForm (returnbutton only)
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   106
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   107
      formColor               <Color>         color to draw form with (returnbutton only)
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   108
      formShadowColor         <Color>         color for shadowing the form (3D only & return)
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   109
      formLightColor          <Color>         color for lighting the form (3D only)
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   110
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   111
      repeatBlock             <Block>         block evaluated for auto-repeat (internal)
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   112
      active                  <Boolean>       true during action evaluation (internal)
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   113
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   114
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   115
    styleSheet parameters:
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   116
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   117
      buttonActiveLevel       <Integer>       level when on (ignored in 2D styles)
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   118
      buttonPassiveLevel      <Integer>       level when off (ignored in 2D styles)
74
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
   119
      buttonBorderWidth       <Integer>       default borderwidth
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   120
      buttonEdgeStyle         <Symbol>        style of edges (currently #soft or nil)
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   121
      buttonFont              <Font>          font to use for textual labels
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   122
      buttonForegroundColor   <Color>         color to draw foreground pixels (i.e. the string)
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   123
      buttonBackgroundColor   <Color>         color to draw background pixels
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   124
      buttonDisabledForegroundColor <Color>   same when disabled
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   125
      buttonDisabledBackgroundColor <Color>   same when disabled
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   126
      buttonEnteredForegroundColor  <Color>   same when mouse pointer is in
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   127
      buttonEnteredBackgroundColor  <Color>   same when mouse pointer is in
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   128
      buttonActiveForegroundColor   <Color>   same when button is active
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   129
      buttonActiveBackgroundColor   <Color>   same when button is active
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   130
      buttonShadowColor             <Color>   shadow color for edgaes (ignored in 2D styles)
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   131
      buttonLightColor              <Color>   light color for edgaes (ignored in 2D styles)
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   132
      buttonHalfShadowColor         <Color>   half shadow color; for soft edges only
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   133
      buttonHalfLightColor          <Color>   half light color; for soft edges only
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   134
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   135
      buttonReturnButtonHasImage    <Boolean> if true, return-buttons draw a return-key image
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   136
      buttonReturnButtonHasBorder   <Boolean> if true, return-buttons show a border
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   137
"
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   138
!
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   139
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   140
examples 
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   141
"
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   142
    You dont have to normally care for all the internals 
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   143
    (they allow many variations though). The typical use is:
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   144
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   145
	b := Button label:'some logo' in:aView.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   146
	b action:[ .. things to do, when pressed ... ]
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   147
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   148
    for buttons with a string-label,
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   149
    and:
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   150
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   151
	b := Button form:someImage in:aView.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   152
	b action:[ .. things to do, when pressed ... ]
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   153
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   154
    for buttons with a bitmap label.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   155
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   156
    There are many things whaich can be configured in addition;
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   157
    for example,
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   158
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   159
    see 'doc/coding-examples' and 'doc/misc/quick_view_intro.doc' for more variations.
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   160
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   161
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   162
    To implement fun buttons (for games, show-demos etc.), you can
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   163
    access all internal parameters (and not take the viewStyle defaults)
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   164
    as in:
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   165
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   166
	|b granite light shadow|
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   167
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   168
	b := Button label:'isn''t that a nice one ?'.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   169
	granite := Image fromFile:'bitmaps/granite_small.tiff'.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   170
	light := granite lightened.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   171
	shadow := granite darkened.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   172
	b backgroundColor:granite.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   173
	b foregroundColor:Color white.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   174
	b shadowColor:shadow.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   175
	b lightColor:light.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   176
	b onLevel:-3; offLevel:5.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   177
	b extent:(200 @ 50).
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   178
	b open
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   179
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   180
    However, in your application, you may want to read those bitmaps only once
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   181
    during startup and cache them for later reuse in some class variable
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   182
    (reading, lightning & darkening of images is a bit slow)
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   183
"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   184
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   185
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   186
!Button class methodsFor:'defaults'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   187
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   188
defaultInitialDelay
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   189
    "when autorepeat is enabled, and button is not released,
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   190
     start repeating after initialDelay seconds"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   191
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   192
    ^ 0.2
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   193
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   194
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   195
defaultRepeatDelay
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   196
    "when autorepeat is enabled, and button is not released,
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   197
     repeat every repeatDelay seconds"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   198
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   199
    ^ 0.025
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   200
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   201
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   202
updateStyleCache
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   203
    |defaultLevel|
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   204
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   205
    StyleSheet is3D ifTrue:[
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   206
	defaultLevel := 1.
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   207
    ] ifFalse:[
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   208
	defaultLevel := 0
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   209
    ].
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   210
    DefaultActiveLevel := StyleSheet at:'buttonActiveLevel' default:(defaultLevel negated).
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   211
    DefaultPassiveLevel := StyleSheet at:'buttonPassiveLevel' default:defaultLevel.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   212
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   213
    DefaultEdgeStyle := StyleSheet at:'buttonEdgeStyle'.
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   214
    DefaultFont := StyleSheet fontAt:'buttonFont'.
74
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
   215
    DefaultBorderWidth := StyleSheet at:'buttonBorderWidth'.
60
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   216
    DefaultForegroundColor := StyleSheet colorAt:'buttonForegroundColor'.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   217
    DefaultBackgroundColor := StyleSheet colorAt:'buttonBackgroundColor'.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   218
    DefaultDisabledForegroundColor := StyleSheet colorAt:'buttonDisabledForegroundColor' default:Color grey.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   219
    DefaultDisabledBackgroundColor := StyleSheet colorAt:'buttonDisabledBackgroundColor'.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   220
    DefaultEnteredForegroundColor := StyleSheet colorAt:'buttonEnteredForegroundColor'.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   221
    DefaultEnteredBackgroundColor := StyleSheet colorAt:'buttonEnteredBackgroundColor'.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   222
    DefaultActiveForegroundColor := StyleSheet colorAt:'buttonActiveForegroundColor'.
f3c738c24ce6 mostly style
claus
parents: 59
diff changeset
   223
    DefaultActiveBackgroundColor := StyleSheet colorAt:'buttonActiveBackgroundColor'.
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   224
    DefaultReturnButtonHasImage := StyleSheet at:'buttonReturnButtonHasImage' default:true.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   225
    DefaultReturnButtonHasBorder := StyleSheet at:'buttonReturnButtonHasBorder' default:false.
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   226
    DefaultShadowColor := StyleSheet colorAt:'buttonShadowColor'.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   227
    DefaultLightColor := StyleSheet colorAt:'buttonLightColor'.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   228
    DefaultHalfShadowColor := StyleSheet colorAt:'buttonHalfShadowColor'.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   229
    DefaultHalfLightColor := StyleSheet colorAt:'buttonHalfLightColor'.
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   230
!
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   231
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   232
returnFormOn:aDevice
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   233
    "return the form used for the return arrow in non-3D;
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   234
     cache the one for Display for the next round."
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   235
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   236
    |f|
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   237
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   238
    (ReturnForm notNil and:[aDevice == ReturnForm device]) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   239
	^ ReturnForm
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   240
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   241
    f := Form fromFile:'Return.xbm' resolution:100 on:aDevice.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   242
    f isNil ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   243
	f := Form width:24 height:16 fromArray:#[2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   244
						 2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   245
						 2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   246
						 2r00000000 2r00000011 2r11100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   247
						 2r00000001 2r10000011 2r11100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   248
						 2r00000011 2r10000011 2r11100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   249
						 2r00000111 2r11111111 2r11100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   250
						 2r00001111 2r11111111 2r11100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   251
						 2r00011111 2r11111111 2r11100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   252
						 2r00001111 2r11111111 2r11100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   253
						 2r00000111 2r11111111 2r11100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   254
						 2r00000011 2r10000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   255
						 2r00000001 2r10000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   256
						 2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   257
						 2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   258
						 2r00000000 2r00000000 2r00000000]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   259
					      on:aDevice
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   260
    ].
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   261
    ReturnForm := f.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   262
    ^ f
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   263
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   264
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   265
returnShadowFormOn:aDevice
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   266
    "return the form used for the return arrow shadow pixels (3D only);
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   267
     cache the one for Display for the next round."
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   268
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   269
    |f|
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   270
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   271
    (ReturnShadowForm notNil and:[aDevice == ReturnShadowForm device]) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   272
	^ ReturnShadowForm
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   273
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   274
    f := Form fromFile:'ReturnShadow.xbm' resolution:100 on:aDevice.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   275
    f isNil ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   276
	f := Form width:24 height:16 fromArray:#[2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   277
						 2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   278
						 2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   279
						 2r00000000 2r00000011 2r11100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   280
						 2r00000001 2r10000010 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   281
						 2r00000010 2r10000010 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   282
						 2r00000100 2r11111110 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   283
						 2r00001000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   284
						 2r00010000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   285
						 2r00001000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   286
						 2r00000100 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   287
						 2r00000010 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   288
						 2r00000001 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   289
						 2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   290
						 2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   291
						 2r00000000 2r00000000 2r00000000]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   292
					      on:aDevice
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   293
    ].
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   294
    ReturnShadowForm := f.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   295
    ^ f
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   296
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   297
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   298
returnLightFormOn:aDevice
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   299
    "return the form used for the return arrow light pixels (3D only);
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   300
     cache the one for Display for the next round"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   301
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   302
    |f|
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   303
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   304
    (ReturnLightForm notNil and:[aDevice == ReturnLightForm device]) ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   305
	^ ReturnLightForm
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   306
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   307
    f := Form fromFile:'ReturnLight.xbm' resolution:100 on:aDevice.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   308
    f isNil ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   309
	f := Form width:24 height:16 fromArray:#[2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   310
						 2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   311
						 2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   312
						 2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   313
						 2r00000000 2r00000000 2r00100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   314
						 2r00000000 2r00000000 2r00100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   315
						 2r00000000 2r00000000 2r00100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   316
						 2r00000000 2r00000000 2r00100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   317
						 2r00000000 2r00000000 2r00100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   318
						 2r00000000 2r00000000 2r00100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   319
						 2r00000000 2r11111111 2r11100000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   320
						 2r00000000 2r10000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   321
						 2r00000000 2r10000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   322
						 2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   323
						 2r00000000 2r00000000 2r00000000
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   324
						 2r00000000 2r00000000 2r00000000]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   325
					      on:aDevice
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   326
    ].
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   327
    ReturnLightForm := f.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   328
    ^ f
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   329
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   330
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   331
!Button class methodsFor:'instance creation'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   332
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   333
label:aLabel action:aBlock in:aView
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   334
    "create and return a new Button with text-label, aString
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   335
     and pressAction, aBlock.  Button is placed into aView."
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   336
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   337
    ^ ((self in:aView) label:aLabel) action:aBlock
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   338
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   339
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   340
form:aForm action:aBlock in:aView
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   341
    "create and return a new Button with icon-label, aForm
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   342
     and pressAction, aBlock.  Button is placed into aView."
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   343
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   344
    ^ ((self in:aView) form:aForm) action:aBlock
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   345
!
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   346
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   347
okButtonIn:aView
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   348
    "since ok-buttons are very common, here is a convenient
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   349
     method to create one ..."
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   350
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   351
    |aButton|
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   352
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   353
    aButton := Button 
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   354
		    label:(self classResources at:'ok')
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   355
		    in:aView.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   356
    aButton cursor:(Cursor thumbsUp).
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   357
    aButton isReturnButton:true.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   358
    ^ aButton
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   359
!
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   360
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   361
abortButtonIn:aView
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   362
    "since abort-buttons are very common, here is a convenient
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   363
     method to create one ..."
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   364
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   365
    |aButton|
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   366
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   367
    aButton := Button 
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   368
		    label:(self classResources at:'abort')
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   369
		    in:aView.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   370
    aButton cursor:(Cursor thumbsDown).
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   371
    ^ aButton
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   372
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   373
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   374
!Button methodsFor:'initialization'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   375
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   376
initialize
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   377
    super initialize.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   378
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   379
    actionWhenPressed := false.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   380
    enabled := true.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   381
    active := false.
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   382
    pressed := false.
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   383
    entered := false.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   384
    autoRepeat := false.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   385
    initialDelay := self class defaultInitialDelay.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   386
    repeatDelay := self class defaultRepeatDelay.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   387
    isReturnButton := false.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   388
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   389
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   390
initStyle
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   391
    |hasGreyscales nm|
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   392
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   393
    super initStyle.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   394
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   395
    DefaultFont notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   396
	font := DefaultFont on:device
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   397
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   398
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   399
    DefaultFont notNil ifTrue:[font := DefaultFont on:device].
74
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
   400
    DefaultBorderWidth notNil ifTrue:[borderWidth := DefaultBorderWidth].
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   401
    DefaultForegroundColor notNil ifTrue:[fgColor := DefaultForegroundColor on:device].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   402
    DefaultBackgroundColor notNil ifTrue:[bgColor := DefaultBackgroundColor on:device].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   403
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   404
    edgeStyle := DefaultEdgeStyle.
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   405
    onLevel := DefaultActiveLevel.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   406
    offLevel := DefaultPassiveLevel.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   407
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   408
    DefaultDisabledForegroundColor notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   409
	disabledFgColor := DefaultDisabledForegroundColor on:device
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   410
    ] ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   411
	disabledFgColor := fgColor
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   412
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   413
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   414
    DefaultEnteredForegroundColor notNil ifTrue:[enteredFgColor := DefaultEnteredForegroundColor on:device].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   415
    DefaultEnteredBackgroundColor notNil ifTrue:[enteredBgColor := DefaultEnteredBackgroundColor on:device].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   416
    DefaultActiveForegroundColor notNil ifTrue:[activeFgColor := DefaultActiveForegroundColor on:device].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   417
    DefaultActiveBackgroundColor notNil ifTrue:[activeBgColor := DefaultActiveBackgroundColor on:device].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   418
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   419
    DefaultShadowColor notNil ifTrue:[shadowColor := DefaultShadowColor on:device].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   420
    DefaultLightColor notNil ifTrue:[lightColor := DefaultLightColor on:device].
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   421
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   422
    shadowColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   423
	shadowColor := Black.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   424
    ].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   425
    lightColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   426
	lightColor := White.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   427
    ].
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   428
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   429
    hasGreyscales := device hasGreyscales.
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   430
    (edgeStyle == #soft) ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   431
	DefaultHalfShadowColor notNil ifTrue:[halfShadowColor := DefaultHalfShadowColor on:device].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   432
	DefaultHalfLightColor notNil ifTrue:[halfLightColor := DefaultHalfLightColor on:device].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   433
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   434
	halfShadowColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   435
"/            hasGreyscales ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   436
"/                halfShadowColor := Color darkGrey
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   437
"/            ] ifFalse:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   438
"/                halfShadowColor := shadowColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   439
"/            ]
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   440
	    halfShadowColor := shadowColor lightened
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   441
	]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   442
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   443
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   444
    "
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   445
     actually, the stuf below should not be needed
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   446
     - the styleSheet should provide values for nonGreyscale displays too
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   447
    "
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   448
    nm := StyleSheet name asSymbol.
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   449
    (nm == #iris) ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   450
	hasGreyscales ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   451
	    DefaultEnteredBackgroundColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   452
		enteredBgColor := bgColor lightened "Color lightGrey".
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   453
	    ].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   454
	    DefaultActiveBackgroundColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   455
		activeBgColor := enteredBgColor.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   456
	    ].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   457
	    DefaultActiveForegroundColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   458
		activeFgColor := enteredFgColor.
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   459
	    ].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   460
	] ifFalse:[
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   461
	    DefaultEnteredBackgroundColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   462
		enteredBgColor := Color veryLightGrey.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   463
	    ].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   464
	    DefaultActiveBackgroundColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   465
		activeBgColor := Black.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   466
	    ].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   467
	    DefaultActiveForegroundColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   468
		activeFgColor := White.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   469
	    ].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   470
	].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   471
    ] ifFalse:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   472
	nm == #motif ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   473
	    lightColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   474
		lightColor := bgColor lightened
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   475
	    ].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   476
"/            hasGreyscales ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   477
"/                lightColor := Color lightGrey
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   478
"/            ]
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   479
	] ifFalse:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   480
	    nm == #st80 ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   481
		hasGreyscales ifTrue:[
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   482
		    DefaultActiveForegroundColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   483
			activeFgColor := fgColor.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   484
		    ].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   485
		    DefaultActiveBackgroundColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   486
			activeBgColor := bgColor darkened.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   487
		    ].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   488
		] ifFalse:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   489
		    DefaultActiveForegroundColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   490
			activeFgColor := White.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   491
		    ].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   492
		    DefaultActiveBackgroundColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   493
			activeBgColor := Black
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   494
		    ]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   495
		]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   496
	    ]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   497
	]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   498
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   499
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   500
    offLevel ~~ level ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   501
	self level:offLevel.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   502
	margin := (onLevel abs) max:(offLevel abs).
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   503
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   504
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   505
    DefaultReturnButtonHasImage ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   506
	(StyleSheet is3D and:[hasGreyscales]) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   507
	    shadowForm := self class returnShadowFormOn:device.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   508
	    lightForm := self class returnLightFormOn:device.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   509
	    formColor := viewBackground.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   510
	    formShadowColor := shadowColor.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   511
	    formLightColor := lightColor
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   512
	] ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   513
	    shadowForm := self class returnFormOn:device.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   514
	    formColor := Black
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   515
	].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   516
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   517
!
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   518
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   519
initCursor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   520
    "set up a hand cursor"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   521
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   522
    cursor := Cursor hand
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   523
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   524
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   525
initEvents
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   526
    super initEvents.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   527
    self enableButtonEvents.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   528
    self enableEnterLeaveEvents
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   529
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   530
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   531
realize
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   532
    super realize.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   533
    active := false.
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   534
    entered := false.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   535
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   536
    fgColor := fgColor on:device.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   537
    bgColor := bgColor on:device.
18
66bf62e27141 *** empty log message ***
claus
parents: 6
diff changeset
   538
    formColor notNil ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   539
	formColor := formColor on:device.
18
66bf62e27141 *** empty log message ***
claus
parents: 6
diff changeset
   540
    ].
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   541
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   542
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   543
reinitialize
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   544
    super reinitialize.
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   545
    active := false.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   546
    entered := false
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   547
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   548
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   549
!Button methodsFor:'queries'!
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   550
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   551
is3D
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   552
    "return true, if the receiver is a 3D style view"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   553
74
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
   554
    StyleSheet name == #mswindows ifTrue:[^ true].
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   555
    ^ super is3D
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   556
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   557
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   558
isReturnButton
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   559
    "return true, if this is a return button"
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   560
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   561
    ^ isReturnButton
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   562
! !
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   563
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   564
!Button methodsFor:'accessing'!
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   565
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   566
isReturnButton:aBoolean
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   567
    "show/dont show a return-key image after the label"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   568
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   569
    isReturnButton ~~ aBoolean ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   570
	DefaultReturnButtonHasBorder ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   571
	    self borderWidth:(aBoolean ifTrue:[1] ifFalse:[0])
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   572
	].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   573
	isReturnButton := aBoolean.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   574
	self newLayout
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   575
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   576
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   577
    
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   578
disable
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   579
    "disable the button"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   580
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   581
    enabled ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   582
	enabled := false.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   583
	self redraw
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   584
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   585
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   586
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   587
enable
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   588
    "enable the button"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   589
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   590
    enabled ifFalse:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   591
	enabled := true.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   592
	self redraw
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   593
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   594
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   595
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   596
turnOffWithoutRedraw
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   597
    "turn the button off - no redraw"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   598
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   599
    pressed := false.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   600
    active := false.
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   601
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   602
    "do not use super level:offLevel
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   603
     - because that one does redraw the edges.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   604
     Sure, this is no good coding style"
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   605
    level := offLevel.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   606
    margin := level abs
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   607
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   608
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   609
turnOff
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   610
    "turn the button off (if not already off)"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   611
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   612
    pressed ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   613
	active := false.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   614
	pressed := false.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   615
	self level:offLevel.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   616
	self redraw
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   617
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   618
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   619
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   620
turnOn
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   621
    "turn the button on (if not already on)"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   622
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   623
    pressed ifFalse:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   624
	pressed := true.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   625
	self level:onLevel.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   626
	self redraw
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   627
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   628
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   629
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   630
pressAction
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   631
    "return the pressAction; thats the block which gets evaluated
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   632
     when the button is pressed (if non-nil)"
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   633
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   634
    ^ pressActionBlock
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   635
!
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   636
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   637
pressAction:aBlock
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   638
    "define the action to be performed on press"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   639
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   640
    pressActionBlock := aBlock
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   641
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   642
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   643
releaseAction
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   644
    "return the releaseAction; thats the block which gets evaluated
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   645
     when the button is relreased (if non-nil)"
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   646
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   647
    ^ releaseActionBlock
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   648
!
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   649
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   650
releaseAction:aBlock
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   651
    "define the action to be performed on release"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   652
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   653
    releaseActionBlock := aBlock
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   654
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   655
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   656
action:aBlock
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   657
    "convenient method: depending on the setting of actionWhenPressed,
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   658
     either set the press-action clear any release-action or
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   659
     vice versa, set the release-action and clear the press-action."
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   660
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   661
    actionWhenPressed ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   662
	releaseActionBlock := nil.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   663
	pressActionBlock := aBlock
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   664
    ] ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   665
	releaseActionBlock := aBlock.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   666
	pressActionBlock := nil
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   667
    ]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   668
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   669
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   670
autoRepeat
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   671
    "turn on autorepeat"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   672
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   673
    autoRepeat := true.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   674
    repeatBlock := [self repeat]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   675
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   676
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   677
isOn
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   678
    "return true, if this button is currently pressed"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   679
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   680
    ^ pressed
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   681
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   682
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   683
onLevel:aNumber
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   684
    "set the level of the button when pressed (i.e. how deep)"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   685
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   686
    onLevel := aNumber.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   687
    pressed ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   688
	self level:onLevel.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   689
	margin := onLevel abs max:offLevel abs.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   690
	self redraw
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   691
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   692
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   693
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   694
onLevel
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   695
    "return the level of the button when pressed"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   696
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   697
    ^ onLevel
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   698
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   699
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   700
offLevel:aNumber
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   701
    "set the level of the button when not pressed (i.e. how high)"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   702
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   703
    offLevel := aNumber.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   704
    pressed ifFalse:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   705
	self level:offLevel.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   706
	margin := onLevel abs max:offLevel abs.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   707
	self redraw
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   708
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   709
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   710
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   711
offLevel
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   712
    "return the level of the button when released"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   713
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   714
    ^ offLevel
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   715
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   716
74
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
   717
edgeStyle:aSymbol
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
   718
    "set the edgestyle - currently only #soft or nil"
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
   719
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
   720
    edgeStyle := aSymbol
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
   721
!
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
   722
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   723
activeLogo:anImageOrString
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   724
    "define the logo to be displayed while active -
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   725
     this is optional; the default is to display the same
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   726
     (logo) in both pressed and released states."
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   727
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   728
    activeLogo := anImageOrString.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   729
    pressed ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   730
	self logo:anImageOrString
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   731
    ]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   732
!
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   733
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   734
passiveLogo:anImageOrString
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   735
    "define the logo to be displayed while inactive -
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   736
     this is optional; the default is to display the same
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   737
     (logo) in both pressed and released states."
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   738
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   739
    passiveLogo := anImageOrString.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   740
    pressed ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   741
	self logo:anImageOrString
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   742
    ]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   743
!
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   744
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   745
activeForegroundColor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   746
    "return the foreground color to be used when pressed"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   747
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   748
    ^ activeFgColor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   749
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   750
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   751
activeForegroundColor:aColor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   752
    "set the foreground color to be used when pressed"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   753
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   754
    activeFgColor := aColor.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   755
    pressed ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   756
	self redraw
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   757
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   758
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   759
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   760
activeBackgroundColor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   761
    "return the background color to be used when pressed"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   762
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   763
    ^ activeBgColor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   764
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   765
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   766
activeBackgroundColor:aColor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   767
    "set the background color to be used when pressed"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   768
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   769
    activeBgColor := aColor.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   770
    pressed ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   771
	self redraw
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   772
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   773
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   774
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   775
activeForegroundColor:fgColor backgroundColor:bgColor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   776
    "set the colors to be used when pressed"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   777
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   778
    activeFgColor := fgColor.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   779
    activeBgColor := bgColor.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   780
    pressed ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   781
	self redraw
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   782
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   783
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   784
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   785
enteredForegroundColor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   786
    "return the foreground color to be used when the mouse
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   787
     pointer enters the button area"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   788
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   789
    ^ enteredFgColor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   790
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   791
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   792
enteredForegroundColor:aColor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   793
    "set the foreground color to be used when the mouse
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   794
     pointer enters the button area"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   795
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   796
    enteredFgColor := aColor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   797
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   798
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   799
enteredBackgroundColor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   800
    "return the background color to be used when the mouse
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   801
     pointer enters the button area"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   802
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   803
    ^ enteredBgColor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   804
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   805
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   806
enteredBackgroundColor:aColor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   807
    "set the background color to be used when the mouse
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   808
     pointer enters the button area"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   809
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   810
    enteredBgColor := aColor
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   811
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   812
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   813
!Button methodsFor:'queries'!
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   814
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   815
preferedExtent
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   816
    "return my prefered extent - this is the minimum size I would like to have"
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   817
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   818
    |extra|
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   819
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   820
    logo notNil ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   821
	extra := (onLevel abs max:offLevel abs) * 2.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   822
	self is3D ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   823
"/            (logo isKindOf:Form) ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   824
		"add space for a frame around"
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   825
		extra := extra + 2.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   826
"/            ]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   827
	].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   828
	^ (labelWidth + extra) @ (labelHeight + extra)
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   829
    ].
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   830
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   831
    ^ super preferedExtent
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   832
! !
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   833
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   834
!Button methodsFor:'private'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   835
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   836
computeLabelOrigin
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   837
    "compute the origin of the text - if  I am a returnButton,
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   838
     shift it somwehat to the right (we have already allocated the
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   839
     real estate, since computeLabelSize returned some extra space
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   840
     before)."
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   841
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   842
    super computeLabelOrigin.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   843
    (isReturnButton and:[shadowForm notNil]) ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   844
	labelOriginX := labelOriginX + hSpace + hSpace.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   845
    ]
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   846
!
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   847
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   848
computeLabelSize
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   849
    "compute the extent needed to hold the label plus the return form"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   850
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   851
    super computeLabelSize.
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   852
    (isReturnButton and:[shadowForm notNil]) ifTrue:[
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   853
	labelWidth := labelWidth + (hSpace * 2) + shadowForm width.
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   854
	labelHeight := labelHeight max: (shadowForm height + vSpace)
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   855
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   856
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   857
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   858
resize
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   859
    "resize myself to make logo fit into myself.
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   860
     Redefined, since we add space for a frame around text when non-3D"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   861
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   862
    |extra|
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   863
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   864
    logo isNil ifFalse:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   865
	self computeLabelOrigin.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   866
	(relativeExtent isNil and:[extentRule isNil]) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   867
	    extra := (onLevel abs max:offLevel abs) * 2.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   868
	    StyleSheet is3D ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   869
"/                (logo isKindOf:Form) ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   870
		    "add space for a rectangle around"
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   871
		    extra := extra + 2
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   872
"/                ]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   873
	    ].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   874
	    self extent:(labelWidth + extra) @ (labelHeight + extra)
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   875
	]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   876
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   877
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   878
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   879
!Button methodsFor:'redrawing'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   880
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   881
drawEdges
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   882
    "draw all of my 3D edges"
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   883
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   884
    self drawEdgesForX:0 y:0 width:width height:height level:level 
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   885
		shadow:shadowColor 
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   886
		light:lightColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   887
		halfShadow:halfShadowColor 
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   888
		halfLight:halfLightColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   889
		style:edgeStyle 
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   890
!
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   891
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   892
drawLeftEdge
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   893
    "draw left 3D edge into window frame"
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   894
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   895
    self drawLeftEdgeLevel:level
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   896
		    shadow:shadowColor 
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   897
		     light:lightColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   898
		     halfShadow:halfShadowColor 
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   899
		     halfLight:halfLightColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   900
		     style:edgeStyle.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   901
!
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   902
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   903
drawRightEdge
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   904
    "draw right 3D edge into window frame"
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   905
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   906
    self drawRightEdgeLevel:level
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   907
		     shadow:shadowColor 
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   908
		      light:lightColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   909
		      halfShadow:halfShadowColor 
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   910
		      halfLight:halfLightColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   911
		      style:edgeStyle.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   912
!
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   913
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   914
drawTopEdge
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   915
    "draw top 3D edge into window frame"
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   916
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   917
    self drawTopEdgeLevel:level
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   918
		   shadow:shadowColor 
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   919
		   light:lightColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   920
		   halfShadow:halfShadowColor 
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   921
		   halfLight:halfLightColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   922
		   style:edgeStyle.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   923
!
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   924
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   925
drawBottomEdge
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   926
    "draw bottom 3D edge into window frame"
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   927
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   928
    self drawBottomEdgeLevel:level
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   929
		      shadow:shadowColor 
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   930
		      light:lightColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   931
		      halfShadow:halfShadowColor 
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   932
		      halfLight:halfLightColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   933
		      style:edgeStyle.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   934
!
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
   935
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   936
drawWith:fg and:bg
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   937
    "redraw myself with fg/bg. Use super to draw the label, add
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   938
     the return-arrow here."
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   939
18
66bf62e27141 *** empty log message ***
claus
parents: 6
diff changeset
   940
    |x y sColor lColor|
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   941
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   942
    shown ifFalse:[^ self].
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   943
    super drawWith:fg and:bg.   "this draws the text"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   944
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   945
    (isReturnButton and:[shadowForm notNil]) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   946
	y := (height - shadowForm height) // 2.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   947
	x := width - shadowForm width - (hSpace // 2).
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   948
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   949
	formShadowColor isNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   950
	    self paint:fg on:bg.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   951
	    self background:bg.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   952
	    self displayOpaqueForm:shadowForm x:x y:y.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   953
	    ^ self
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   954
	].
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   955
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   956
	"
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   957
	 drawing form in 3d-style (i.e. with shadow and light)
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   958
	"
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   959
	(formShadowColor isColor and:[formShadowColor colorId notNil
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   960
	 and:[formLightColor isColor and:[formLightColor colorId notNil
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   961
	 and:[formColor isColor and:[formColor colorId notNil]]]]])
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   962
	ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   963
	    sColor := formShadowColor.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   964
	    lColor := formLightColor.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   965
	] ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   966
	    sColor := Black.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   967
	    lColor := White.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   968
	].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   969
	self foreground:sColor.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   970
	self displayForm:shadowForm x:x y:y.
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
   971
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   972
	lightForm notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   973
	    self foreground:lColor.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   974
	    self displayForm:lightForm x:x y:y.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   975
	].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   976
	self paint:fg.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   977
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   978
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
   979
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   980
showPassive
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   981
    "redraw myself passive"
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   982
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   983
    offLevel ~~ level ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   984
	self level:offLevel.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   985
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   986
    (passiveLogo notNil and:[passiveLogo ~~ logo]) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   987
	self logo:passiveLogo
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   988
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   989
    self redraw.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   990
!
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   991
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   992
showActive
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   993
    "redraw myself active"
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   994
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   995
    onLevel ~~ level ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   996
	self level:onLevel.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   997
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   998
    (activeLogo notNil and:[activeLogo ~~ logo]) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
   999
	self logo:activeLogo
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1000
    ].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1001
    self redraw.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1002
!
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1003
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1004
redraw
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1005
    "like redrawing a label, but hilight when pressed
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1006
     (lolight when disabled)"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1007
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1008
    |fg bg|
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1009
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1010
    shown ifFalse:[^ self].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1011
    active ifTrue:[^ self].
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
  1012
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1013
    fg := fgColor.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1014
    bg := bgColor.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1015
    enabled ifFalse:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1016
	fg := disabledFgColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1017
    ] ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1018
	entered ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1019
	    enteredFgColor notNil ifTrue:[fg := enteredFgColor].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1020
	    enteredBgColor notNil ifTrue:[bg := enteredBgColor]
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1021
	].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1022
	(pressed and:[entered or:[actionWhenPressed]]) ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1023
	    activeFgColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1024
		onLevel == offLevel ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1025
		    fg := bgColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1026
		]
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1027
	    ] ifFalse:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1028
		fg := activeFgColor.
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1029
	    ].
62
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1030
	    activeBgColor isNil ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1031
		onLevel == offLevel ifTrue:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1032
		    bg := fgColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1033
		]
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1034
	    ] ifFalse:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1035
		bg := activeBgColor
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1036
	    ].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1037
	    self is3D ifFalse:[
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1038
		self drawWith:fg and:bg .
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1039
		"
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1040
		 draw a rectangle around
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1041
		"
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1042
		self paint:fg.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1043
		self displayRectangleX:0 y:0 width:width height:height.
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1044
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1045
		^ self
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1046
	    ].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1047
	].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1048
    ].
7cc1e330da47 *** empty log message ***
claus
parents: 60
diff changeset
  1049
    self drawWith:fg and:bg
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1050
! !
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1051
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1052
!Button methodsFor:'event handling'!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1053
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1054
buttonPress:button x:x y:y
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1055
    "button was pressed - if enabled, perform pressaction"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1056
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
  1057
    (button == 1 or:[button == #select]) ifFalse:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1058
	^ super buttonPress:button x:x y:y
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1059
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1060
    pressed ifFalse:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1061
	enabled ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1062
	    pressed := true.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1063
	    self showActive.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1064
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1065
	    (pressActionBlock notNil or:[model notNil]) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1066
		"
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1067
		 force output - so that button is drawn correctly in case
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1068
		 of any long-computation (at high priority)
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1069
		"
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1070
		device synchronizeOutput.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1071
	    ].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1072
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1073
	    active := true.
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
  1074
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1075
	    pressActionBlock notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1076
		pressActionBlock value
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1077
	    ].
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
  1078
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1079
	    actionWhenPressed ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1080
		"the ST-80 way of doing things"
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1081
		(model notNil and:[changeSymbol notNil]) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1082
		    model perform:changeSymbol
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1083
		].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1084
	    ].
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1085
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1086
	    active := false.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1087
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1088
	    autoRepeat ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1089
		Processor addTimedBlock:repeatBlock afterSeconds:initialDelay
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1090
	    ]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1091
	]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1092
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1093
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1094
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1095
buttonMultiPress:button x:x y:y
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1096
    ^ self buttonPress:button x:x y:y
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1097
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1098
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1099
buttonRelease:button x:x y:y
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1100
    "button was released - if enabled, perform releaseaction"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1101
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
  1102
    (button == 1 or:[button == #select]) ifFalse:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1103
	^ super buttonRelease:button x:x y:y
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1104
    ].
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1105
    pressed ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1106
	autoRepeat ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1107
	    Processor removeTimedBlock:repeatBlock
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1108
	].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1109
	pressed := false.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1110
	self showPassive.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1111
	enabled ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1112
	    "
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1113
	     only perform action if released within myself
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1114
	    "
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1115
	    ((x >= 0) 
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1116
	    and:[x <= width
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1117
	    and:[y >= 0
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1118
	    and:[y <= height]]]) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1119
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1120
		(releaseActionBlock notNil or:[model notNil]) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1121
		    "
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1122
		     force output - so that button is drawn correctly in case
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1123
		     of any long-computation (at high priority)
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1124
		    "
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1125
		    device synchronizeOutput.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1126
		].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1127
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1128
		active := true.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1129
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1130
		releaseActionBlock notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1131
		    releaseActionBlock value
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1132
		].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1133
		actionWhenPressed ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1134
		    "the ST-80 way of doing things"
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1135
		    (model notNil and:[changeSymbol notNil]) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1136
			model perform:changeSymbol
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1137
		    ].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1138
		].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1139
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1140
		active := false.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1141
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1142
		enteredFgColor notNil ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1143
		    self drawWith:enteredFgColor and:enteredBgColor
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1144
		]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1145
	    ]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1146
	]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1147
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1148
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1149
74
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
  1150
keyPress:key x:x y:y
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
  1151
    "only trigger, if I am the focusView of my group"
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
  1152
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
  1153
    (windowGroup notNil and:[windowGroup focusView == self]) ifTrue:[
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
  1154
	(key == #Return or:[key == Character space]) ifTrue:[
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
  1155
	    "just simulate a buttonPress/release here."
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
  1156
	    self buttonPress:1 x:0 y:0.
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
  1157
	    self buttonRelease:1 x:0 y:0.
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
  1158
	    ^ self.
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
  1159
	]
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
  1160
    ].
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
  1161
    super keyPress:key x:x y:y
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
  1162
!
9d0d6a11939e last version before introduction of controller
claus
parents: 62
diff changeset
  1163
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1164
pointerLeave:state
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1165
    "redraw with normal colors if they differ from enteredColors"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1166
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1167
    entered := false.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1168
    pressed ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1169
	"
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1170
	 leave with mouse-button down;
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1171
	 stop autorepeating and/or if I am a button with
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1172
	 action on release, show passive
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1173
	"
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1174
	autoRepeat ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1175
	    Processor removeTimedBlock:repeatBlock
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1176
	].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1177
	actionWhenPressed ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1178
	    self showPassive.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1179
	]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1180
    ] ifFalse:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1181
	enabled ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1182
	    ((enteredFgColor notNil and:[enteredFgColor ~~ fgColor])
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1183
	    or:[enteredBgColor notNil and:[enteredBgColor ~~ bgColor]]) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1184
		self redraw
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1185
	    ]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1186
	]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1187
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1188
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1189
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1190
pointerEnter:state x:x y:y
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1191
    "redraw with enteredColors if they differ from the normal colors"
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1192
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1193
    entered := true.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1194
    pressed ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1195
	"
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1196
	 reentered after a leave with mouse-button down;
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1197
	 restart autorepeating and/or if I am a button with
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1198
	 actionWhenReleased, show active again.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1199
	"
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1200
	enabled ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1201
	    autoRepeat ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1202
		Processor addTimedBlock:repeatBlock afterSeconds:initialDelay
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1203
	    ].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1204
	    actionWhenPressed ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1205
		self showActive.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1206
	    ]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1207
	]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1208
    ] ifFalse:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1209
	enabled ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1210
	    ((enteredFgColor notNil and:[enteredFgColor ~~ fgColor])
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1211
	    or:[enteredBgColor notNil and:[enteredBgColor ~~ bgColor]]) ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1212
		self redraw
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1213
	    ]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1214
	]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1215
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1216
!
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1217
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1218
repeat
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1219
    "this is sent from the autorepeat-block, when the button has been pressed long
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1220
     enough; it simulates a release-press, by evaluating both release
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1221
     and press actions."
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1222
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1223
    pressed ifTrue:[
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1224
	enabled ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1225
	    active ifFalse:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1226
		active := true.
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1227
		releaseActionBlock notNil ifTrue:[releaseActionBlock value].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1228
		pressActionBlock notNil ifTrue:[pressActionBlock value].
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1229
		active := false.
35
83bd380c4383 clear entered-flag on realize
claus
parents: 24
diff changeset
  1230
"/                device synchronizeOutput.
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1231
59
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1232
		autoRepeat ifTrue:[
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1233
		    Processor addTimedBlock:repeatBlock afterSeconds:repeatDelay
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1234
		]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1235
	    ]
450ce95a72a4 *** empty log message ***
claus
parents: 42
diff changeset
  1236
	]
0
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1237
    ]
e6a541c1c0eb Initial revision
claus
parents:
diff changeset
  1238
! !