View.st
author claus
Mon, 21 Nov 1994 17:44:08 +0100
changeset 82 98a70bce6d51
parent 81 4ba554473294
child 83 597bdb33e832
permissions -rw-r--r--
*** empty log message ***
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
0
48194c26a46c Initial revision
claus
parents:
diff changeset
     1
"
6
7ee0cfde237d *** empty log message ***
claus
parents: 5
diff changeset
     2
 COPYRIGHT (c) 1989 by Claus Gittinger
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
     3
	      All Rights Reserved
0
48194c26a46c Initial revision
claus
parents:
diff changeset
     4
48194c26a46c Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
48194c26a46c Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
48194c26a46c Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
48194c26a46c Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
48194c26a46c Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
48194c26a46c Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
48194c26a46c Initial revision
claus
parents:
diff changeset
    11
"
48194c26a46c Initial revision
claus
parents:
diff changeset
    12
48194c26a46c Initial revision
claus
parents:
diff changeset
    13
PseudoView subclass:#View
48194c26a46c Initial revision
claus
parents:
diff changeset
    14
       instanceVariableNames:'superView subViews
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
    15
			      components style resources
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
    16
			      viewport
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
    17
			      borderColor borderWidth borderShape viewShape
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
    18
			      top left
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
    19
			      extentChanged originChanged cornerChanged
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
    20
			      relativeOrigin relativeExtent relativeCorner
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
    21
			      originRule extentRule cornerRule
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
    22
			      insets
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
    23
			      shown hidden name
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    24
			      level 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    25
			      margin innerClipRect
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
    26
			      shadowColor lightColor
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
    27
			      viewOrigin 
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
    28
			      bitGravity viewGravity
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
    29
			      keyboardHandler model controller windowGroup
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
    30
			      aspectSymbol changeSymbol menuSymbol'
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
    31
       classVariableNames:   'Grey CentPoint
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
    32
			      ViewSpacing  
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
    33
			      DefaultStyle StyleSheet
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
    34
			      DefaultViewBackgroundColor DefaultBorderColor
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
    35
			      DefaultLightColor DefaultShadowColor
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
    36
			      DefaultBorderWidth DefaultFont'
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    37
       poolDictionaries:     ''
48194c26a46c Initial revision
claus
parents:
diff changeset
    38
       category:'Views-Basic'
48194c26a46c Initial revision
claus
parents:
diff changeset
    39
!
48194c26a46c Initial revision
claus
parents:
diff changeset
    40
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    41
View class instanceVariableNames:'ClassResources'!
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    42
0
48194c26a46c Initial revision
claus
parents:
diff changeset
    43
View comment:'
6
7ee0cfde237d *** empty log message ***
claus
parents: 5
diff changeset
    44
COPYRIGHT (c) 1989 by Claus Gittinger
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
    45
	      All Rights Reserved
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
    46
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
    47
$Header: /cvs/stx/stx/libview/View.st,v 1.22 1994-11-21 16:43:24 claus Exp $
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    48
'!
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    49
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    50
"this flag controls (globally) how views look - it will vanish"
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    51
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    52
Smalltalk at:#View3D put:false!
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    53
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    54
!View class methodsFor:'documentation'!
41
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
    55
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    56
copyright
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    57
"
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    58
 COPYRIGHT (c) 1989 by Claus Gittinger
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
    59
	      All Rights Reserved
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    60
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    61
 This software is furnished under a license and may be used
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    62
 only in accordance with the terms of that license and with the
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    63
 inclusion of the above copyright notice.   This software may not
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    64
 be provided or otherwise made available to, or used by, any
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    65
 other person.  No title to or ownership of the software is
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    66
 hereby transferred.
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    67
"
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    68
!
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    69
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    70
version
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    71
"
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
    72
$Header: /cvs/stx/stx/libview/View.st,v 1.22 1994-11-21 16:43:24 claus Exp $
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    73
"
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    74
!
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
    75
41
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
    76
documentation
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
    77
"
41
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
    78
    this class implements functions common to all Views. 
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
    79
    Instances of View are seldom used, most views in the system inherit 
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
    80
    from this class. 
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
    81
    However, sometimes a view is used to create a dummy view for framing 
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
    82
    or layout purposes.
41
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
    83
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
    84
    Instance variables:
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
    85
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    86
	superView               <View>                  my superview i.e. the view I am in
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    87
	subViews                <Collection>            the collection of subviews
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    88
	window                  <Rectangle>             my window i.e. local coordinate-system
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    89
	viewport                <Rectangle>             my Rectangle in superviews coordinates
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    90
	borderColor             <Color>                 color of border
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    91
	borderWidth             <Number>                borderWidth in pixels (device dep.)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    92
	borderShape             <Form>                  shape of border (if device supports it)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    93
	viewShape               <Form>                  shape of view (if device supports it)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    94
	top                     <Number>                top coordinate in superview
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    95
	left                    <Number>                left coordinate in superview
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    96
	extendChanged           <Boolean>               true if extend changed during setup
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    97
	originChanged           <Boolean>               true if origin changed during setup
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    98
	relativeOrigin          <Number>                relative origin in percent within superview
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
    99
	relativeExtent          <Number>                relative extent in percent within superview
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   100
	originRule              <Block>                 rule to compute origin if superview changes size
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   101
	extentRule              <Block>                 rule to compute extent if superview changes size
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   102
	shown                   <Boolean>               true if visible (false if iconified)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   103
	hidden                  <Boolean>               dont show automatically when superview is realized
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   104
	name                    <String>                my name (future use for resources)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   105
	level                   <Number>                3D level relative to superview
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   106
	margin                  <Number>                convenient margin
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   107
	innerClipRect           <Rectangle>             convenient inner clip (minus margin)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   108
	shadowColor             <Color>                 color used to draw 3D shadowed edges
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   109
	lightColor              <Color>                 color used to draw 3D lighted edges
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   110
	viewOrigin              <Point>                 origin within model
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   111
	contentsChanngeAction   <Block>                 action to perform when model contents changes
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   112
	originChangeAction      <Block>                 action to perform when model origin changes
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   113
	bitGravity              <nil | Symbol>          gravity of contents (if device supports it)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   114
	viewGravity             <nil | Symbol>          gravity of view (if device supports it)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   115
	keyboardHandler         <nil | any>             gets keyboard input if non-nil
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   116
	model                   <nil | any>             the model (if any)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   117
	controller              <nil | Controller>      the controller (if any)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   118
41
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
   119
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
   120
    Class variables:
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
   121
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   122
	Grey                    <Color>                 the color grey - its used so often
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   123
	ViewSpacing             <Number>                prefered spacing between views; 1mm
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   124
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   125
	CentPoint               <Point>                 100 @ 100 - its used so often
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   126
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   127
	StyleSheet              <ResourcePack>          contains all view-style specifics
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   128
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   129
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   130
    styleSheet parameters:
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   131
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   132
	popupShadow             <Boolean>               if true, popupViews show a shadow below
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   133
	popupLevel              <nil | Integer>         3D level
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   134
	borderWidth             <nil | Integer>         borderWidth (ignored in 3D styles)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   135
	borderColor             <nil | Color>           borderColor (ignored in 3D styles)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   136
	viewBackground          <nil | Color>           views background
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   137
	shadowColor             <nil | Color>           color for shadow edges (ignored in 2D styles)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   138
	lightColor              <nil | Color>           color for light edges (ignored in 2D styles)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   139
	font                    <nil | Font>            font to use
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   140
"
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   141
! !
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   142
48194c26a46c Initial revision
claus
parents:
diff changeset
   143
!View class methodsFor:'initialization'!
48194c26a46c Initial revision
claus
parents:
diff changeset
   144
48194c26a46c Initial revision
claus
parents:
diff changeset
   145
initialize
48194c26a46c Initial revision
claus
parents:
diff changeset
   146
    "Workstation initialize."
48194c26a46c Initial revision
claus
parents:
diff changeset
   147
48194c26a46c Initial revision
claus
parents:
diff changeset
   148
    super initialize.
48194c26a46c Initial revision
claus
parents:
diff changeset
   149
    Form initialize.
48194c26a46c Initial revision
claus
parents:
diff changeset
   150
    Color initialize.
48194c26a46c Initial revision
claus
parents:
diff changeset
   151
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   152
48194c26a46c Initial revision
claus
parents:
diff changeset
   153
!View class methodsFor:'defaults'!
48194c26a46c Initial revision
claus
parents:
diff changeset
   154
48194c26a46c Initial revision
claus
parents:
diff changeset
   155
defaultExtent
48194c26a46c Initial revision
claus
parents:
diff changeset
   156
    "define the default extent"
48194c26a46c Initial revision
claus
parents:
diff changeset
   157
48194c26a46c Initial revision
claus
parents:
diff changeset
   158
    CentPoint isNil ifTrue:[CentPoint := 100 @ 100].
48194c26a46c Initial revision
claus
parents:
diff changeset
   159
    ^ CentPoint
48194c26a46c Initial revision
claus
parents:
diff changeset
   160
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   161
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   162
flushAllClassResources
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   163
    "flush all classes resource translations.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   164
     Needed after a resource file has changed."
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   165
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   166
    ResourcePack flushCachedResourcePacks.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   167
    self flushClassResources.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   168
    self allSubclassesDo:[:aClass |
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   169
	(aClass class implements:#flushClassResources) ifTrue:[aClass flushClassResources].
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   170
    ]
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   171
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   172
    "
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   173
     View flushAllClassResources
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   174
    "
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   175
    "to change the language:
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   176
	Language := #english.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   177
	Smalltalk changed:#Language.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   178
	View flushAllClassResources
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   179
     or:
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   180
	Language := #german.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   181
	Smalltalk changed:#Language.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   182
	View flushAllClassResources
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   183
    "     
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   184
!
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   185
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   186
flushClassResources
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   187
    "flush classes resource string translations.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   188
     Needed whenever a resource file has changed"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   189
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   190
    ClassResources := nil.
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   191
!
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   192
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   193
classResources
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   194
    "if not already loaded, get the classes resourcePack
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   195
     and return it"
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   196
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   197
    ClassResources isNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   198
	ClassResources := ResourcePack for:self.
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   199
    ].
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   200
    ^ ClassResources
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   201
!
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   202
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   203
classResources:aResourcePack
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   204
    "allow setting of the classResources"
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   205
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   206
    ClassResources := aResourcePack
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   207
!
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   208
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   209
defaultStyle
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   210
    "return the default view style"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   211
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   212
    ^ DefaultStyle
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   213
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   214
    "
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   215
     View defaultStyle
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   216
    "
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   217
!
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   218
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   219
styleSheet:aViewStyle
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   220
    "set the view style from a style-sheet"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   221
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   222
    StyleSheet := aViewStyle.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   223
    DefaultStyle := (StyleSheet at:'name' ifAbsent:'unknown') asSymbol.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   224
    self updateAllStyleCaches.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   225
!
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   226
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   227
defaultStyle:aStyle
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   228
    "set the view style for new views"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   229
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   230
    aStyle ~~ DefaultStyle ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   231
	DefaultStyle := aStyle.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   232
	self updateAllStyleCaches.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   233
    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   234
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   235
    "
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   236
     View defaultStyle:#next. SystemBrowser start
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   237
     View defaultStyle:#motif. SystemBrowser start
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   238
     View defaultStyle:#iris. SystemBrowser start
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   239
     View defaultStyle:#st80. SystemBrowser start
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   240
     View defaultStyle:#normal. SystemBrowser start
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   241
    "
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   242
!
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   243
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   244
updateAllStyleCaches
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   245
    "reload all style caches in all view classes.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   246
     Needed after a style change or when a style file has been changed"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   247
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   248
    StyleSheet := ViewStyle fromFile:(DefaultStyle , '.style').
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   249
    StyleSheet fileReadFailed ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   250
	('***** WARNING: no styleSheet for ' , DefaultStyle , '-style.') errorPrintNL.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   251
	DefaultStyle := #normal.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   252
	StyleSheet := ViewStyle fromFile:(DefaultStyle , '.style').
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   253
	StyleSheet fileReadFailed  ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   254
	    '***** FATAL: not even a styleSheet for normal-style.' errorPrintNL.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   255
	]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   256
    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   257
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   258
    "
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   259
     tell all view classes to flush any
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   260
     cached style-data
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   261
    "
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   262
    self changed:#style.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   263
    self updateStyleCache.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   264
    self allSubclassesDo:[:aClass |
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   265
	(aClass class implements:#updateStyleCache) ifTrue:[aClass updateStyleCache].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   266
    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   267
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   268
    "
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   269
     View updateAllStyleCaches
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   270
    "
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   271
!
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   272
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   273
updateStyleCache
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   274
    "this method gets some heavily used style stuff and keeps
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   275
     it in class-variables for faster access.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   276
     Subclasses should redefine this to load any cached style-values
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   277
     into faster class variables as well. These should NOT do a 
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   278
     super updateStyleCache, since this method is called for all view-classes
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   279
     anyway."
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   280
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   281
    |bgGrey|
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   282
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   283
    "
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   284
     when coming here the first time, we read the styleSheet
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   285
     and keep the values in fast class variables
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   286
    "
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   287
    StyleSheet isNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   288
	DefaultStyle := #normal.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   289
	StyleSheet := ViewStyle fromFile:'normal.style'.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   290
    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   291
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   292
    Grey := StyleSheet viewGrey.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   293
    Grey isNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   294
	Grey := Color grey
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   295
    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   296
    Grey := Grey on:Display.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   297
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   298
    Display hasGreyscales ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   299
	bgGrey := Grey
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   300
    ] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   301
	bgGrey := White on:Display 
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   302
    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   303
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   304
    ViewSpacing := StyleSheet at:'viewSpacing'.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   305
    ViewSpacing isNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   306
	ViewSpacing := Display verticalPixelPerMillimeter rounded.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   307
    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   308
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   309
    DefaultBorderWidth := StyleSheet at:'borderWidth' default:0.
78
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
   310
    DefaultBorderColor := StyleSheet colorAt:'borderColor' default:Black.
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
   311
    DefaultViewBackgroundColor := StyleSheet colorAt:'viewBackground' default:bgGrey.
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
   312
    DefaultShadowColor := StyleSheet colorAt:'shadowColor'.
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
   313
    DefaultLightColor := StyleSheet colorAt:'lightColor'.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   314
    DefaultFont := StyleSheet at:'font'.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   315
    DefaultFont isNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   316
	DefaultFont := Font family:'courier' face:'medium' style:'roman' size:12.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   317
    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   318
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   319
    DefaultFont := DefaultFont on:Display.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   320
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   321
    DefaultViewBackgroundColor isNil ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   322
	'bad viewBackground in style - using white' errorPrintNL.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   323
	DefaultViewBackgroundColor := White
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   324
    ].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   325
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   326
48194c26a46c Initial revision
claus
parents:
diff changeset
   327
!View class methodsFor:'instance creation'!
48194c26a46c Initial revision
claus
parents:
diff changeset
   328
48194c26a46c Initial revision
claus
parents:
diff changeset
   329
in:aView
42
ace6ce40b2f8 *** empty log message ***
claus
parents: 41
diff changeset
   330
    "return a new view as a subview of aView.
ace6ce40b2f8 *** empty log message ***
claus
parents: 41
diff changeset
   331
     If aView is nil, it is left unspecified, in which superview
ace6ce40b2f8 *** empty log message ***
claus
parents: 41
diff changeset
   332
     the new view will be placed. The view can later be assigned
ace6ce40b2f8 *** empty log message ***
claus
parents: 41
diff changeset
   333
     by adding it to the superview via #addSubView:.
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   334
     If realized and no superview has ever been set, it will come
42
ace6ce40b2f8 *** empty log message ***
claus
parents: 41
diff changeset
   335
     up as a topview."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   336
48194c26a46c Initial revision
claus
parents:
diff changeset
   337
    |newView|
48194c26a46c Initial revision
claus
parents:
diff changeset
   338
48194c26a46c Initial revision
claus
parents:
diff changeset
   339
    newView := self basicNew.
42
ace6ce40b2f8 *** empty log message ***
claus
parents: 41
diff changeset
   340
    aView notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   341
	newView device:(aView device).
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   342
	newView superView:(aView).
42
ace6ce40b2f8 *** empty log message ***
claus
parents: 41
diff changeset
   343
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   344
	newView device:Display
42
ace6ce40b2f8 *** empty log message ***
claus
parents: 41
diff changeset
   345
    ].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   346
    newView initialize.
42
ace6ce40b2f8 *** empty log message ***
claus
parents: 41
diff changeset
   347
    aView notNil ifTrue:[aView addSubView:newView].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   348
    ^ newView
48194c26a46c Initial revision
claus
parents:
diff changeset
   349
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   350
48194c26a46c Initial revision
claus
parents:
diff changeset
   351
extent:extent in:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   352
    "create a new view as a subview of aView with given extent"
48194c26a46c Initial revision
claus
parents:
diff changeset
   353
48194c26a46c Initial revision
claus
parents:
diff changeset
   354
    ^ self origin:nil extent:extent borderWidth:nil
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   355
		      font:nil label:nil in:aView
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   356
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   357
48194c26a46c Initial revision
claus
parents:
diff changeset
   358
origin:origin in:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   359
    "create a new view as a subview of aView with given origin"
48194c26a46c Initial revision
claus
parents:
diff changeset
   360
48194c26a46c Initial revision
claus
parents:
diff changeset
   361
    ^ self origin:origin extent:nil borderWidth:nil
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   362
			 font:nil label:nil in:aView
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   363
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   364
48194c26a46c Initial revision
claus
parents:
diff changeset
   365
extent:extent
48194c26a46c Initial revision
claus
parents:
diff changeset
   366
    "create a new view with given extent"
48194c26a46c Initial revision
claus
parents:
diff changeset
   367
48194c26a46c Initial revision
claus
parents:
diff changeset
   368
    ^ self origin:nil extent:extent borderWidth:nil
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   369
		      font:nil label:nil in:nil
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   370
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   371
48194c26a46c Initial revision
claus
parents:
diff changeset
   372
origin:origin extent:extent
48194c26a46c Initial revision
claus
parents:
diff changeset
   373
    "create a new view with given origin and extent"
48194c26a46c Initial revision
claus
parents:
diff changeset
   374
48194c26a46c Initial revision
claus
parents:
diff changeset
   375
    ^ self origin:origin extent:extent borderWidth:nil
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   376
			 font:nil label:nil in:nil
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   377
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   378
48194c26a46c Initial revision
claus
parents:
diff changeset
   379
origin:origin extent:extent in:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   380
    "create a new view as a subview of aView with given origin and extent"
48194c26a46c Initial revision
claus
parents:
diff changeset
   381
48194c26a46c Initial revision
claus
parents:
diff changeset
   382
    ^ self origin:origin extent:extent borderWidth:nil
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   383
			 font:nil label:nil in:aView
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   384
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   385
48194c26a46c Initial revision
claus
parents:
diff changeset
   386
origin:origin extent:extent borderWidth:bw in:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   387
    "create a new view as a subview of aView with given origin, extent
48194c26a46c Initial revision
claus
parents:
diff changeset
   388
     and borderWidth"
48194c26a46c Initial revision
claus
parents:
diff changeset
   389
48194c26a46c Initial revision
claus
parents:
diff changeset
   390
    ^ self origin:origin extent:extent borderWidth:bw
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   391
			 font:nil label:nil in:aView
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   392
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   393
48194c26a46c Initial revision
claus
parents:
diff changeset
   394
origin:origin extent:extent borderWidth:bw
48194c26a46c Initial revision
claus
parents:
diff changeset
   395
    "create a new view with given origin, extent and borderWidth"
48194c26a46c Initial revision
claus
parents:
diff changeset
   396
48194c26a46c Initial revision
claus
parents:
diff changeset
   397
    ^ self origin:origin extent:extent borderWidth:bw
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   398
			 font:nil label:nil in:nil
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   399
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   400
48194c26a46c Initial revision
claus
parents:
diff changeset
   401
label:label
48194c26a46c Initial revision
claus
parents:
diff changeset
   402
    "create a new view with given label"
48194c26a46c Initial revision
claus
parents:
diff changeset
   403
48194c26a46c Initial revision
claus
parents:
diff changeset
   404
    ^ self origin:nil extent:nil borderWidth:nil
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   405
		      font:nil label:label in:nil
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   406
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   407
48194c26a46c Initial revision
claus
parents:
diff changeset
   408
label:label in:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   409
    "create a new view as subview of aView with given label"
48194c26a46c Initial revision
claus
parents:
diff changeset
   410
48194c26a46c Initial revision
claus
parents:
diff changeset
   411
    ^ self origin:nil extent:nil borderWidth:nil
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   412
		      font:nil label:label in:aView
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   413
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   414
48194c26a46c Initial revision
claus
parents:
diff changeset
   415
extent:extent label:label
48194c26a46c Initial revision
claus
parents:
diff changeset
   416
    "create a new view with given extent and label"
48194c26a46c Initial revision
claus
parents:
diff changeset
   417
48194c26a46c Initial revision
claus
parents:
diff changeset
   418
    ^ self origin:nil extent:extent borderWidth:nil
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   419
		      font:nil label:label in:nil
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   420
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   421
48194c26a46c Initial revision
claus
parents:
diff changeset
   422
origin:origin extent:extent label:label
48194c26a46c Initial revision
claus
parents:
diff changeset
   423
    "create a new view with given origin, extent and label"
48194c26a46c Initial revision
claus
parents:
diff changeset
   424
48194c26a46c Initial revision
claus
parents:
diff changeset
   425
    ^ self origin:origin extent:extent borderWidth:nil
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   426
			 font:nil label:label in:nil
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   427
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   428
48194c26a46c Initial revision
claus
parents:
diff changeset
   429
origin:origin extent:extent font:aFont label:label
48194c26a46c Initial revision
claus
parents:
diff changeset
   430
    ^ self origin:origin extent:extent borderWidth:nil
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   431
			 font:nil label:label in:nil
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   432
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   433
48194c26a46c Initial revision
claus
parents:
diff changeset
   434
origin:origin extent:extent font:aFont label:label in:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   435
    ^ self origin:origin extent:extent borderWidth:nil
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   436
			 font:aFont label:label in:aView
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   437
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   438
48194c26a46c Initial revision
claus
parents:
diff changeset
   439
origin:anOrigin extent:anExtent
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   440
		label:aLabel icon:aForm
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   441
		minExtent:minExtent maxExtent:maxExtent
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   442
    |newView|
48194c26a46c Initial revision
claus
parents:
diff changeset
   443
48194c26a46c Initial revision
claus
parents:
diff changeset
   444
    newView := self on:Display.
48194c26a46c Initial revision
claus
parents:
diff changeset
   445
    anOrigin notNil ifTrue:[newView origin:anOrigin].
48194c26a46c Initial revision
claus
parents:
diff changeset
   446
    anExtent notNil ifTrue:[newView extent:anExtent].
48194c26a46c Initial revision
claus
parents:
diff changeset
   447
    aLabel notNil ifTrue:[newView label:aLabel].
48194c26a46c Initial revision
claus
parents:
diff changeset
   448
    aForm notNil ifTrue:[newView icon:aForm].
48194c26a46c Initial revision
claus
parents:
diff changeset
   449
    minExtent notNil ifTrue:[newView minExtent:minExtent].
48194c26a46c Initial revision
claus
parents:
diff changeset
   450
    maxExtent notNil ifTrue:[newView maxExtent:maxExtent].
48194c26a46c Initial revision
claus
parents:
diff changeset
   451
    ^ newView
48194c26a46c Initial revision
claus
parents:
diff changeset
   452
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   453
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   454
origin:anOrigin extent:anExtent borderWidth:bw font:aFont label:aLabel in:aView
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   455
    |newView|
48194c26a46c Initial revision
claus
parents:
diff changeset
   456
48194c26a46c Initial revision
claus
parents:
diff changeset
   457
    aView notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   458
	newView := self basicNew.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   459
	newView device:(aView device).
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   460
	aView addSubView:newView.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   461
	newView initialize
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   462
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   463
	newView := self on:Display
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   464
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   465
    bw notNil ifTrue:[newView borderWidth:bw].
48194c26a46c Initial revision
claus
parents:
diff changeset
   466
    anExtent notNil ifTrue:[newView extent:anExtent].
48194c26a46c Initial revision
claus
parents:
diff changeset
   467
    anOrigin notNil ifTrue:[newView origin:anOrigin].
48194c26a46c Initial revision
claus
parents:
diff changeset
   468
    aFont notNil ifTrue:[newView font:aFont].
48194c26a46c Initial revision
claus
parents:
diff changeset
   469
    aLabel notNil ifTrue:[newView label:aLabel].
48194c26a46c Initial revision
claus
parents:
diff changeset
   470
    ^ newView
48194c26a46c Initial revision
claus
parents:
diff changeset
   471
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   472
48194c26a46c Initial revision
claus
parents:
diff changeset
   473
origin:origin corner:corner 
48194c26a46c Initial revision
claus
parents:
diff changeset
   474
    "create a new view with given origin and extent"
48194c26a46c Initial revision
claus
parents:
diff changeset
   475
48194c26a46c Initial revision
claus
parents:
diff changeset
   476
    ^ self origin:origin corner:corner borderWidth:nil
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   477
			 font:nil label:nil in:nil
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   478
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   479
48194c26a46c Initial revision
claus
parents:
diff changeset
   480
origin:origin corner:corner in:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   481
    "create a new view as a subview of aView with given origin and extent"
48194c26a46c Initial revision
claus
parents:
diff changeset
   482
48194c26a46c Initial revision
claus
parents:
diff changeset
   483
    ^ self origin:origin corner:corner borderWidth:nil
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   484
			 font:nil label:nil in:aView
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   485
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   486
48194c26a46c Initial revision
claus
parents:
diff changeset
   487
origin:origin corner:corner borderWidth:bw in:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
   488
    "create a new view as a subview of aView with given origin and extent"
48194c26a46c Initial revision
claus
parents:
diff changeset
   489
48194c26a46c Initial revision
claus
parents:
diff changeset
   490
    ^ self origin:origin corner:corner borderWidth:bw
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   491
			 font:nil label:nil in:aView
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   492
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   493
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   494
origin:anOrigin corner:aCorner borderWidth:bw font:aFont label:aLabel in:aView
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   495
    |newView|
48194c26a46c Initial revision
claus
parents:
diff changeset
   496
48194c26a46c Initial revision
claus
parents:
diff changeset
   497
    aView notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   498
	newView := self basicNew.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   499
	newView device:(aView device).
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   500
	aView addSubView:newView.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   501
	newView initialize
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   502
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   503
	newView := self on:Display
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   504
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   505
    bw notNil ifTrue:[newView borderWidth:bw].
48194c26a46c Initial revision
claus
parents:
diff changeset
   506
    anOrigin notNil ifTrue:[newView origin:anOrigin].
48194c26a46c Initial revision
claus
parents:
diff changeset
   507
    aCorner notNil ifTrue:[newView corner:aCorner].
48194c26a46c Initial revision
claus
parents:
diff changeset
   508
    aFont notNil ifTrue:[newView font:aFont].
48194c26a46c Initial revision
claus
parents:
diff changeset
   509
    aLabel notNil ifTrue:[newView label:aLabel].
48194c26a46c Initial revision
claus
parents:
diff changeset
   510
    ^ newView
48194c26a46c Initial revision
claus
parents:
diff changeset
   511
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   512
48194c26a46c Initial revision
claus
parents:
diff changeset
   513
on:anObject aspect:aspectMsg change:changeMsg menu:menuMsg
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   514
    "st-80 style view creation: create a new view, set its model
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   515
     and access selectors for aspect, change and menu"
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   516
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   517
    ^ self new on:anObject
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   518
	   aspect:aspectMsg
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   519
	   change:changeMsg
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   520
	     menu:menuMsg
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   521
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   522
48194c26a46c Initial revision
claus
parents:
diff changeset
   523
model:aModel
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   524
    "st-80 style view creation: create a new view and set its model"
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   525
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   526
    ^ self new model:aModel
48194c26a46c Initial revision
claus
parents:
diff changeset
   527
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   528
48194c26a46c Initial revision
claus
parents:
diff changeset
   529
!View methodsFor:'initialization'!
48194c26a46c Initial revision
claus
parents:
diff changeset
   530
48194c26a46c Initial revision
claus
parents:
diff changeset
   531
initialize
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   532
    "initialize all state of the view - usually redefined in subclasses,
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   533
     but always doing a 'super initialize'. Each class should setup its
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   534
     locals - and not forget the others.
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   535
     View setup is separated into two parts, the general setup done here
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   536
     and the style specific setup in initStyle. Each view should be prepared
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   537
     for a stylechange by being sent another initStyle with a new style value.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   538
     (in this case, it should set all of its style-dependent things, but
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   539
      leave the state and contents as-is)"
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   540
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   541
    |ext|
48194c26a46c Initial revision
claus
parents:
diff changeset
   542
48194c26a46c Initial revision
claus
parents:
diff changeset
   543
    super initialize.
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   544
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   545
    font := DefaultFont.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   546
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   547
    shown := hidden := realized := false.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   548
48194c26a46c Initial revision
claus
parents:
diff changeset
   549
    "fill in some defaults - some of them are usually redefined in subclasses
48194c26a46c Initial revision
claus
parents:
diff changeset
   550
     initialize methods"
48194c26a46c Initial revision
claus
parents:
diff changeset
   551
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   552
    name := self class name asString asLowercaseFirst.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   553
    ext := self class defaultExtent.
48194c26a46c Initial revision
claus
parents:
diff changeset
   554
48194c26a46c Initial revision
claus
parents:
diff changeset
   555
    level := 0.
48194c26a46c Initial revision
claus
parents:
diff changeset
   556
    margin := 0.
48194c26a46c Initial revision
claus
parents:
diff changeset
   557
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   558
    resources := self class classResources.
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   559
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   560
    self initStyle.
48194c26a46c Initial revision
claus
parents:
diff changeset
   561
48194c26a46c Initial revision
claus
parents:
diff changeset
   562
    left := 0.
48194c26a46c Initial revision
claus
parents:
diff changeset
   563
    top := 0.
48194c26a46c Initial revision
claus
parents:
diff changeset
   564
    width := ext x.
48194c26a46c Initial revision
claus
parents:
diff changeset
   565
    height := ext y.
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   566
"/    leftInset := 0.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   567
"/    topInset := 0.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   568
"/    rightInset := 0.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   569
"/    bottomInset := 0.
42
ace6ce40b2f8 *** empty log message ***
claus
parents: 41
diff changeset
   570
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   571
    viewOrigin := 0@0.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   572
    originChanged := extentChanged := false.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   573
    bitGravity := nil.
48194c26a46c Initial revision
claus
parents:
diff changeset
   574
    viewGravity := nil.
48194c26a46c Initial revision
claus
parents:
diff changeset
   575
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   576
"
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   577
    controller := self defaultController new.
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   578
    controller view:self.
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   579
"
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   580
!
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   581
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   582
defaultController
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   583
    ^ Controller
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   584
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   585
48194c26a46c Initial revision
claus
parents:
diff changeset
   586
initStyle
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   587
    "this method sets up all style dependent things"
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   588
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   589
    "
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   590
     when coming here the first time, we read the styleSheet
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   591
     and keep the values in fast class variables
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   592
    "
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   593
    StyleSheet isNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   594
	self class updateStyleCache
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   595
    ].
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
   596
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   597
    style := DefaultStyle.
48194c26a46c Initial revision
claus
parents:
diff changeset
   598
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   599
    borderWidth := DefaultBorderWidth.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   600
    borderWidth isNil ifTrue:[borderWidth := 1].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   601
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   602
    viewBackground := DefaultViewBackgroundColor on:device.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   603
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   604
    DefaultLightColor notNil ifTrue:[
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   605
	lightColor := DefaultLightColor.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   606
    ] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   607
	device hasGreyscales ifTrue:[
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   608
	    lightColor := viewBackground lightened
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   609
	] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   610
	    "
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   611
	     this seems strange: on B&W light color is darker than
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   612
	     normal viewBackground (White) to make the boundary of
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   613
	     the view visible
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   614
	    "
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   615
	    lightColor := Color grey:50
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   616
	]
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   617
    ].
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   618
    DefaultShadowColor notNil ifTrue:[
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   619
	shadowColor := DefaultShadowColor.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   620
    ] ifFalse:[
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   621
	shadowColor := Black
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   622
    ].
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   623
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   624
    lightColor := lightColor on:device.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   625
    shadowColor := shadowColor on:device.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   626
    borderColor := DefaultBorderColor on:device.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   627
    font := DefaultFont on:device.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   628
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   629
48194c26a46c Initial revision
claus
parents:
diff changeset
   630
initEvents
48194c26a46c Initial revision
claus
parents:
diff changeset
   631
    "will be sent by create - can be redefined by subclasses to enable
48194c26a46c Initial revision
claus
parents:
diff changeset
   632
     view events"
48194c26a46c Initial revision
claus
parents:
diff changeset
   633
48194c26a46c Initial revision
claus
parents:
diff changeset
   634
    ^ self
48194c26a46c Initial revision
claus
parents:
diff changeset
   635
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   636
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   637
prepareForReinit
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   638
    super prepareForReinit.
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   639
    windowGroup notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   640
	windowGroup reinitialize
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   641
    ]
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   642
!
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   643
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   644
reinitialize
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   645
    "this is called right snapIn"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   646
48194c26a46c Initial revision
claus
parents:
diff changeset
   647
    |myController|
48194c26a46c Initial revision
claus
parents:
diff changeset
   648
48194c26a46c Initial revision
claus
parents:
diff changeset
   649
    "if I have already been reinited - return"
48194c26a46c Initial revision
claus
parents:
diff changeset
   650
    drawableId notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   651
	^ self
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   652
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   653
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   654
    "
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   655
     superView must be there, first
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   656
    "
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   657
    superView notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   658
	superView id isNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   659
	    superView reinitialize
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   660
	]
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   661
    ].
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   662
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   663
    myController := controller.
48194c26a46c Initial revision
claus
parents:
diff changeset
   664
    controller := nil.
48194c26a46c Initial revision
claus
parents:
diff changeset
   665
    self recreate.
48194c26a46c Initial revision
claus
parents:
diff changeset
   666
48194c26a46c Initial revision
claus
parents:
diff changeset
   667
    "if I was mapped, do it again"
48194c26a46c Initial revision
claus
parents:
diff changeset
   668
    realized ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   669
	"only remap if I have a superview - otherwise, I might be
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   670
	 a hidden iconView or menu ..."
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   671
	superView notNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   672
	    shown ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   673
		device mapView:self id:drawableId iconified:false
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   674
			   atX:left y:top width:width height:height
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   675
	    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   676
	].
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   677
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   678
"/        "if it was iconified, try to remap iconified"
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   679
"/        shown ifFalse:[
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   680
"/            device mapView:self id:drawableId iconified:true
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   681
"/                       atX:left y:top width:width height:height
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   682
"/        ] ifTrue:[
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   683
"/            device mapView:self id:drawableId iconified:false
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   684
"/                       atX:left y:top width:width height:height
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   685
"/        ].
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   686
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   687
"/        "and restart the window-group process"
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   688
"/        windowGroup notNil ifTrue:[
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   689
"/            windowGroup startup
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
   690
"/        ]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   691
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   692
48194c26a46c Initial revision
claus
parents:
diff changeset
   693
    "restore controller"
48194c26a46c Initial revision
claus
parents:
diff changeset
   694
    controller := myController
48194c26a46c Initial revision
claus
parents:
diff changeset
   695
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   696
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   697
reinitStyle
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   698
    "this method is called for a style change"
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   699
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   700
    |t|
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   701
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   702
    self initStyle.
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   703
    drawableId notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   704
	"force a change"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   705
	t := borderWidth. borderWidth := nil. self borderWidth:t.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   706
	t := viewBackground. viewBackground := nil. self viewBackground:t.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   707
	self clear.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   708
	self redraw
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   709
    ].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   710
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   711
48194c26a46c Initial revision
claus
parents:
diff changeset
   712
!View methodsFor:'accessing-mvc'!
48194c26a46c Initial revision
claus
parents:
diff changeset
   713
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   714
windowGroup
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   715
    "return the window group. For old style views, return nil"
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   716
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   717
    ^ windowGroup
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   718
!
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   719
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   720
windowGroup:aGroup
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   721
    "set the window group."
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   722
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   723
    windowGroup := aGroup
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   724
!
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
   725
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   726
controller
48194c26a46c Initial revision
claus
parents:
diff changeset
   727
    "return the controller. For non MVC views, return nil"
48194c26a46c Initial revision
claus
parents:
diff changeset
   728
48194c26a46c Initial revision
claus
parents:
diff changeset
   729
    ^ controller
48194c26a46c Initial revision
claus
parents:
diff changeset
   730
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   731
48194c26a46c Initial revision
claus
parents:
diff changeset
   732
controller:aController
48194c26a46c Initial revision
claus
parents:
diff changeset
   733
    "set the controller"
48194c26a46c Initial revision
claus
parents:
diff changeset
   734
48194c26a46c Initial revision
claus
parents:
diff changeset
   735
    controller := aController.
48194c26a46c Initial revision
claus
parents:
diff changeset
   736
    controller view:self.
48194c26a46c Initial revision
claus
parents:
diff changeset
   737
    controller model:model
48194c26a46c Initial revision
claus
parents:
diff changeset
   738
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   739
48194c26a46c Initial revision
claus
parents:
diff changeset
   740
model
48194c26a46c Initial revision
claus
parents:
diff changeset
   741
    "return the model, for non-MVC views,
48194c26a46c Initial revision
claus
parents:
diff changeset
   742
     this is usually the receiver"
48194c26a46c Initial revision
claus
parents:
diff changeset
   743
48194c26a46c Initial revision
claus
parents:
diff changeset
   744
    ^ model
48194c26a46c Initial revision
claus
parents:
diff changeset
   745
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   746
48194c26a46c Initial revision
claus
parents:
diff changeset
   747
model:aModel
48194c26a46c Initial revision
claus
parents:
diff changeset
   748
    "set the model"
48194c26a46c Initial revision
claus
parents:
diff changeset
   749
48194c26a46c Initial revision
claus
parents:
diff changeset
   750
    model notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   751
	model removeDependent:self
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   752
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   753
    model := aModel.
48194c26a46c Initial revision
claus
parents:
diff changeset
   754
    model notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   755
	aModel addDependent:self
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   756
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   757
    controller notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   758
	controller model:aModel
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   759
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   760
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   761
48194c26a46c Initial revision
claus
parents:
diff changeset
   762
on: anObject aspect: aspectMsg change: changeMsg menu: menuMsg
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   763
    "ST-80 compatibility: set model, aspect, change and menu
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   764
     messages - needs a view which uses these"
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   765
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   766
    self model:anObject.
48194c26a46c Initial revision
claus
parents:
diff changeset
   767
    self aspect:aspectMsg.
48194c26a46c Initial revision
claus
parents:
diff changeset
   768
    self change:changeMsg.
48194c26a46c Initial revision
claus
parents:
diff changeset
   769
    self menu:menuMsg
48194c26a46c Initial revision
claus
parents:
diff changeset
   770
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   771
48194c26a46c Initial revision
claus
parents:
diff changeset
   772
aspect:aspectMsg
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   773
    aspectSymbol := aspectMsg
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   774
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   775
48194c26a46c Initial revision
claus
parents:
diff changeset
   776
change:changeMsg
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   777
    "ST-80 style change notification. If a views changeSymbol is nonNil, 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   778
     it will send it to its model when something changes."
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   779
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   780
    changeSymbol := changeMsg
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   781
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   782
48194c26a46c Initial revision
claus
parents:
diff changeset
   783
menu:menuMsg
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   784
    "ST-80 style menus. If a views menuSymbol is nonNil, it
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   785
     will send it to its model when the middleButton is pressed.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   786
     That method should return nil or the menu to be shown.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   787
     This is useful for very dynamic menus, where it does not
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   788
     make sense to define an initial menu."
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   789
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
   790
    menuSymbol := menuMsg
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   791
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
   792
48194c26a46c Initial revision
claus
parents:
diff changeset
   793
!View methodsFor:'accessing-dimensions'!
48194c26a46c Initial revision
claus
parents:
diff changeset
   794
48194c26a46c Initial revision
claus
parents:
diff changeset
   795
left:aNumber
48194c26a46c Initial revision
claus
parents:
diff changeset
   796
    "set the x position"
48194c26a46c Initial revision
claus
parents:
diff changeset
   797
48194c26a46c Initial revision
claus
parents:
diff changeset
   798
    self origin:(aNumber @ top)
48194c26a46c Initial revision
claus
parents:
diff changeset
   799
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   800
48194c26a46c Initial revision
claus
parents:
diff changeset
   801
top:aNumber
48194c26a46c Initial revision
claus
parents:
diff changeset
   802
    "set the y position"
48194c26a46c Initial revision
claus
parents:
diff changeset
   803
48194c26a46c Initial revision
claus
parents:
diff changeset
   804
    self origin:(left @ aNumber)
48194c26a46c Initial revision
claus
parents:
diff changeset
   805
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   806
48194c26a46c Initial revision
claus
parents:
diff changeset
   807
width:aNumber
48194c26a46c Initial revision
claus
parents:
diff changeset
   808
    "set the views width in pixels"
48194c26a46c Initial revision
claus
parents:
diff changeset
   809
48194c26a46c Initial revision
claus
parents:
diff changeset
   810
    self extent:(aNumber @ height)
48194c26a46c Initial revision
claus
parents:
diff changeset
   811
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   812
48194c26a46c Initial revision
claus
parents:
diff changeset
   813
height:aNumber
48194c26a46c Initial revision
claus
parents:
diff changeset
   814
    "set the views height in pixels"
48194c26a46c Initial revision
claus
parents:
diff changeset
   815
48194c26a46c Initial revision
claus
parents:
diff changeset
   816
    self extent:(width @ aNumber)
48194c26a46c Initial revision
claus
parents:
diff changeset
   817
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   818
48194c26a46c Initial revision
claus
parents:
diff changeset
   819
innerWidth
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   820
    "return the width of the view minus any 3D-shadow-borders"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   821
48194c26a46c Initial revision
claus
parents:
diff changeset
   822
    (level == 0) ifTrue:[^ width].
48194c26a46c Initial revision
claus
parents:
diff changeset
   823
    ^ width - (2 * margin)
48194c26a46c Initial revision
claus
parents:
diff changeset
   824
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   825
48194c26a46c Initial revision
claus
parents:
diff changeset
   826
innerHeight
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   827
    "return the height of the view minus any 3D-shadow-borders"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   828
48194c26a46c Initial revision
claus
parents:
diff changeset
   829
    (margin == 0) ifTrue:[^ height].
48194c26a46c Initial revision
claus
parents:
diff changeset
   830
    ^ height - (2 * margin)
48194c26a46c Initial revision
claus
parents:
diff changeset
   831
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   832
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   833
leftInset:aNumber
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   834
    "set the inset of the left edge; positive is to the right,
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   835
     negative to the left"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   836
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   837
    insets isNil ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   838
	insets := Array new:4 withAll:0.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   839
    ].
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   840
"/    leftInset := aNumber.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   841
    insets at:1 put:aNumber.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   842
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   843
    "force recomputation"
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   844
    drawableId isNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   845
	originChanged := true
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   846
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   847
	self superViewChangedSize
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   848
    ]
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   849
!
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   850
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   851
topInset:aNumber
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   852
    "set the inset of the top edge; positive is to the bottom,
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   853
     negative to the top"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   854
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   855
    insets isNil ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   856
	insets := Array new:4 withAll:0.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   857
    ].
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   858
"/    topInset := aNumber.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   859
    insets at:2 put:aNumber.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   860
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   861
    "force recomputation"
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   862
    drawableId isNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   863
	originChanged := true
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   864
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   865
	self superViewChangedSize
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   866
    ]
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   867
!
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   868
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   869
rightInset:aNumber
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   870
    "set the inset of the right edge; positive is to the left,
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   871
     negative to the right"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   872
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   873
    insets isNil ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   874
	insets := Array new:4 withAll:0.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   875
    ].
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   876
"/    rightInset := aNumber.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   877
    insets at:3 put:aNumber.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   878
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   879
    "force recomputation"
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   880
    drawableId isNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   881
	originChanged := true
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   882
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   883
	self superViewChangedSize
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   884
    ]
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   885
!
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   886
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   887
bottomInset:aNumber
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   888
    "set the inset of the bottom edge; positive is to the top,
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   889
     negative to the bottom"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   890
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   891
    insets isNil ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   892
	insets := Array new:4 withAll:0.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   893
    ].
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   894
"/    bottomInset := aNumber.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   895
    insets at:4 put:aNumber.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
   896
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   897
    "force recomputation"
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   898
    drawableId isNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   899
	originChanged := true
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   900
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   901
	self superViewChangedSize
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   902
    ]
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   903
!
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
   904
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   905
extent:extent
48194c26a46c Initial revision
claus
parents:
diff changeset
   906
    "set the views extent; extent may be:
48194c26a46c Initial revision
claus
parents:
diff changeset
   907
     a point where integer fields mean pixel-values
48194c26a46c Initial revision
claus
parents:
diff changeset
   908
     and float values mean relative-to-superview;
48194c26a46c Initial revision
claus
parents:
diff changeset
   909
     or a block returning a point"
48194c26a46c Initial revision
claus
parents:
diff changeset
   910
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   911
    |w h pixelExtent|
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   912
48194c26a46c Initial revision
claus
parents:
diff changeset
   913
    extent isBlock ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   914
	extentRule := extent.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   915
	drawableId notNil ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   916
	    pixelExtent := extent value
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   917
	] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   918
	    extentChanged := true
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   919
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   920
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   921
	w := extent x.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   922
	h := extent y.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   923
	((w isMemberOf:Float) or:[h isMemberOf:Float]) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   924
	    relativeExtent := extent.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   925
	    pixelExtent := self extentFromRelativeExtent.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   926
	    pixelExtent isNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   927
		extentChanged := true
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   928
	    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   929
	] ifFalse:[
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   930
	    pixelExtent := extent
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   931
	]
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   932
    ].
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   933
    pixelExtent notNil ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   934
	self pixelExtent:pixelExtent
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   935
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
   936
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   937
48194c26a46c Initial revision
claus
parents:
diff changeset
   938
origin:origin
48194c26a46c Initial revision
claus
parents:
diff changeset
   939
    "set the views origin; origin may be:
48194c26a46c Initial revision
claus
parents:
diff changeset
   940
     a point where integer fields mean pixel-values
48194c26a46c Initial revision
claus
parents:
diff changeset
   941
     and float values mean relative-to-superview;
48194c26a46c Initial revision
claus
parents:
diff changeset
   942
     or a block returning a point"
48194c26a46c Initial revision
claus
parents:
diff changeset
   943
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   944
    |newLeft newTop pixelOrigin|
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   945
48194c26a46c Initial revision
claus
parents:
diff changeset
   946
    origin isBlock ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   947
	originRule := origin.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   948
	drawableId notNil ifTrue:[
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   949
	    pixelOrigin := origin value
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   950
	] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   951
	    originChanged := true
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   952
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   953
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   954
	newLeft := origin x.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   955
	newTop := origin y.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   956
	((newLeft isMemberOf:Float) or:[newTop isMemberOf:Float]) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   957
	    relativeOrigin := origin.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   958
	    pixelOrigin := self originFromRelativeOrigin.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   959
	    pixelOrigin isNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   960
		originChanged := true
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   961
	    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   962
	] ifFalse:[
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   963
	    pixelOrigin := origin
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   964
	]
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   965
    ].
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   966
    pixelOrigin notNil ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   967
	self pixelOrigin:pixelOrigin
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
   968
    ].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   969
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   970
48194c26a46c Initial revision
claus
parents:
diff changeset
   971
origin:origin corner:corner 
48194c26a46c Initial revision
claus
parents:
diff changeset
   972
    "set both origin and extent"
48194c26a46c Initial revision
claus
parents:
diff changeset
   973
48194c26a46c Initial revision
claus
parents:
diff changeset
   974
    |newLeft newTop newRight newBot|
48194c26a46c Initial revision
claus
parents:
diff changeset
   975
48194c26a46c Initial revision
claus
parents:
diff changeset
   976
    "do it as one operation if possible"
48194c26a46c Initial revision
claus
parents:
diff changeset
   977
48194c26a46c Initial revision
claus
parents:
diff changeset
   978
    origin isBlock ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   979
	corner isBlock ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   980
	    newLeft := origin x.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   981
	    (newLeft isMemberOf:Float) ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   982
		newTop := origin y.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   983
		(newTop isMemberOf:Float) ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   984
		    newRight := corner x.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   985
		    (newRight isMemberOf:Float) ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   986
			newBot := corner y.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   987
			(newBot isMemberOf:Float) ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   988
			    self pixelOrigin:origin corner:corner 
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   989
			]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   990
		    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   991
		]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   992
	    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
   993
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
   994
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
   995
    self origin:origin.
48194c26a46c Initial revision
claus
parents:
diff changeset
   996
    self corner:corner 
48194c26a46c Initial revision
claus
parents:
diff changeset
   997
!
48194c26a46c Initial revision
claus
parents:
diff changeset
   998
48194c26a46c Initial revision
claus
parents:
diff changeset
   999
origin:origin extent:extent
48194c26a46c Initial revision
claus
parents:
diff changeset
  1000
    "set both origin and extent"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1001
48194c26a46c Initial revision
claus
parents:
diff changeset
  1002
    |newLeft newTop newWidth newHeight|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1003
48194c26a46c Initial revision
claus
parents:
diff changeset
  1004
    "do it as one operation if possible"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1005
48194c26a46c Initial revision
claus
parents:
diff changeset
  1006
    origin isBlock ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1007
	extent isBlock ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1008
	    newLeft := origin x.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1009
	    (newLeft isMemberOf:Float) ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1010
		newTop := origin y.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1011
		(newTop isMemberOf:Float) ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1012
		    newWidth := extent x.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1013
		    (newWidth isMemberOf:Float) ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1014
			newHeight := extent y.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1015
			(newHeight isMemberOf:Float) ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1016
			    self pixelOrigin:origin extent:extent
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1017
			]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1018
		    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1019
		]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1020
	    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1021
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1022
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1023
    self extent:extent.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1024
    self origin:origin
48194c26a46c Initial revision
claus
parents:
diff changeset
  1025
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1026
48194c26a46c Initial revision
claus
parents:
diff changeset
  1027
left:newLeft top:newTop width:newWidth height:newHeight
48194c26a46c Initial revision
claus
parents:
diff changeset
  1028
    "another way of specifying origin and extent"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1029
48194c26a46c Initial revision
claus
parents:
diff changeset
  1030
    self origin:(newLeft @ newTop) extent:(newWidth @ newHeight)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1031
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1032
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1033
makeFullyVisible
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1034
    "make sure, that the view is fully visible by shifting it
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1035
     into the visible screen area if nescessary"
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1036
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1037
    ((top + height) > (device height)) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1038
	self top:(device height - height)
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1039
    ].
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1040
    ((left + width) > (device width)) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1041
	self left:(device width - width)
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1042
    ].
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1043
    (top < 0) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1044
	self top:0
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1045
    ].
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1046
    (left < 0) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1047
	self left:0
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1048
    ].
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1049
!
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1050
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1051
relativeOrigin
48194c26a46c Initial revision
claus
parents:
diff changeset
  1052
    "return the relative origin or nil"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1053
48194c26a46c Initial revision
claus
parents:
diff changeset
  1054
    ^ relativeOrigin
48194c26a46c Initial revision
claus
parents:
diff changeset
  1055
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1056
48194c26a46c Initial revision
claus
parents:
diff changeset
  1057
relativeCorner
48194c26a46c Initial revision
claus
parents:
diff changeset
  1058
    "return the relative corner or nil"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1059
48194c26a46c Initial revision
claus
parents:
diff changeset
  1060
    ^ relativeCorner
48194c26a46c Initial revision
claus
parents:
diff changeset
  1061
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1062
48194c26a46c Initial revision
claus
parents:
diff changeset
  1063
relativeExtent
48194c26a46c Initial revision
claus
parents:
diff changeset
  1064
    "return the relative extent or nil"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1065
48194c26a46c Initial revision
claus
parents:
diff changeset
  1066
    ^ relativeExtent
48194c26a46c Initial revision
claus
parents:
diff changeset
  1067
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1068
48194c26a46c Initial revision
claus
parents:
diff changeset
  1069
relativeOrigin:aPoint
48194c26a46c Initial revision
claus
parents:
diff changeset
  1070
    "set the relative origin"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1071
48194c26a46c Initial revision
claus
parents:
diff changeset
  1072
    relativeOrigin := aPoint
48194c26a46c Initial revision
claus
parents:
diff changeset
  1073
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1074
48194c26a46c Initial revision
claus
parents:
diff changeset
  1075
relativeCorner:aPoint
48194c26a46c Initial revision
claus
parents:
diff changeset
  1076
    "set the relative corner"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1077
48194c26a46c Initial revision
claus
parents:
diff changeset
  1078
    relativeCorner := aPoint
48194c26a46c Initial revision
claus
parents:
diff changeset
  1079
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1080
48194c26a46c Initial revision
claus
parents:
diff changeset
  1081
relativeExtent:aPoint
48194c26a46c Initial revision
claus
parents:
diff changeset
  1082
    "set the relative extent"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1083
48194c26a46c Initial revision
claus
parents:
diff changeset
  1084
    relativeExtent := aPoint
48194c26a46c Initial revision
claus
parents:
diff changeset
  1085
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1086
48194c26a46c Initial revision
claus
parents:
diff changeset
  1087
center:newCenter
48194c26a46c Initial revision
claus
parents:
diff changeset
  1088
    "move the receiver so that newCenter, aPoint becomes the center point"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1089
48194c26a46c Initial revision
claus
parents:
diff changeset
  1090
    self origin:(newCenter - ((width // 2) @ (height // 2)))
48194c26a46c Initial revision
claus
parents:
diff changeset
  1091
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1092
48194c26a46c Initial revision
claus
parents:
diff changeset
  1093
center
48194c26a46c Initial revision
claus
parents:
diff changeset
  1094
    "return the point at the center of the receiver"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1095
48194c26a46c Initial revision
claus
parents:
diff changeset
  1096
    ^ (left + (width // 2)) @ (top + (height // 2))
48194c26a46c Initial revision
claus
parents:
diff changeset
  1097
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1098
48194c26a46c Initial revision
claus
parents:
diff changeset
  1099
origin
48194c26a46c Initial revision
claus
parents:
diff changeset
  1100
    "return the origin (in pixels)"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1101
48194c26a46c Initial revision
claus
parents:
diff changeset
  1102
    ^ left@top
48194c26a46c Initial revision
claus
parents:
diff changeset
  1103
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1104
48194c26a46c Initial revision
claus
parents:
diff changeset
  1105
originRelativeTo:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
  1106
    "return the origin (in pixels) relative to a superView"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1107
48194c26a46c Initial revision
claus
parents:
diff changeset
  1108
    |currentView
48194c26a46c Initial revision
claus
parents:
diff changeset
  1109
     org  "{ Class: Point }"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1110
     sumX "{ Class: SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1111
     sumY "{ Class: SmallInteger }" |
48194c26a46c Initial revision
claus
parents:
diff changeset
  1112
48194c26a46c Initial revision
claus
parents:
diff changeset
  1113
    currentView := self.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1114
    sumX := 0.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1115
    sumY := 0.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1116
    [currentView notNil] whileTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1117
	(currentView == aView) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1118
	    ^ (sumX @ sumY)
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1119
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1120
	org := currentView origin.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1121
	sumX := sumX + org x.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1122
	sumY := sumY + org y.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1123
	currentView := currentView superView
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1124
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1125
    ^ nil
48194c26a46c Initial revision
claus
parents:
diff changeset
  1126
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1127
48194c26a46c Initial revision
claus
parents:
diff changeset
  1128
left
48194c26a46c Initial revision
claus
parents:
diff changeset
  1129
    "return the x position of the left border"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1130
48194c26a46c Initial revision
claus
parents:
diff changeset
  1131
    ^ left
48194c26a46c Initial revision
claus
parents:
diff changeset
  1132
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1133
48194c26a46c Initial revision
claus
parents:
diff changeset
  1134
right
48194c26a46c Initial revision
claus
parents:
diff changeset
  1135
    "return the x position of the right border"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1136
48194c26a46c Initial revision
claus
parents:
diff changeset
  1137
    ^ left + width - 1
48194c26a46c Initial revision
claus
parents:
diff changeset
  1138
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1139
48194c26a46c Initial revision
claus
parents:
diff changeset
  1140
top
48194c26a46c Initial revision
claus
parents:
diff changeset
  1141
    "return the y position of the top border"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1142
48194c26a46c Initial revision
claus
parents:
diff changeset
  1143
    ^ top
48194c26a46c Initial revision
claus
parents:
diff changeset
  1144
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1145
48194c26a46c Initial revision
claus
parents:
diff changeset
  1146
bottom
48194c26a46c Initial revision
claus
parents:
diff changeset
  1147
    "return the y position of the bottom border"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1148
48194c26a46c Initial revision
claus
parents:
diff changeset
  1149
    ^ top + height - 1
48194c26a46c Initial revision
claus
parents:
diff changeset
  1150
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1151
48194c26a46c Initial revision
claus
parents:
diff changeset
  1152
corner
48194c26a46c Initial revision
claus
parents:
diff changeset
  1153
    "return the lower right corner-point"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1154
48194c26a46c Initial revision
claus
parents:
diff changeset
  1155
    ^ (left + width - 1) @ (top + height - 1)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1156
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1157
48194c26a46c Initial revision
claus
parents:
diff changeset
  1158
corner:corner 
48194c26a46c Initial revision
claus
parents:
diff changeset
  1159
    "set the views  corner;  corner may be:
48194c26a46c Initial revision
claus
parents:
diff changeset
  1160
     a point where integer fields mean pixel-values
48194c26a46c Initial revision
claus
parents:
diff changeset
  1161
     and float values mean relative-to-superview;
48194c26a46c Initial revision
claus
parents:
diff changeset
  1162
     or a block returning a point"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1163
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1164
    |x y pixelCorner|
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1165
48194c26a46c Initial revision
claus
parents:
diff changeset
  1166
    corner isBlock ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1167
	cornerRule := corner.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1168
	drawableId notNil ifTrue:[    
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1169
	    pixelCorner := corner value
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1170
	] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1171
	    extentChanged := true
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1172
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1173
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1174
	x := corner x.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1175
	y := corner y.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1176
	((x isMemberOf:Float) or:[y isMemberOf:Float]) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1177
	    relativeCorner := corner.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1178
	    pixelCorner := self cornerFromRelativeCorner.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1179
	    pixelCorner isNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1180
		extentChanged := true
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1181
	    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1182
	] ifFalse:[
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1183
	    pixelCorner := corner
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1184
	]
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1185
    ].
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1186
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1187
    pixelCorner notNil ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1188
	self pixelCorner:pixelCorner
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1189
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1190
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1191
48194c26a46c Initial revision
claus
parents:
diff changeset
  1192
!View methodsFor:'accessing-transformation'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1193
48194c26a46c Initial revision
claus
parents:
diff changeset
  1194
window
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1195
    "return my window (i.e. logical coordinate space).
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1196
     If there is no window, return the extent."
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1197
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1198
    window isNil ifTrue:[^ width @ height].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1199
    ^ window
48194c26a46c Initial revision
claus
parents:
diff changeset
  1200
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1201
48194c26a46c Initial revision
claus
parents:
diff changeset
  1202
window:aRectangle
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1203
    "define my window (i.e. logical coordinate space)"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1204
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1205
    window := aRectangle.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1206
    subViews notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1207
	subViews do:[:s |
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1208
	    s superViewChangedSize
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1209
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1210
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1211
48194c26a46c Initial revision
claus
parents:
diff changeset
  1212
"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1213
    viewport isNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1214
	viewport := aRectangle.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1215
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1216
"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1217
"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1218
    superView notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1219
	self superViewChangedSize
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1220
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1221
	originChanged := true.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1222
	extentChanged := true
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1223
    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1224
"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1225
!
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1226
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1227
viewport:aRectangle
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1228
    "define my extend in my superviews coordinate-system."
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1229
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1230
    |relW relH relX relY winW winH|
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1231
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1232
    viewport := aRectangle.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1233
    self dimensionFromViewport
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1234
"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1235
    superView notNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1236
	superView window isNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1237
	    winW := 1.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1238
	    winH := 1
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1239
	] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1240
	    winW := superView window width.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1241
	    winH := superView window height
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1242
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1243
	relW := (aRectangle width / winW) asFloat.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1244
	relH := (aRectangle height / winH) asFloat.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1245
	relX := (aRectangle left / winW) asFloat.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1246
	relY := (aRectangle top / winH) asFloat.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1247
	self origin:(relX @ relY) extent:(relW @ relH)
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1248
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1249
"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1250
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1251
48194c26a46c Initial revision
claus
parents:
diff changeset
  1252
window:aRectangle viewport:vRect
48194c26a46c Initial revision
claus
parents:
diff changeset
  1253
    window := aRectangle.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1254
    self viewport:vRect.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1255
    subViews notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1256
	subViews do:[:s |
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1257
	    s superViewChangedSize
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1258
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1259
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1260
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1261
48194c26a46c Initial revision
claus
parents:
diff changeset
  1262
transformation 
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1263
    "return the transformation"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1264
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1265
    |vP|
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1266
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1267
    transformation isNil ifTrue:[
78
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  1268
	"
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  1269
	 fake a transformation, if I have a non-nil window
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  1270
	"
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  1271
	window notNil ifTrue:[
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  1272
	    superView isNil ifTrue:[
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1273
		vP := (0@0 extent:self extent)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1274
	    ] ifFalse:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1275
		vP := (self origin extent:self extent)
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1276
	    ].
78
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  1277
	    ^ WindowingTransformation 
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1278
				  window:window
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1279
				  viewport:vP
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1280
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1281
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1282
    ^ transformation
48194c26a46c Initial revision
claus
parents:
diff changeset
  1283
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1284
48194c26a46c Initial revision
claus
parents:
diff changeset
  1285
displayTransformation
48194c26a46c Initial revision
claus
parents:
diff changeset
  1286
    "ST-80 compatibility - ST/X does not draw onto the display"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1287
48194c26a46c Initial revision
claus
parents:
diff changeset
  1288
    ^ self transformation
48194c26a46c Initial revision
claus
parents:
diff changeset
  1289
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1290
48194c26a46c Initial revision
claus
parents:
diff changeset
  1291
displayTransform:aPoint
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1292
    "given a point in logical coordinate space, return corresponding
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1293
     point in device coordinates"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1294
48194c26a46c Initial revision
claus
parents:
diff changeset
  1295
    |nx ny|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1296
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1297
    transformation notNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1298
	^ transformation applyTo:aPoint x
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1299
    ].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1300
    nx := aPoint x - window left * width / window width.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1301
    ny := aPoint y - window top * height / window height.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1302
    ^ nx @ ny
48194c26a46c Initial revision
claus
parents:
diff changeset
  1303
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1304
48194c26a46c Initial revision
claus
parents:
diff changeset
  1305
inverseDisplayTransform:aPoint
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1306
    "given a point in device coordinates (such as a button-press-point),
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1307
     return corresponding point in logical coordinates"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1308
48194c26a46c Initial revision
claus
parents:
diff changeset
  1309
    |nx ny|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1310
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1311
    transformation notNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1312
	^ transformation applyInverseTo:aPoint x
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1313
    ].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1314
    window isNil ifTrue:[^ aPoint].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1315
    nx := aPoint x * window width / width + window left.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1316
    ny := aPoint y * window height / height + window top.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1317
    ^ nx @ ny
48194c26a46c Initial revision
claus
parents:
diff changeset
  1318
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1319
48194c26a46c Initial revision
claus
parents:
diff changeset
  1320
viewRectangle
48194c26a46c Initial revision
claus
parents:
diff changeset
  1321
    "return the inside area"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1322
48194c26a46c Initial revision
claus
parents:
diff changeset
  1323
    |m2|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1324
48194c26a46c Initial revision
claus
parents:
diff changeset
  1325
    innerClipRect notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1326
	^ innerClipRect
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1327
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1328
    m2 := margin + margin.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1329
48194c26a46c Initial revision
claus
parents:
diff changeset
  1330
    ^ (margin @ margin) extent:((width - m2) @ (height - m2))
48194c26a46c Initial revision
claus
parents:
diff changeset
  1331
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1332
48194c26a46c Initial revision
claus
parents:
diff changeset
  1333
viewOrigin
48194c26a46c Initial revision
claus
parents:
diff changeset
  1334
    "return the viewOrigin; thats the coordinate of the contents 
48194c26a46c Initial revision
claus
parents:
diff changeset
  1335
     which is shown topLeft in the view 
48194c26a46c Initial revision
claus
parents:
diff changeset
  1336
     (i.e. the origin of the visible part of the contents)."
48194c26a46c Initial revision
claus
parents:
diff changeset
  1337
48194c26a46c Initial revision
claus
parents:
diff changeset
  1338
    ^ viewOrigin
48194c26a46c Initial revision
claus
parents:
diff changeset
  1339
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1340
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1341
setViewOrigin:aPoint
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1342
    "set the viewOrigin - i.e. virtually scroll without redrawing"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1343
48194c26a46c Initial revision
claus
parents:
diff changeset
  1344
    viewOrigin := aPoint
48194c26a46c Initial revision
claus
parents:
diff changeset
  1345
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1346
48194c26a46c Initial revision
claus
parents:
diff changeset
  1347
xOriginOfContents
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1348
    "return the x coordinate of the viewOrigin; 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1349
     used by scrollBars to compute thumb position within the document."
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1350
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1351
    ^ self viewOrigin x
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1352
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1353
48194c26a46c Initial revision
claus
parents:
diff changeset
  1354
yOriginOfContents
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1355
    "return the y coordinate of the viewOrigin; 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1356
     used by scrollBars to compute thumb position within the document."
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1357
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1358
    ^ self viewOrigin y
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1359
!
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1360
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1361
heightOfContents
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1362
    "return the height of the contents in pixels 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1363
     - defaults to views visible area here.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1364
    This method MUST be redefined in all view classess which are
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1365
    going to be scrolled AND show data which has different size than
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1366
    the view. For example, a view showing A4-size documents should return
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1367
    the number of vertical pixels such a document has on this device.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1368
    A view showing a bitmap of height 1000 should return 1000.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1369
    If not redefined, scrollbars have no way of knowing the actual size
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1370
    of the contents being shown. This is called by scrollBars to compute
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1371
    the relative height of the document vs. the views actual size."
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1372
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1373
    ^ self innerHeight
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1374
!
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1375
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1376
widthOfContents
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1377
    "return the width of the contents in pixels
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1378
     - defaults to views visible area here.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1379
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1380
    This method MUST be redefined in all view classess which are
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1381
    going to be scrolled AND show data which has different size than
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1382
    the view. For example, a view showing A4-size documents should return
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1383
    the number of horizontal pixels such a document has on this device.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1384
    A view showing a bitmap of width 700 should return 700.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1385
    If not redefined, scrollbars have no way of knowing the actual size
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1386
    of the contents being shown. This is called by scrollBars to compute
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1387
    the relative width of the document vs. the views actual size."
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1388
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1389
    ^ self innerWidth
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1390
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1391
48194c26a46c Initial revision
claus
parents:
diff changeset
  1392
!View methodsFor:'accessing-hierarchy'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1393
48194c26a46c Initial revision
claus
parents:
diff changeset
  1394
superView
48194c26a46c Initial revision
claus
parents:
diff changeset
  1395
    "return my superView"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1396
48194c26a46c Initial revision
claus
parents:
diff changeset
  1397
    ^ superView
48194c26a46c Initial revision
claus
parents:
diff changeset
  1398
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1399
48194c26a46c Initial revision
claus
parents:
diff changeset
  1400
superView:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
  1401
    "set my superView to be aView"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1402
48194c26a46c Initial revision
claus
parents:
diff changeset
  1403
    superView := aView
48194c26a46c Initial revision
claus
parents:
diff changeset
  1404
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1405
48194c26a46c Initial revision
claus
parents:
diff changeset
  1406
topView
48194c26a46c Initial revision
claus
parents:
diff changeset
  1407
    "return the topView - thats the one with no superview"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1408
48194c26a46c Initial revision
claus
parents:
diff changeset
  1409
    |v|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1410
48194c26a46c Initial revision
claus
parents:
diff changeset
  1411
    v := self.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1412
    [v notNil] whileTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1413
	v superView isNil ifTrue:[^ v].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1414
	v := v superView
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1415
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1416
48194c26a46c Initial revision
claus
parents:
diff changeset
  1417
    ^ nil
48194c26a46c Initial revision
claus
parents:
diff changeset
  1418
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1419
48194c26a46c Initial revision
claus
parents:
diff changeset
  1420
subViews
48194c26a46c Initial revision
claus
parents:
diff changeset
  1421
    "return the collection of subviews"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1422
48194c26a46c Initial revision
claus
parents:
diff changeset
  1423
    ^ subViews
48194c26a46c Initial revision
claus
parents:
diff changeset
  1424
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1425
48194c26a46c Initial revision
claus
parents:
diff changeset
  1426
subViews:aListOfViews
48194c26a46c Initial revision
claus
parents:
diff changeset
  1427
    "set the collection of subviews"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1428
48194c26a46c Initial revision
claus
parents:
diff changeset
  1429
    subViews := aListOfViews.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1430
    subViews notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1431
	subViews do:[:view |
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1432
	    view superView:self
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1433
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1434
    ]
41
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1435
! !
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1436
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1437
!View methodsFor:'queries'!
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1438
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1439
canHandle:aKey
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1440
    "return true, if I like to handle the key (keyPress event)"
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1441
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1442
    ^ true
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1443
!
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1444
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1445
preferedExtent
41
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1446
    "return my preferred extent - this is the minimum size I would like to have.
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1447
     The default here is the actual extent, the receiver currently has."
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1448
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1449
    ^ self extent
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1450
! !
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1451
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1452
!View methodsFor:'enumerating subviews'!
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1453
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1454
allSubViewsDo:aBlock
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1455
    "evaluate aBlock for all subviews (recursively)"
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1456
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1457
    (subViews isNil or:[subViews isEmpty]) ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1458
	subViews do:[:aSubview |
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1459
	    aSubview withAllSubViewsDo:aBlock
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1460
	]
41
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1461
    ]
36
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1462
!
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1463
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1464
withAllSubViewsDo:aBlock
41
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1465
    "evaluate aBlock for the receiver and all subviews (recursively)"
36
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1466
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1467
    aBlock value:self.
41
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1468
    self allSubViewsDo:aBlock
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1469
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1470
48194c26a46c Initial revision
claus
parents:
diff changeset
  1471
!View methodsFor:'accessing-misc'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1472
48194c26a46c Initial revision
claus
parents:
diff changeset
  1473
viewGravity
48194c26a46c Initial revision
claus
parents:
diff changeset
  1474
    "return the viewGravity - thats the direction where the view will move
48194c26a46c Initial revision
claus
parents:
diff changeset
  1475
     when the superView is resized."
48194c26a46c Initial revision
claus
parents:
diff changeset
  1476
48194c26a46c Initial revision
claus
parents:
diff changeset
  1477
    ^ viewGravity
48194c26a46c Initial revision
claus
parents:
diff changeset
  1478
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1479
48194c26a46c Initial revision
claus
parents:
diff changeset
  1480
viewGravity:gravity
48194c26a46c Initial revision
claus
parents:
diff changeset
  1481
    "set the viewGravity - thats the direction where the view will move
48194c26a46c Initial revision
claus
parents:
diff changeset
  1482
     when the superView is resized."
48194c26a46c Initial revision
claus
parents:
diff changeset
  1483
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1484
    viewGravity ~~ gravity ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1485
	viewGravity := gravity.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1486
	drawableId notNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1487
	    device setWindowGravity:gravity in:drawableId
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1488
	]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1489
    ]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1490
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1491
48194c26a46c Initial revision
claus
parents:
diff changeset
  1492
bitGravity
48194c26a46c Initial revision
claus
parents:
diff changeset
  1493
    "return the bitGravity - thats the direction where the contents will move
48194c26a46c Initial revision
claus
parents:
diff changeset
  1494
     when the the view is resized."
48194c26a46c Initial revision
claus
parents:
diff changeset
  1495
48194c26a46c Initial revision
claus
parents:
diff changeset
  1496
    ^ bitGravity
48194c26a46c Initial revision
claus
parents:
diff changeset
  1497
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1498
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1499
bitGravity:gravity
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1500
    "set the bitGravity - thats the direction where the contents will move
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1501
     when the view is resized."
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1502
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1503
    bitGravity ~~ gravity ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1504
	bitGravity := gravity.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1505
	drawableId notNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1506
	    device setBitGravity:gravity in:drawableId
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1507
	]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1508
    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1509
!
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1510
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1511
inputOnly
48194c26a46c Initial revision
claus
parents:
diff changeset
  1512
    "return true, if this view is an input-only view;
48194c26a46c Initial revision
claus
parents:
diff changeset
  1513
     input only views are transparent and can be layed on top of a view to
48194c26a46c Initial revision
claus
parents:
diff changeset
  1514
     catch its input"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1515
48194c26a46c Initial revision
claus
parents:
diff changeset
  1516
    ^ false
48194c26a46c Initial revision
claus
parents:
diff changeset
  1517
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1518
48194c26a46c Initial revision
claus
parents:
diff changeset
  1519
createOnTop
48194c26a46c Initial revision
claus
parents:
diff changeset
  1520
    "return true, if this view should be put on top (raised) automatically.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1521
     usually this is true for alertBoxes etc."
48194c26a46c Initial revision
claus
parents:
diff changeset
  1522
48194c26a46c Initial revision
claus
parents:
diff changeset
  1523
    ^ false
48194c26a46c Initial revision
claus
parents:
diff changeset
  1524
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1525
48194c26a46c Initial revision
claus
parents:
diff changeset
  1526
canDrop:anObjectOrCollection
48194c26a46c Initial revision
claus
parents:
diff changeset
  1527
    "return true, if anObjectOrCollection can be
48194c26a46c Initial revision
claus
parents:
diff changeset
  1528
     dropped in the receiver. This method should be
48194c26a46c Initial revision
claus
parents:
diff changeset
  1529
     redefined in views which can take objects"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1530
48194c26a46c Initial revision
claus
parents:
diff changeset
  1531
    ^ false
48194c26a46c Initial revision
claus
parents:
diff changeset
  1532
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1533
48194c26a46c Initial revision
claus
parents:
diff changeset
  1534
is3D
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  1535
    "return true, if my style is some kind of 3D style - will change"
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  1536
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1537
    ^ StyleSheet is3D
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1538
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1539
48194c26a46c Initial revision
claus
parents:
diff changeset
  1540
shown
48194c26a46c Initial revision
claus
parents:
diff changeset
  1541
    "return true if the view is shown; false if hidden"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1542
48194c26a46c Initial revision
claus
parents:
diff changeset
  1543
    ^ shown
48194c26a46c Initial revision
claus
parents:
diff changeset
  1544
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1545
48194c26a46c Initial revision
claus
parents:
diff changeset
  1546
isCollapsed
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  1547
    "ST80 compatibility: return true if the view is not shown (i.e. iconified)"
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  1548
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1549
    ^ shown not
48194c26a46c Initial revision
claus
parents:
diff changeset
  1550
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1551
48194c26a46c Initial revision
claus
parents:
diff changeset
  1552
hidden:aBoolean
48194c26a46c Initial revision
claus
parents:
diff changeset
  1553
    "if the argument is true, the receiver view will not
48194c26a46c Initial revision
claus
parents:
diff changeset
  1554
     be realized automatically when superview is realized"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1555
48194c26a46c Initial revision
claus
parents:
diff changeset
  1556
    hidden := aBoolean
48194c26a46c Initial revision
claus
parents:
diff changeset
  1557
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1558
48194c26a46c Initial revision
claus
parents:
diff changeset
  1559
hidden
48194c26a46c Initial revision
claus
parents:
diff changeset
  1560
    "return true, if the view does not want to be realized
48194c26a46c Initial revision
claus
parents:
diff changeset
  1561
     automatically when superview is realized"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1562
48194c26a46c Initial revision
claus
parents:
diff changeset
  1563
    ^ hidden
48194c26a46c Initial revision
claus
parents:
diff changeset
  1564
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1565
48194c26a46c Initial revision
claus
parents:
diff changeset
  1566
lower
48194c26a46c Initial revision
claus
parents:
diff changeset
  1567
    "bring to back"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1568
48194c26a46c Initial revision
claus
parents:
diff changeset
  1569
    drawableId isNil ifTrue:[self create].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1570
    device lowerWindow:drawableId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1571
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1572
48194c26a46c Initial revision
claus
parents:
diff changeset
  1573
raise
48194c26a46c Initial revision
claus
parents:
diff changeset
  1574
    "bring to front"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1575
48194c26a46c Initial revision
claus
parents:
diff changeset
  1576
    drawableId isNil ifTrue:[self create].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1577
    device raiseWindow:drawableId
48194c26a46c Initial revision
claus
parents:
diff changeset
  1578
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1579
48194c26a46c Initial revision
claus
parents:
diff changeset
  1580
!View methodsFor:'accessing-bg & border'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1581
48194c26a46c Initial revision
claus
parents:
diff changeset
  1582
viewBackground:something
41
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1583
    "set the viewBackground to something, a color, image or form.
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1584
     If its a color and we run on a color display, also set shadow and light
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1585
     colors - this means, that a red view will get light-red and dark-red
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1586
     edges."
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1587
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  1588
    something isColor ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1589
	device hasGreyscales ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1590
	    shadowColor := something darkened.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1591
	    lightColor := something lightened
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1592
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1593
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1594
    super viewBackground:something
48194c26a46c Initial revision
claus
parents:
diff changeset
  1595
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1596
48194c26a46c Initial revision
claus
parents:
diff changeset
  1597
borderColor
48194c26a46c Initial revision
claus
parents:
diff changeset
  1598
    "return my borderColor"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1599
48194c26a46c Initial revision
claus
parents:
diff changeset
  1600
    ^ borderColor
48194c26a46c Initial revision
claus
parents:
diff changeset
  1601
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1602
48194c26a46c Initial revision
claus
parents:
diff changeset
  1603
borderColor:aColor
48194c26a46c Initial revision
claus
parents:
diff changeset
  1604
    "set my borderColor"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1605
48194c26a46c Initial revision
claus
parents:
diff changeset
  1606
    (aColor ~~ borderColor) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1607
	borderColor := aColor.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1608
	drawableId notNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1609
	    self setBorderColor
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1610
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1611
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1612
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1613
48194c26a46c Initial revision
claus
parents:
diff changeset
  1614
borderWidth
48194c26a46c Initial revision
claus
parents:
diff changeset
  1615
    "return my borderWidth"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1616
48194c26a46c Initial revision
claus
parents:
diff changeset
  1617
    ^ borderWidth
48194c26a46c Initial revision
claus
parents:
diff changeset
  1618
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1619
48194c26a46c Initial revision
claus
parents:
diff changeset
  1620
borderWidth:aNumber
48194c26a46c Initial revision
claus
parents:
diff changeset
  1621
    "set my borderWidth"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1622
48194c26a46c Initial revision
claus
parents:
diff changeset
  1623
    (aNumber ~~ borderWidth) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1624
	borderWidth := aNumber.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1625
	drawableId notNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1626
	    device setWindowBorderWidth:aNumber in:drawableId
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1627
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1628
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1629
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1630
48194c26a46c Initial revision
claus
parents:
diff changeset
  1631
borderShape:aForm
48194c26a46c Initial revision
claus
parents:
diff changeset
  1632
    "set the borderShape to aForm"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1633
48194c26a46c Initial revision
claus
parents:
diff changeset
  1634
    borderShape := aForm.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1635
    drawableId notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1636
	device setWindowBorderShape:(aForm id) in:drawableId
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1637
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1638
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1639
48194c26a46c Initial revision
claus
parents:
diff changeset
  1640
viewShape:aForm
48194c26a46c Initial revision
claus
parents:
diff changeset
  1641
    "set the viewShape to aForm"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1642
48194c26a46c Initial revision
claus
parents:
diff changeset
  1643
    viewShape := aForm.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1644
    drawableId notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1645
	device setWindowShape:(aForm id) in:drawableId
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1646
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1647
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1648
48194c26a46c Initial revision
claus
parents:
diff changeset
  1649
name
48194c26a46c Initial revision
claus
parents:
diff changeset
  1650
    "return my name component to be used for resource-access"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1651
48194c26a46c Initial revision
claus
parents:
diff changeset
  1652
    ^ name
48194c26a46c Initial revision
claus
parents:
diff changeset
  1653
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1654
48194c26a46c Initial revision
claus
parents:
diff changeset
  1655
fullName
48194c26a46c Initial revision
claus
parents:
diff changeset
  1656
    "return my full name to be used for resource-access"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1657
48194c26a46c Initial revision
claus
parents:
diff changeset
  1658
    superView notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1659
	^ superView fullName , '.' , name
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1660
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1661
    ^ name
48194c26a46c Initial revision
claus
parents:
diff changeset
  1662
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1663
48194c26a46c Initial revision
claus
parents:
diff changeset
  1664
name:aString
48194c26a46c Initial revision
claus
parents:
diff changeset
  1665
    "set my name component to be used for resource-access"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1666
48194c26a46c Initial revision
claus
parents:
diff changeset
  1667
    name := aString
48194c26a46c Initial revision
claus
parents:
diff changeset
  1668
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1669
48194c26a46c Initial revision
claus
parents:
diff changeset
  1670
keyboardHandler:someOne
48194c26a46c Initial revision
claus
parents:
diff changeset
  1671
    "set my keyboardHandler"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1672
48194c26a46c Initial revision
claus
parents:
diff changeset
  1673
    keyboardHandler := someOne
48194c26a46c Initial revision
claus
parents:
diff changeset
  1674
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1675
48194c26a46c Initial revision
claus
parents:
diff changeset
  1676
level
48194c26a46c Initial revision
claus
parents:
diff changeset
  1677
    "return my level relative to superView (3D)"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1678
48194c26a46c Initial revision
claus
parents:
diff changeset
  1679
    ^ level
48194c26a46c Initial revision
claus
parents:
diff changeset
  1680
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1681
48194c26a46c Initial revision
claus
parents:
diff changeset
  1682
level:aNumber
48194c26a46c Initial revision
claus
parents:
diff changeset
  1683
    "set my level relative to superView (3D)"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1684
48194c26a46c Initial revision
claus
parents:
diff changeset
  1685
    |oldMargin how|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1686
42
ace6ce40b2f8 *** empty log message ***
claus
parents: 41
diff changeset
  1687
    (aNumber ~~ level) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1688
	self is3D ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1689
	    level := aNumber.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1690
	    oldMargin := margin.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1691
	    margin := level abs.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1692
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1693
	    realized ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1694
		(margin > oldMargin) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1695
		    how := #smaller
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1696
		] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1697
		    how := #larger
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1698
		].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1699
		self sizeChanged:how.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1700
"/                self computeInnerClip.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1701
		self setInnerClip.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1702
		shown ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1703
		    self redrawEdges
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1704
		]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1705
	    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1706
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1707
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1708
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1709
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1710
lightColor:aColorOrImage
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1711
    "set the color to be used for lighted edges (3D only)"
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1712
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1713
    lightColor := aColorOrImage
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1714
!
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1715
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1716
shadowColor:aColorOrImage
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1717
    "set the color to be used for shadowed edges (3D only)"
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1718
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1719
    shadowColor := aColorOrImage
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1720
!
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1721
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1722
margin
48194c26a46c Initial revision
claus
parents:
diff changeset
  1723
    "return my margin - this is usually the level,
48194c26a46c Initial revision
claus
parents:
diff changeset
  1724
     but can be more for some views"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1725
48194c26a46c Initial revision
claus
parents:
diff changeset
  1726
    ^ margin
48194c26a46c Initial revision
claus
parents:
diff changeset
  1727
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1728
48194c26a46c Initial revision
claus
parents:
diff changeset
  1729
widthIncludingBorder
48194c26a46c Initial revision
claus
parents:
diff changeset
  1730
    "return my width including border"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1731
48194c26a46c Initial revision
claus
parents:
diff changeset
  1732
    ^ width + (2*borderWidth)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1733
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1734
48194c26a46c Initial revision
claus
parents:
diff changeset
  1735
heightIncludingBorder
48194c26a46c Initial revision
claus
parents:
diff changeset
  1736
    "return my height including border"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1737
48194c26a46c Initial revision
claus
parents:
diff changeset
  1738
    ^ height + (2*borderWidth)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1739
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1740
48194c26a46c Initial revision
claus
parents:
diff changeset
  1741
!View methodsFor:'adding & removing components'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1742
48194c26a46c Initial revision
claus
parents:
diff changeset
  1743
addComponent:aComponent
48194c26a46c Initial revision
claus
parents:
diff changeset
  1744
    components isNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1745
	components := IdentitySet new
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1746
    ].
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1747
    components add:aComponent.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1748
    aComponent parent:self
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1749
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1750
48194c26a46c Initial revision
claus
parents:
diff changeset
  1751
removeComponent:aComponent
48194c26a46c Initial revision
claus
parents:
diff changeset
  1752
    components isNil ifTrue:[^self].
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1753
    components remove:aComponent ifAbsent:[].
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1754
    aComponent parent:nil 
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1755
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1756
36
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1757
setParentViewIn:aView
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1758
    "common code for addSubView* methods"
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1759
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1760
    aView superView:self.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1761
    (aView device ~~ device) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1762
	'warning subview (' errorPrint. aView class name errorPrint.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1763
	') has different device than me (' errorPrint.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1764
	self class name errorPrint. ').' errorPrintNewline.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1765
	aView device:device
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1766
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1767
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1768
36
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1769
addSubView:newView
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1770
    "add a view to the collection of subviews"
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1771
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1772
    subViews isNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1773
	subViews := OrderedCollection with:newView
36
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1774
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1775
	subViews add:newView.
36
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1776
    ].
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1777
    self setParentViewIn:newView.
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1778
!
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1779
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1780
addSubView:newView after:aView
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1781
    "add a view to the collection of subviews after another view.
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1782
     This makes sense, in Panels and other layout views, to enter a new
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1783
     element at some defined place."
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1784
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1785
    subViews isNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1786
	subViews := OrderedCollection with:newView
36
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1787
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1788
	subViews add:newView after:aView.
36
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1789
    ].
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1790
    self setParentViewIn:newView.
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1791
!
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1792
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  1793
addSubView:newView before:aView
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  1794
    "add a view to the collection of subviews before another view.
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  1795
     This makes sense, in Panels and other layout views, to enter a new
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  1796
     element at some defined place."
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  1797
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  1798
    subViews isNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1799
	subViews := OrderedCollection with:newView
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  1800
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1801
	subViews add:newView before:aView.
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  1802
    ].
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  1803
    self setParentViewIn:newView.
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  1804
!
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  1805
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1806
addSubView:aView in:bounds borderWidth:bw
36
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1807
    "for ST-80 compatibility"
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1808
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1809
    aView borderWidth:bw.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1810
    aView origin:(bounds origin x asFloat) @ (bounds origin y asFloat)
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1811
	  extent:(bounds extent x asFloat) @ (bounds extent y asFloat).
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1812
    self addSubView:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
  1813
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1814
48194c26a46c Initial revision
claus
parents:
diff changeset
  1815
add:aView in:bounds
36
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1816
    "for ST-80 compatibility"
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  1817
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1818
    aView origin:(bounds origin x asFloat) @ (bounds origin y asFloat)
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1819
	  extent:(bounds extent x asFloat) @ (bounds extent y asFloat).
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1820
    self addSubView:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
  1821
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1822
48194c26a46c Initial revision
claus
parents:
diff changeset
  1823
addSubView:aView viewport:aRectangle
48194c26a46c Initial revision
claus
parents:
diff changeset
  1824
    "Adds aView to the views list of subviews and uses the
48194c26a46c Initial revision
claus
parents:
diff changeset
  1825
     existing subviews window and the new viewport to position it"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1826
48194c26a46c Initial revision
claus
parents:
diff changeset
  1827
    self addSubView:aView.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1828
    aView viewport:aRectangle
48194c26a46c Initial revision
claus
parents:
diff changeset
  1829
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1830
48194c26a46c Initial revision
claus
parents:
diff changeset
  1831
addSubView:aView window:aWindowRectangle viewport:aViewportRectangle
48194c26a46c Initial revision
claus
parents:
diff changeset
  1832
    "Adds aView to the views list of subviews and uses 
48194c26a46c Initial revision
claus
parents:
diff changeset
  1833
     aWindowRectangle and aViewportRectangle to position it"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1834
48194c26a46c Initial revision
claus
parents:
diff changeset
  1835
    self addSubView:aView.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1836
    aView window:aWindowRectangle.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1837
    aView viewport:aViewportRectangle
48194c26a46c Initial revision
claus
parents:
diff changeset
  1838
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1839
48194c26a46c Initial revision
claus
parents:
diff changeset
  1840
removeSubView:aView
48194c26a46c Initial revision
claus
parents:
diff changeset
  1841
    "remove a view from the collection of subviews"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1842
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  1843
    subViews notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1844
	subViews remove:aView ifAbsent:[nil].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1845
	(subViews size == 0) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1846
	    subViews := nil
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1847
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1848
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1849
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1850
48194c26a46c Initial revision
claus
parents:
diff changeset
  1851
!View methodsFor:'ST-80 compatibility'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1852
48194c26a46c Initial revision
claus
parents:
diff changeset
  1853
on:aModel aspect:aspect change:change list:list menu:menu
48194c26a46c Initial revision
claus
parents:
diff changeset
  1854
    "ST-80 compatibility"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1855
48194c26a46c Initial revision
claus
parents:
diff changeset
  1856
    aspectSymbol := aspect.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1857
    changeSymbol := change.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1858
    menuSymbol := menu.
48194c26a46c Initial revision
claus
parents:
diff changeset
  1859
    self model:aModel
48194c26a46c Initial revision
claus
parents:
diff changeset
  1860
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1861
48194c26a46c Initial revision
claus
parents:
diff changeset
  1862
sensor
20
ab35d92b9a4b *** empty log message ***
claus
parents: 15
diff changeset
  1863
    "return the views sensor"
ab35d92b9a4b *** empty log message ***
claus
parents: 15
diff changeset
  1864
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  1865
    windowGroup notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1866
	^ windowGroup sensor.
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  1867
    ].
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  1868
    ^ nil
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1869
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1870
48194c26a46c Initial revision
claus
parents:
diff changeset
  1871
update
48194c26a46c Initial revision
claus
parents:
diff changeset
  1872
    ^ self redraw
48194c26a46c Initial revision
claus
parents:
diff changeset
  1873
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1874
48194c26a46c Initial revision
claus
parents:
diff changeset
  1875
update:aspect
48194c26a46c Initial revision
claus
parents:
diff changeset
  1876
    "an update request - should be redefined in subclasses"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1877
48194c26a46c Initial revision
claus
parents:
diff changeset
  1878
    ^ self update
48194c26a46c Initial revision
claus
parents:
diff changeset
  1879
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1880
48194c26a46c Initial revision
claus
parents:
diff changeset
  1881
update:aspect with:anObject
48194c26a46c Initial revision
claus
parents:
diff changeset
  1882
    "an update request - should be redefined in subclasses"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1883
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1884
    "
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1885
     this is a leftover for ST-80 supprto; may vanish
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1886
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1887
    aspect == #rectangle ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1888
	^ self update:#all
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1889
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  1890
    ^ self update:aspect
48194c26a46c Initial revision
claus
parents:
diff changeset
  1891
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1892
48194c26a46c Initial revision
claus
parents:
diff changeset
  1893
!View methodsFor:'informing others of changes'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1894
48194c26a46c Initial revision
claus
parents:
diff changeset
  1895
originWillChange
48194c26a46c Initial revision
claus
parents:
diff changeset
  1896
    "this one is sent, just before viewOrigin changes -
48194c26a46c Initial revision
claus
parents:
diff changeset
  1897
     gives subclasses a chance to catch scrolls easily
48194c26a46c Initial revision
claus
parents:
diff changeset
  1898
     (for example to hide cursor before scroll)"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1899
48194c26a46c Initial revision
claus
parents:
diff changeset
  1900
    ^ self
48194c26a46c Initial revision
claus
parents:
diff changeset
  1901
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1902
48194c26a46c Initial revision
claus
parents:
diff changeset
  1903
originChanged:delta
48194c26a46c Initial revision
claus
parents:
diff changeset
  1904
    "this one is sent, after my origin changed -
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1905
     tell dependents (i.e. scrollers) about this"
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1906
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1907
    self changed:#originOfContents with:delta
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1908
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1909
48194c26a46c Initial revision
claus
parents:
diff changeset
  1910
contentsChanged
48194c26a46c Initial revision
claus
parents:
diff changeset
  1911
    "this one is sent, whenever contents changes size -
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1912
     tell dependents about the change (i.e. scrollers)."
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1913
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1914
    self changed:#sizeOfContents
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1915
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  1916
48194c26a46c Initial revision
claus
parents:
diff changeset
  1917
!View methodsFor:'scrolling'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1918
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1919
widthForScrollBetween:yStart and:yEnd 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1920
    "return the width in pixels for a scroll between yStart and yEnd
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1921
     - return full width here since we do not know how wide contents is.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1922
     Views which only use part of their space (short lists, text) may redefine
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1923
     this method and return the number of pixels that have to be scrolled.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1924
     On slow displays, this may make a difference; on fast ones you will probably
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1925
     not notice any difference."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1926
48194c26a46c Initial revision
claus
parents:
diff changeset
  1927
    ^ (width - margin - margin)
48194c26a46c Initial revision
claus
parents:
diff changeset
  1928
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1929
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1930
verticalScrollStep
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1931
    "return the amount to scroll when stepping up/down.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1932
     Subclasses may want to redefine this."
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1933
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1934
    ^ (device verticalPixelPerMillimeter * 20) asInteger
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1935
!
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1936
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1937
horizontalScrollStep
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1938
    "return the amount to scroll when stepping left/right.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1939
     Subclasses may want to redefine this."
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1940
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1941
    ^ (device horizontalPixelPerMillimeter * 20) asInteger
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1942
!
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  1943
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1944
scrollVerticalToPercent:percent
48194c26a46c Initial revision
claus
parents:
diff changeset
  1945
    "scroll to a position given in percent of total"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1946
48194c26a46c Initial revision
claus
parents:
diff changeset
  1947
    self scrollVerticalTo:
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1948
	    ((((self heightOfContents * percent) / 100.0) + 0.5) asInteger)
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1949
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1950
48194c26a46c Initial revision
claus
parents:
diff changeset
  1951
scrollVerticalTo:aPixelOffset
48194c26a46c Initial revision
claus
parents:
diff changeset
  1952
    "change origin to make aPixelOffset be the top line"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1953
48194c26a46c Initial revision
claus
parents:
diff changeset
  1954
    |orgY|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1955
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1956
    orgY := self viewOrigin y.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1957
48194c26a46c Initial revision
claus
parents:
diff changeset
  1958
    (aPixelOffset < orgY) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1959
	self scrollUp:(orgY - aPixelOffset)
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1960
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1961
	(aPixelOffset > orgY) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1962
	    self scrollDown:(aPixelOffset - orgY)
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1963
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1964
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1965
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1966
48194c26a46c Initial revision
claus
parents:
diff changeset
  1967
scrollHorizontalToPercent:percent
48194c26a46c Initial revision
claus
parents:
diff changeset
  1968
    "scroll to a position given in percent of total"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1969
48194c26a46c Initial revision
claus
parents:
diff changeset
  1970
    self scrollHorizontalTo:
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1971
	    ((((self widthOfContents * percent) / 100.0) + 0.5) asInteger)
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1972
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1973
48194c26a46c Initial revision
claus
parents:
diff changeset
  1974
scrollHorizontalTo:aPixelOffset
48194c26a46c Initial revision
claus
parents:
diff changeset
  1975
    "change origin to make aPixelOffset be the left col"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1976
48194c26a46c Initial revision
claus
parents:
diff changeset
  1977
    |orgX|
48194c26a46c Initial revision
claus
parents:
diff changeset
  1978
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  1979
    orgX := self viewOrigin x.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1980
48194c26a46c Initial revision
claus
parents:
diff changeset
  1981
    (aPixelOffset < orgX) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1982
	self scrollLeft:(orgX - aPixelOffset)
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1983
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1984
	(aPixelOffset > orgX) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1985
	    self scrollRight:(aPixelOffset - orgX)
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  1986
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  1987
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  1988
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1989
48194c26a46c Initial revision
claus
parents:
diff changeset
  1990
scrollTo:aPixelOffset
48194c26a46c Initial revision
claus
parents:
diff changeset
  1991
    "only here for historic reasons - will vanish soon"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1992
48194c26a46c Initial revision
claus
parents:
diff changeset
  1993
    ^ self scrollVerticalTo:aPixelOffset
48194c26a46c Initial revision
claus
parents:
diff changeset
  1994
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  1995
48194c26a46c Initial revision
claus
parents:
diff changeset
  1996
scrollToTop
48194c26a46c Initial revision
claus
parents:
diff changeset
  1997
    "move viewOrigin to top"
48194c26a46c Initial revision
claus
parents:
diff changeset
  1998
48194c26a46c Initial revision
claus
parents:
diff changeset
  1999
    self scrollVerticalTo:0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2000
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2001
2
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
  2002
scrollToTopLeft
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
  2003
    "move viewOrigin to top/left"
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
  2004
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
  2005
    self scrollVerticalTo:0.
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
  2006
    self scrollHorizontalTo:0
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
  2007
!
b35336ab0de3 *** empty log message ***
claus
parents: 0
diff changeset
  2008
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2009
scrollUp:nPixels
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2010
    "change origin to scroll up (towards the origin) by some pixels"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2011
48194c26a46c Initial revision
claus
parents:
diff changeset
  2012
    |count "{ Class:SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2013
     m2    "{ Class:SmallInteger }"
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2014
     w     "{ Class:SmallInteger }"
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2015
     h     "{ Class:SmallInteger }"
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2016
     viewOrigin 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2017
     orgY  "{ Class:SmallInteger }"|
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2018
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2019
    viewOrigin := self viewOrigin.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2020
    orgY := viewOrigin y.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2021
48194c26a46c Initial revision
claus
parents:
diff changeset
  2022
    count := nPixels.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2023
    (count > orgY) ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2024
	count := orgY
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2025
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2026
    (count <= 0) ifTrue:[^ self].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2027
48194c26a46c Initial revision
claus
parents:
diff changeset
  2028
    self originWillChange.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2029
    self setViewOrigin:(viewOrigin x @ (orgY - count)).
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2030
48194c26a46c Initial revision
claus
parents:
diff changeset
  2031
    (count >= self innerHeight) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2032
	self redraw.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2033
    ] ifFalse:[
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2034
	m2 := margin * 2. "top & bottom margins"
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2035
	h := height - m2 - count.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2036
	w := self widthForScrollBetween:orgY and:(orgY + h).
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2037
	w := w min:(width - m2).
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2038
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2039
	self catchExpose.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2040
	self copyFrom:self x:margin y:margin
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2041
			 toX:margin y:(count + margin)
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2042
		       width:w height:h.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2043
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2044
	self redrawDeviceX:margin y:margin
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2045
		     width:(width - m2)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2046
		    height:count.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2047
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2048
	self waitForExpose.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2049
    ].
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2050
    self originChanged:(0 @ count negated).
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2051
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2052
48194c26a46c Initial revision
claus
parents:
diff changeset
  2053
scrollUp
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2054
    "scroll up by some amount; this is called when the scrollbars
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2055
     scroll-step up button is pressed."
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2056
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2057
    self scrollUp:(self verticalScrollStep)
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2058
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2059
48194c26a46c Initial revision
claus
parents:
diff changeset
  2060
scrollDown:nPixels
48194c26a46c Initial revision
claus
parents:
diff changeset
  2061
    "change origin to scroll down some pixels"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2062
48194c26a46c Initial revision
claus
parents:
diff changeset
  2063
    |count "{ Class:SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2064
     m2    "{ Class:SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2065
     w     "{ Class:SmallInteger }"
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2066
     h     "{ Class:SmallInteger }"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2067
     hCont "{ Class:SmallInteger }"
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2068
     ih    "{ Class:SmallInteger }"
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2069
     viewOrigin orgY|
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2070
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2071
    viewOrigin := self viewOrigin.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2072
    orgY := viewOrigin y.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2073
48194c26a46c Initial revision
claus
parents:
diff changeset
  2074
    count := nPixels.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2075
    hCont := self heightOfContents.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2076
    ih := self innerHeight.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2077
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2078
    ((orgY + nPixels + ih) > hCont) ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2079
	count := hCont - orgY - ih
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2080
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2081
    (count <= 0) ifTrue:[^ self].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2082
48194c26a46c Initial revision
claus
parents:
diff changeset
  2083
    self originWillChange.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2084
    viewOrigin := viewOrigin x @ (orgY + count).
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2085
    self setViewOrigin:viewOrigin.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2086
48194c26a46c Initial revision
claus
parents:
diff changeset
  2087
    (count >= ih) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2088
	self redraw.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2089
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2090
	m2 := margin * 2.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2091
	h := height - m2 - count.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2092
	w := self widthForScrollBetween:orgY and:(orgY + h).
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2093
	w := w min:(width - m2).
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2094
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2095
	self catchExpose.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2096
	self copyFrom:self x:margin y:(count + margin)
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2097
			 toX:margin y:margin
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2098
		       width:w 
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2099
		      height:h.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2100
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2101
	self redrawDeviceX:margin y:(h + margin) 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2102
		     width:(width - m2) height:count.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2103
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2104
	self waitForExpose.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2105
    ].
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2106
    self originChanged:(0 @ count).
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2107
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2108
48194c26a46c Initial revision
claus
parents:
diff changeset
  2109
scrollDown
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2110
    "scroll down by some amount; this is called when the scrollbars
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2111
     scroll-step down button is pressed."
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2112
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2113
    self scrollDown:(self verticalScrollStep)
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2114
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2115
48194c26a46c Initial revision
claus
parents:
diff changeset
  2116
scrollLeft:nPixels
48194c26a46c Initial revision
claus
parents:
diff changeset
  2117
    "change origin to scroll left some pixels"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2118
48194c26a46c Initial revision
claus
parents:
diff changeset
  2119
    |count "{ Class:SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2120
     m2    "{ Class:SmallInteger }"
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2121
     h     "{ Class:SmallInteger }"
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2122
     viewOrigin orgX|
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2123
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2124
    viewOrigin := self viewOrigin.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2125
    orgX := viewOrigin x.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2126
48194c26a46c Initial revision
claus
parents:
diff changeset
  2127
    count := nPixels.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2128
    (count > orgX) ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2129
	count := orgX
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2130
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2131
    (count <= 0) ifTrue:[^ self].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2132
48194c26a46c Initial revision
claus
parents:
diff changeset
  2133
    self originWillChange.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2134
    viewOrigin := (orgX - count) @ viewOrigin y.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2135
    self setViewOrigin:viewOrigin.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2136
48194c26a46c Initial revision
claus
parents:
diff changeset
  2137
    (count >= self innerWidth) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2138
	self redraw.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2139
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2140
	m2 := margin * 2.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2141
	h := (height - m2).
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2142
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2143
	self catchExpose.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2144
	self copyFrom:self x:margin y:margin
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2145
			 toX:(count + margin) y:margin
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2146
		       width:(width - m2 - count) 
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2147
		      height:h.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2148
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2149
	self redrawDeviceX:margin y:margin
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2150
		     width:count height:(height - m2).
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2151
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2152
	self waitForExpose.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2153
    ].
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2154
    self originChanged:(count negated @ 0).
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2155
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2156
48194c26a46c Initial revision
claus
parents:
diff changeset
  2157
scrollLeft
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2158
    "scroll left by some amount; this is called when the scrollbars
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2159
     scroll-step left button is pressed."
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2160
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2161
    self scrollLeft:(self horizontalScrollStep)
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2162
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2163
48194c26a46c Initial revision
claus
parents:
diff changeset
  2164
scrollRight:nPixels
48194c26a46c Initial revision
claus
parents:
diff changeset
  2165
    "change origin to scroll right some pixels"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2166
48194c26a46c Initial revision
claus
parents:
diff changeset
  2167
    |count "{ Class:SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2168
     m2    "{ Class:SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2169
     h     "{ Class:SmallInteger }" 
48194c26a46c Initial revision
claus
parents:
diff changeset
  2170
     wCont "{ Class:SmallInteger }"
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2171
     iw    "{ Class:SmallInteger }"
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2172
     viewOrigin orgX|
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2173
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2174
    viewOrigin := self viewOrigin.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2175
    orgX := viewOrigin x.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2176
48194c26a46c Initial revision
claus
parents:
diff changeset
  2177
    count := nPixels.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2178
    wCont := self widthOfContents.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2179
    iw := self innerWidth.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2180
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2181
    ((orgX + nPixels + iw) > wCont) ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2182
	count := wCont - orgX - iw
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2183
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2184
    (count <= 0) ifTrue:[^ self].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2185
48194c26a46c Initial revision
claus
parents:
diff changeset
  2186
    self originWillChange.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2187
    viewOrigin := (orgX + count) @ viewOrigin y.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2188
    self setViewOrigin:viewOrigin.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2189
48194c26a46c Initial revision
claus
parents:
diff changeset
  2190
    (count >= iw) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2191
	self redraw.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2192
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2193
	m2 := margin * 2.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2194
	h := (height - m2).
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2195
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2196
	self catchExpose.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2197
	self copyFrom:self x:(count + margin) y:margin
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2198
			 toX:margin y:margin
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2199
		       width:(width - m2 - count) 
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2200
		      height:h.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2201
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2202
	self redrawDeviceX:(width - margin - count) y:margin 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2203
		     width:count height:(height - m2).
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2204
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2205
	self waitForExpose.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2206
    ].
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2207
    self originChanged:(count @ 0).
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2208
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2209
48194c26a46c Initial revision
claus
parents:
diff changeset
  2210
scrollRight
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2211
    "scroll right by some amount; this is called when the scrollbars
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2212
     scroll-step right button is pressed."
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2213
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2214
    self scrollRight:(self horizontalScrollStep)
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2215
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  2216
48194c26a46c Initial revision
claus
parents:
diff changeset
  2217
!View methodsFor:'private'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2218
48194c26a46c Initial revision
claus
parents:
diff changeset
  2219
pixelExtent:extent
48194c26a46c Initial revision
claus
parents:
diff changeset
  2220
    "set the views extent in pixels"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2221
15
ba1100f2ca03 fixed resize (smaller) border repaint bug
claus
parents: 12
diff changeset
  2222
    self pixelOrigin:(left @ top) extent:extent
ba1100f2ca03 fixed resize (smaller) border repaint bug
claus
parents: 12
diff changeset
  2223
!
ba1100f2ca03 fixed resize (smaller) border repaint bug
claus
parents: 12
diff changeset
  2224
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2225
pixelOrigin:origin
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2226
    "set the views origin in pixels. For subviews. the origin is relative
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2227
     to the superviews top-left. For topViews, its the screen origin."
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2228
48194c26a46c Initial revision
claus
parents:
diff changeset
  2229
    |newLeft newTop|
48194c26a46c Initial revision
claus
parents:
diff changeset
  2230
48194c26a46c Initial revision
claus
parents:
diff changeset
  2231
    newLeft := origin x.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2232
    newTop := origin y.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2233
    ((newTop ~~ top) or:[newLeft ~~ left]) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2234
	top := newTop.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2235
	left := newLeft.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2236
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2237
	"
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2238
	 if the receiver is visible, or is a topView, perform the
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2239
	 operation right away - otherwise, simply remember that the
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2240
	 origin has changed - will tell the display once we get realized
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2241
	"
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2242
	(shown 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2243
	or:[superView isNil and:[drawableId notNil]]) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2244
	    device moveWindow:drawableId x:left y:top
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2245
	] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2246
	    originChanged := true
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2247
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2248
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2249
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2250
48194c26a46c Initial revision
claus
parents:
diff changeset
  2251
pixelCorner:corner
48194c26a46c Initial revision
claus
parents:
diff changeset
  2252
    "set the views corner in pixels"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2253
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2254
    |w h|
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2255
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2256
    w := corner x - left.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2257
    h := corner y - top.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2258
    self pixelOrigin:(left @ top) extent:(w @ h)
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2259
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2260
48194c26a46c Initial revision
claus
parents:
diff changeset
  2261
pixelOrigin:origin corner:corner
48194c26a46c Initial revision
claus
parents:
diff changeset
  2262
    "set the views origin and extent in pixels"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2263
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2264
    |w h|
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2265
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2266
    w := corner x - origin x.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2267
    h := corner y - origin y.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2268
    self pixelOrigin:origin extent:(w @ h)
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2269
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2270
48194c26a46c Initial revision
claus
parents:
diff changeset
  2271
pixelOrigin:origin extent:extent
48194c26a46c Initial revision
claus
parents:
diff changeset
  2272
    "set the views origin and extent in pixels"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2273
15
ba1100f2ca03 fixed resize (smaller) border repaint bug
claus
parents: 12
diff changeset
  2274
    |newLeft newTop newWidth newHeight how 
ba1100f2ca03 fixed resize (smaller) border repaint bug
claus
parents: 12
diff changeset
  2275
     mustRedrawBottomEdge mustRedrawRightEdge mustRepaintBottom
ba1100f2ca03 fixed resize (smaller) border repaint bug
claus
parents: 12
diff changeset
  2276
     mustRepaintRight sameOrigin oldWidth oldHeight|
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2277
48194c26a46c Initial revision
claus
parents:
diff changeset
  2278
    newLeft := origin x.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2279
    newTop := origin y.
15
ba1100f2ca03 fixed resize (smaller) border repaint bug
claus
parents: 12
diff changeset
  2280
    sameOrigin := ((newTop == top) and:[newLeft == left]).
ba1100f2ca03 fixed resize (smaller) border repaint bug
claus
parents: 12
diff changeset
  2281
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2282
    newWidth := extent x.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2283
    newHeight := extent y.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2284
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2285
    newWidth < 0 ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2286
	newWidth := 0.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2287
    ].
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2288
    newHeight < 0 ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2289
	newHeight := 0
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2290
    ].
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2291
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2292
    ((newWidth == width) and:[newHeight == height]) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2293
	sameOrigin ifTrue:[^ self].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2294
	^ self pixelOrigin:origin
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2295
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2296
    top := newTop.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2297
    left := newLeft.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2298
48194c26a46c Initial revision
claus
parents:
diff changeset
  2299
    mustRedrawBottomEdge := (level ~~ 0) and:[newHeight < height].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2300
    mustRedrawRightEdge := (level ~~ 0) and:[newWidth < width].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2301
48194c26a46c Initial revision
claus
parents:
diff changeset
  2302
    ((newHeight <= height) and:[newWidth <= width]) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2303
	how := #smaller
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2304
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2305
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2306
"/    shown ifTrue:[                  "4-nov-94 actually correct,"
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2307
    drawableId notNil ifTrue:[        "but theres a bug in menus when resized while hidden"
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2308
	mustRepaintRight := false.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2309
	mustRepaintBottom := false.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2310
	(level ~~ 0) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2311
	    "clear the old edges"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2312
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2313
	    newWidth > width ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2314
		self clipRect:nil.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2315
		self paint:viewBackground.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2316
		self fillDeviceRectangleX:(width - margin)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2317
					y:0
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2318
				    width:margin
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2319
				   height:height.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2320
		mustRepaintRight := true.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2321
		oldWidth := width
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2322
	    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2323
	    newHeight > height ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2324
		self clipRect:nil.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2325
		self paint:viewBackground.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2326
		self fillDeviceRectangleX:0
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2327
					y:(height - margin)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2328
				    width:width
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2329
				   height:margin.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2330
		mustRepaintBottom := true.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2331
		oldHeight := height
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2332
	    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2333
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2334
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2335
	width := newWidth.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2336
	height := newHeight.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2337
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2338
	self setInnerClip.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2339
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2340
	"if view becomes smaller, send sizeChanged first"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2341
	(how == #smaller) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2342
	    self sizeChanged:how
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2343
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2344
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2345
	"have to tell X, when extent of view is changed"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2346
	sameOrigin ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2347
	    device resizeWindow:drawableId width:width height:height.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2348
	] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2349
	    "claus: some xservers seem to do better when resizing
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2350
	     first ...."
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2351
" 
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2352
	    (how == #smaller) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2353
		device resizeWindow:drawableId width:width height:height.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2354
		device moveWindow:drawableId x:left y:top
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2355
	    ] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2356
		device moveResizeWindow:drawableId x:left y:top width:width height:height
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2357
	    ].
15
ba1100f2ca03 fixed resize (smaller) border repaint bug
claus
parents: 12
diff changeset
  2358
" 
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2359
	    device moveResizeWindow:drawableId x:left y:top
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2360
					   width:width height:height.
15
ba1100f2ca03 fixed resize (smaller) border repaint bug
claus
parents: 12
diff changeset
  2361
" "
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2362
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2363
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2364
	"if view becomes bigger, send sizeChanged after"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2365
	(how ~~ #smaller) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2366
	    self sizeChanged:how
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2367
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2368
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2369
	(mustRedrawBottomEdge or:[mustRedrawRightEdge]) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2370
	    self clipRect:nil.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2371
	    mustRedrawBottomEdge ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2372
		self drawBottomEdge
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2373
	    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2374
	    mustRedrawRightEdge ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2375
		self drawRightEdge
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2376
	    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2377
	    self clipRect:innerClipRect
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2378
	].
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2379
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2380
	mustRepaintRight ifTrue:[
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2381
	    self redrawDeviceX:(oldWidth - margin)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2382
			     y:0
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2383
			 width:margin
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2384
			height:height.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2385
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2386
	mustRepaintBottom ifTrue:[
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2387
	    self redrawDeviceX:0
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2388
			     y:(oldHeight - margin)
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2389
			 width:width
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2390
			height:margin.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2391
	].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2392
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2393
	"otherwise memorize the need for a sizeChanged message"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2394
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2395
	width := newWidth.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2396
	height := newHeight.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2397
	sameOrigin ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2398
	    originChanged := true.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2399
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2400
	extentChanged := true
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2401
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2402
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2403
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2404
pointFromRelative:p
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2405
    "compute absolute coordinate from p"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2406
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2407
    |newX newY rel inRect bw superWidth superHeight superLeft superTop |
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2408
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2409
    bw := borderWidth.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2410
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2411
    superView isNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2412
	superWidth := device width.      
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2413
	superHeight := device height.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2414
	superLeft := superTop := 0.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2415
    ] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2416
	inRect := superView viewRectangle.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2417
	superWidth := inRect width - bw.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2418
	superHeight := inRect height - bw.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2419
	superLeft := inRect left.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2420
	superTop := inRect top.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2421
    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2422
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2423
    rel := p x.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2424
    rel isInteger ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2425
	newX := rel
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2426
    ] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2427
	newX := (rel * (superWidth + bw)) asInteger + superLeft.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2428
	(bw ~~ 0) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2429
	    rel ~= 1.0 ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2430
		newX := newX - bw
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2431
	    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2432
	]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2433
    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2434
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2435
    rel := p y.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2436
    rel isInteger ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2437
	newY := rel
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2438
    ] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2439
	newY := (rel * (superHeight + bw)) asInteger + superTop.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2440
	(bw ~~ 0) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2441
	    rel ~= 1.0 ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2442
		newY := newY - bw
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2443
	    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2444
	]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2445
    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2446
    ^ newX @ newY
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2447
!
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2448
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2449
originFromRelativeOrigin
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2450
    "compute & return pixel origin from relativeOrigin"
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2451
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2452
    ^ self originFromRelativeOrigin:relativeOrigin
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2453
!
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2454
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2455
originFromRelativeOrigin:aPoint
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2456
    "compute & return pixel origin from relativeOrigin, aPoint"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2457
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2458
    |newX newY p l t|
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2459
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2460
    p := self pointFromRelative:aPoint.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2461
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2462
    insets isNil ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2463
	^ p
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2464
    ].
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2465
    l := insets at:1.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2466
    t := insets at:2.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2467
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2468
"/  l := t := 0.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2469
"/    leftInset notNil ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2470
"/        l := leftInset
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2471
"/    ].
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2472
"/    topInset notNil ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2473
"/        t := topInset
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2474
"/    ].
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2475
    ((l ~~ 0) or:[t ~~ 0]) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2476
	newX := p x.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2477
	newY := p y.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2478
	^ (newX + l) @ (newY + t)
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2479
    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2480
    ^ p
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2481
!
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2482
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2483
cornerFromRelativeCorner
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2484
    "compute & return pixel corner from relativeCorner"
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2485
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2486
    ^ self cornerFromRelativeCorner:relativeCorner
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2487
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2488
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2489
cornerFromRelativeCorner:aPoint
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2490
    "compute & return pixel corner from a relativeCorner, aPoint"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2491
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2492
    |newX newY p r b bw|
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2493
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2494
    p := self pointFromRelative:aPoint.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2495
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2496
    bw := borderWidth.
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2497
    insets isNil ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2498
	bw == 0 ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2499
	    ^ p
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2500
	].
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2501
	^ (p x - bw) @ (p y - bw)
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2502
    ].
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2503
    r := insets at:3.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2504
    b := insets at:4.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2505
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2506
"/    r := b := bw.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2507
"/    rightInset notNil ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2508
"/        r := rightInset + bw
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2509
"/    ].
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2510
"/    bottomInset notNil ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2511
"/        b := bottomInset + bw
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2512
"/    ].
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2513
    ((r ~~ 0) or:[b ~~ 0]) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2514
	newX := p x.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2515
	newY := p y.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2516
	^ (newX - r) @ (newY - b)
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2517
    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2518
    ^ p
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2519
!
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2520
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2521
extentFromRelativeExtent
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2522
    "compute & return pixel extent from relativeExtent"
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2523
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2524
    ^ self extentFromRelativeExtent:relativeExtent
42
ace6ce40b2f8 *** empty log message ***
claus
parents: 41
diff changeset
  2525
!
ace6ce40b2f8 *** empty log message ***
claus
parents: 41
diff changeset
  2526
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2527
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2528
extentFromRelativeExtent:aPoint
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2529
    "compute & return pixel extent from relativeExtent, aPoint"
42
ace6ce40b2f8 *** empty log message ***
claus
parents: 41
diff changeset
  2530
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2531
    |rel newX newY inRect bw2 r b|
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2532
41
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  2533
    superView isNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2534
	inRect := 0@0 extent:device extent
41
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  2535
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2536
	inRect := superView viewRectangle.
41
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  2537
    ].
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  2538
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2539
    bw2 := borderWidth * 2.
42
ace6ce40b2f8 *** empty log message ***
claus
parents: 41
diff changeset
  2540
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2541
    rel := aPoint x.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2542
    (rel isMemberOf:Float) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2543
	newX := (rel * (inRect width + bw2)) asInteger + inRect left.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2544
	(borderWidth ~~ 0) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2545
	    newX := newX - borderWidth
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2546
	].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2547
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2548
	newX := rel
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2549
    ].
42
ace6ce40b2f8 *** empty log message ***
claus
parents: 41
diff changeset
  2550
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2551
    rel := aPoint y.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2552
    (rel isMemberOf:Float) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2553
	newY := (rel * (inRect height + bw2)) asInteger + inRect top.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2554
	(borderWidth ~~ 0) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2555
	    newY := newY - borderWidth
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2556
	].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2557
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2558
	newY := rel
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2559
    ].
42
ace6ce40b2f8 *** empty log message ***
claus
parents: 41
diff changeset
  2560
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2561
    insets notNil ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2562
	r := insets at:3.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2563
	(r  ~~ 0) ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2564
	    newX := newX - r
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2565
	].
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2566
	b := insets at:4.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2567
	(b ~~ 0) ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2568
	    newY := newY - b
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  2569
	].
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2570
    ].
42
ace6ce40b2f8 *** empty log message ***
claus
parents: 41
diff changeset
  2571
    ^ newX @ newY
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2572
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2573
48194c26a46c Initial revision
claus
parents:
diff changeset
  2574
dimensionFromViewport
48194c26a46c Initial revision
claus
parents:
diff changeset
  2575
    "define my origin/extend from viewport"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2576
48194c26a46c Initial revision
claus
parents:
diff changeset
  2577
    |relW relH relX relY winW winH org ext|
48194c26a46c Initial revision
claus
parents:
diff changeset
  2578
48194c26a46c Initial revision
claus
parents:
diff changeset
  2579
    superView notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2580
	superView window isNil ifTrue:[
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2581
"
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2582
	    v := superView.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2583
	    (v notNil and:[v window isNil]) whileTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2584
		v := v superview
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2585
	    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2586
	    v notNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2587
		w := v window
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2588
	    ].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2589
"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2590
"
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2591
	    winW := 1.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2592
	    winH := 1
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2593
"
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2594
	    winW := superView width.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2595
	    winH := superView height.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2596
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2597
	] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2598
	    winW := superView window width.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2599
	    winH := superView window height
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2600
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2601
	relW := (viewport width / winW) asFloat.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2602
	relH := (viewport height / winH) asFloat.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2603
	relX := (viewport left / winW) asFloat.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2604
	relY := (viewport top / winH) asFloat.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2605
	"bad coding style ... misuse other method"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2606
	relativeOrigin := (relX @ relY).
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2607
	org := self originFromRelativeOrigin.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2608
	relativeOrigin := nil.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2609
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2610
	"bad coding style ...misuse other method"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2611
	relativeExtent := (relW @ relH).
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2612
	ext := self extentFromRelativeExtent.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2613
	relativeExtent := nil.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2614
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2615
	self pixelOrigin:org extent:ext.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2616
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2617
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2618
48194c26a46c Initial revision
claus
parents:
diff changeset
  2619
computeInnerClip
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2620
    "compute, but do not set the inside clip-area"
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2621
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2622
    |m2 nX nY nW nH|
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2623
48194c26a46c Initial revision
claus
parents:
diff changeset
  2624
    (margin ~~ 0) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2625
	m2 := margin + margin.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2626
	nX := nY := margin.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2627
	nW := width - m2.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2628
	nH := height - m2.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2629
	transformation notNil ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2630
	    nX := transformation applyInverseToX:nX.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2631
	    nY := transformation applyInverseToY:nY.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2632
	    nW := transformation applyInverseScaleX:nW.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2633
	    nH := transformation applyInverseScaleY:nH.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2634
	].
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2635
	innerClipRect := Rectangle 
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2636
				 left:nX 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2637
				 top:nY 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2638
				 width:nW 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2639
				 height:nH
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2640
    ] ifFalse:[
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2641
	"no clipping"
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2642
	innerClipRect := nil
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2643
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2644
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2645
48194c26a46c Initial revision
claus
parents:
diff changeset
  2646
setInnerClip
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2647
    "compute, and set the inside clip-area"
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2648
42
ace6ce40b2f8 *** empty log message ***
claus
parents: 41
diff changeset
  2649
    self computeInnerClip.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2650
    self clipRect:innerClipRect
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2651
!
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2652
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2653
setBorderColor
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2654
    "set my borderColor"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2655
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2656
    |id dither|
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2657
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2658
    drawableId notNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2659
	borderColor := borderColor on:device.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2660
	id := borderColor colorId.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2661
	id notNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2662
	    device setWindowBorderColor:id in:drawableId
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2663
	] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2664
	    dither := borderColor ditherForm.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2665
	    dither notNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2666
		device setWindowBorderPixmap:(dither id) in:drawableId
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2667
	    ] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2668
		'bad borderColor' errorPrintNewline
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2669
	    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2670
	]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2671
    ]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2672
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  2673
48194c26a46c Initial revision
claus
parents:
diff changeset
  2674
!View methodsFor:'realization'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2675
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2676
physicalCreate
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2677
    "common code for create & recreate"
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2678
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2679
    "associate colors to device"
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2680
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2681
    drawableId := device 
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2682
		      createWindowFor:self 
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2683
			  origin:(left @ top)
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2684
			  extent:(width @ height)
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2685
			  minExtent:nil
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2686
			  maxExtent:nil
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2687
			  borderWidth:borderWidth
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2688
			  subViewOf:superView
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2689
			  onTop:(self createOnTop)
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2690
			  inputOnly:(self inputOnly)
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2691
			  label:nil
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2692
			  cursor:cursor
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2693
			  icon:nil
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2694
			  iconView:nil.
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2695
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2696
    extentChanged := false.
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2697
    originChanged := false.
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2698
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2699
    (borderColor and:[borderColor ~~ Black]) ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2700
	borderColor := borderColor on:device.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2701
	self setBorderColor
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2702
    ].
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2703
    (viewGravity notNil "and:[viewGravity ~~ #NorthWest]") ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2704
	device setWindowGravity:viewGravity in:drawableId
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2705
    ].
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  2706
    (bitGravity notNil "and:[bitGravity ~~ #NorthWest]") ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2707
	device setBitGravity:bitGravity in:drawableId
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2708
    ].
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2709
    borderShape notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2710
	device setWindowBorderShape:(borderShape id) in:drawableId
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2711
    ].
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2712
    viewShape notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2713
	device setWindowShape:(viewShape id) in:drawableId
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2714
    ].
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2715
    (backed notNil and:[backed ~~ false]) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2716
	device setBackingStore:backed in:drawableId
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2717
    ].
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2718
    saveUnder ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2719
	device setSaveUnder:true in:drawableId
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2720
    ].
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2721
!
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2722
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2723
create
48194c26a46c Initial revision
claus
parents:
diff changeset
  2724
    "create (i.e. tell X about me)
48194c26a46c Initial revision
claus
parents:
diff changeset
  2725
     this is kind of stupid - creation means XCreateWindow;
48194c26a46c Initial revision
claus
parents:
diff changeset
  2726
     realizing means XMapWindow"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2727
48194c26a46c Initial revision
claus
parents:
diff changeset
  2728
    drawableId isNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2729
	"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2730
	 make certain that superview is created also
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2731
	"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2732
	superView notNil ifTrue:[
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2733
"/            superView id isNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2734
		superView create.
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2735
"/            ].
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2736
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2737
"/            "and put my controller into the superviews controller list"
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2738
"/            controller notNil ifTrue:[
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2739
"/                superView controller notNil ifTrue:[
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2740
"/                    controller manager:(superView controller manager)
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2741
"/                ]
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2742
"/            ]
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2743
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2744
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2745
	cursor := cursor on:device.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2746
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2747
	self physicalCreate.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2748
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2749
	viewBackground notNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2750
	   self setViewBackground
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2751
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2752
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2753
	self initializeMiddleButtonMenu.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2754
	self initEvents.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2755
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2756
	"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2757
	 this is the first create,
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2758
	 force sizechange messages to be sent to the view
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2759
	"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2760
	extentChanged := true.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2761
	originChanged := true
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2762
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2763
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2764
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2765
recreate
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2766
    "recreate (i.e. tell X about me) after a snapin"
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2767
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2768
    drawableId isNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2769
	super recreate.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2770
	self physicalCreate.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2771
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2772
	viewBackground notNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2773
	    self setViewBackground 
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2774
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2775
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2776
	"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2777
	 XXX has to be changed: eventmasks are device specific -
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2778
	 XXX will not allow restart on another Workstation-type.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2779
	 XXX event masks must become symbolic
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2780
	"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2781
	device setEventMask:eventMask in:drawableId
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2782
    ]
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2783
!
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2784
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2785
createWithAllSubViews
48194c26a46c Initial revision
claus
parents:
diff changeset
  2786
    "create, then create all subviews"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2787
48194c26a46c Initial revision
claus
parents:
diff changeset
  2788
    drawableId isNil ifTrue:[self create].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2789
    subViews notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2790
	subViews do:[:subView | subView createWithAllSubViews]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2791
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2792
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2793
48194c26a46c Initial revision
claus
parents:
diff changeset
  2794
initializeMiddleButtonMenu
48194c26a46c Initial revision
claus
parents:
diff changeset
  2795
    "a place to initialize menu - this one is sent once when the view is
48194c26a46c Initial revision
claus
parents:
diff changeset
  2796
     first created; usually redefined in subclasses; default here is no menu"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2797
48194c26a46c Initial revision
claus
parents:
diff changeset
  2798
    ^ self
48194c26a46c Initial revision
claus
parents:
diff changeset
  2799
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2800
48194c26a46c Initial revision
claus
parents:
diff changeset
  2801
fixSize
48194c26a46c Initial revision
claus
parents:
diff changeset
  2802
    "adjust size of window according to either relative/abs or
48194c26a46c Initial revision
claus
parents:
diff changeset
  2803
     block extent; also set origin"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2804
48194c26a46c Initial revision
claus
parents:
diff changeset
  2805
    window notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2806
	^ self superViewChangedSize
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2807
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2808
48194c26a46c Initial revision
claus
parents:
diff changeset
  2809
    "if the extent is not the one we created the window with ..."
48194c26a46c Initial revision
claus
parents:
diff changeset
  2810
    extentChanged ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2811
	self sizeChanged:nil.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2812
	extentChanged := false
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2813
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2814
48194c26a46c Initial revision
claus
parents:
diff changeset
  2815
    originChanged ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2816
	originRule notNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2817
	    self pixelOrigin:(originRule value)
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2818
	] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2819
	    relativeOrigin notNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2820
		self originFromRelativeOrigin
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2821
	    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2822
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2823
	originChanged := false
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2824
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2825
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2826
48194c26a46c Initial revision
claus
parents:
diff changeset
  2827
realize
48194c26a46c Initial revision
claus
parents:
diff changeset
  2828
    "realize - make visible;
48194c26a46c Initial revision
claus
parents:
diff changeset
  2829
     realizing is done very late (after layout is fixed) to avoid
48194c26a46c Initial revision
claus
parents:
diff changeset
  2830
     visible rearranging of windows on the screen"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2831
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  2832
    |superGroup groupChange|
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  2833
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2834
    drawableId isNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2835
	self create.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2836
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2837
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  2838
    "
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  2839
     put myself into superviews windowgroup if there is a superview
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  2840
    "
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2841
    groupChange := false.
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  2842
    superView notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2843
	windowGroup notNil ifTrue:[
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2844
"/            'oops - wgroup change on realize' printNewline.
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2845
	    windowGroup removeView:self.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2846
	    windowGroup := nil
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2847
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2848
	superGroup := superView windowGroup.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2849
	superGroup ~~ windowGroup ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2850
	    groupChange := true.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2851
	    windowGroup := superGroup.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2852
	    windowGroup notNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2853
		windowGroup addView:self.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2854
	    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2855
	]
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  2856
    ].
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  2857
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2858
    hidden ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2859
	^ self
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2860
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2861
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  2862
"/    realized ifFalse:[
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  2863
    (originChanged or:[extentChanged]) ifTrue:[self fixSize].
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  2864
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  2865
    (realized not or:[groupChange]) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2866
	subViews notNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2867
	    subViews do:[:subView |
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2868
		subView realize
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2869
	    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2870
	].
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  2871
    ].
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  2872
    self setInnerClip.
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  2873
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  2874
    realized ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2875
	"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2876
	 now, make the view visible
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2877
	"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2878
	device mapWindow:drawableId.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2879
	realized := true
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2880
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  2881
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2882
60
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  2883
realizeInGroup
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  2884
    "special realize - leave windowgroup as is; for special applications"
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  2885
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  2886
    |superGroup groupChange|
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  2887
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  2888
    drawableId isNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2889
	self create.
60
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  2890
    ].
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  2891
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  2892
    hidden ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2893
	^ self
60
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  2894
    ].
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  2895
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  2896
"/    realized ifFalse:[
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  2897
    (originChanged or:[extentChanged]) ifTrue:[self fixSize].
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  2898
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  2899
    (realized not) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2900
	subViews notNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2901
	    subViews do:[:subView |
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2902
		subView realize
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2903
	    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2904
	].
60
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  2905
    ].
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  2906
    self setInnerClip.
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  2907
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  2908
    realized ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2909
	"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2910
	 now, make the view visible
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2911
	"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2912
	device mapWindow:drawableId.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2913
	realized := true
60
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  2914
    ]
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  2915
!
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  2916
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2917
rerealize
48194c26a46c Initial revision
claus
parents:
diff changeset
  2918
    "rerealize at old position"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2919
41
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  2920
    drawableId notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2921
	subViews notNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2922
	    subViews do:[:aView |
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2923
		aView realize
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2924
	    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2925
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2926
	device mapView:self id:drawableId iconified:false
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2927
		   atX:left y:top width:width height:height
41
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  2928
    ]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2929
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2930
48194c26a46c Initial revision
claus
parents:
diff changeset
  2931
destroy
48194c26a46c Initial revision
claus
parents:
diff changeset
  2932
    "unrealize & destroy - make me invisible, destroy subviews then
48194c26a46c Initial revision
claus
parents:
diff changeset
  2933
     make me unknown to the device"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2934
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  2935
    |subs|
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  2936
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2937
    realized ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2938
	self unrealize.            
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2939
	"make it go away immediately
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2940
	 - also, this hides the subview killing"
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  2941
"
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2942
	device synchronizeOutput. 
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  2943
"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2944
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2945
48194c26a46c Initial revision
claus
parents:
diff changeset
  2946
    model notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2947
	model removeDependent:self
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2948
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2949
    controller := nil.
48194c26a46c Initial revision
claus
parents:
diff changeset
  2950
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  2951
    subs := subViews.
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  2952
    subs notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2953
	"stupid: destroy removes itself from the subview list
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2954
	 - therefore we have to loop over a copy here"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2955
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2956
	subViews := nil.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2957
	subs do:[:aView |
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2958
	    aView notNil ifTrue:[aView destroy]             
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2959
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2960
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  2961
    superView notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2962
	superView removeSubView:self.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2963
	superView := nil
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2964
    ].
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  2965
    super destroy.
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  2966
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  2967
    windowGroup notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2968
	windowGroup removeView:self.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2969
	windowGroup := nil
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  2970
    ].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2971
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  2972
48194c26a46c Initial revision
claus
parents:
diff changeset
  2973
unrealize
48194c26a46c Initial revision
claus
parents:
diff changeset
  2974
    "hide me"
48194c26a46c Initial revision
claus
parents:
diff changeset
  2975
48194c26a46c Initial revision
claus
parents:
diff changeset
  2976
    realized ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2977
	drawableId notNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2978
	    device unmapWindow:drawableId
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2979
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2980
	realized := false.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  2981
	shown := false
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  2982
    ]
20
ab35d92b9a4b *** empty log message ***
claus
parents: 15
diff changeset
  2983
!
ab35d92b9a4b *** empty log message ***
claus
parents: 15
diff changeset
  2984
ab35d92b9a4b *** empty log message ***
claus
parents: 15
diff changeset
  2985
open
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2986
    "open up the view - for normal views, this is a modeless open
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2987
     (i.e. the new view comes up as independent process).
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2988
     This is redefined in ModalBox, which comes up modal (i.e. 
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2989
     control is under the current process, so that interaction with the
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2990
     current group is blocked while the modalBox is active)."
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2991
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2992
    ^ self openModeless
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2993
!
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2994
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  2995
openModeless
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2996
    "create and schedule a new windowgroup for me and open the view.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2997
     The view will be handled by its own process, effectively running in
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  2998
     parallel."
20
ab35d92b9a4b *** empty log message ***
claus
parents: 15
diff changeset
  2999
ab35d92b9a4b *** empty log message ***
claus
parents: 15
diff changeset
  3000
    ProcessorScheduler isPureEventDriven ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3001
	windowGroup isNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3002
	    windowGroup := WindowGroup new.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3003
	    windowGroup addTopView:self.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3004
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3005
	windowGroup startup.
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  3006
    ] ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3007
	self realize
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  3008
    ]
20
ab35d92b9a4b *** empty log message ***
claus
parents: 15
diff changeset
  3009
!
ab35d92b9a4b *** empty log message ***
claus
parents: 15
diff changeset
  3010
ab35d92b9a4b *** empty log message ***
claus
parents: 15
diff changeset
  3011
openModal
ab35d92b9a4b *** empty log message ***
claus
parents: 15
diff changeset
  3012
    "create a new windowgroup, but start processing in the current process
23
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  3013
     actually suspending event processing for the currently active group.
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  3014
     Stay in modalLoop while view is visible."
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  3015
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  3016
    self openModal:[true]
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  3017
!
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  3018
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  3019
openModal:aBlock
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  3020
    "create a new windowgroup, but start processing in the current process
4a7e02de7b72 *** empty log message ***
claus
parents: 21
diff changeset
  3021
     actually suspending event processing for the currently active group.
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  3022
     Stay in this modal loop while aBlock evaluates to true AND the receiver is
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  3023
     visible.
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  3024
     This makes any interaction with the current window impossible - 
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  3025
     however, other views (in their groups) still work."
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  3026
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3027
    (Processor activePriority >= Processor userInterruptPriority) ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3028
	"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3029
	 create a new window group and put myself into it
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3030
	"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3031
	windowGroup := WindowGroup new.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3032
	windowGroup addTopView:self.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3033
	"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3034
	 go dispatch events in this new group
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3035
	 (thus current windowgroup is blocked from interaction)
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3036
	"
78
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  3037
	Object abortSignal handle:[:ex |
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  3038
	    self hide.
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  3039
	    ex return.
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  3040
	] do:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3041
	    windowGroup startupModal:[realized and:aBlock]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3042
	].
78
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  3043
"/        (Object abortSignal catch:[
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  3044
"/            windowGroup startupModal:[realized and:aBlock]
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  3045
"/        ]) ifTrue:[
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  3046
"/            self hide
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  3047
"/        ].
21
7b3da079729d *** empty log message ***
claus
parents: 20
diff changeset
  3048
    ] ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3049
	self realize
20
ab35d92b9a4b *** empty log message ***
claus
parents: 15
diff changeset
  3050
    ]
60
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  3051
!
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  3052
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  3053
openAutonomous
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  3054
    "create and schedule a new windowgroup for me and open the view.
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  3055
     The view will be handled by its own process, effectively running in
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  3056
     parallel. This entry is for non-topviews, which want to be served
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3057
     autonomous from the topview. (see the fileBrowsers kill-button
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3058
     when executing unix commands as an example)"
60
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  3059
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  3060
    |wg|
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  3061
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  3062
    ProcessorScheduler isPureEventDriven ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3063
	wg := WindowGroup new.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3064
	self windowGroup:wg.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3065
	wg addView:self.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3066
	wg startup.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3067
	self realizeInGroup.
60
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  3068
    ] ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3069
	self realize
60
d7e4d835cbaf new openAutonomous for subviews in own group
claus
parents: 54
diff changeset
  3070
    ]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3071
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  3072
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3073
!View methodsFor:'user notification'!
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3074
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3075
warn:aString
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3076
    "like Objects warn, but translates the string via the
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3077
     resourcePack, thus giving a translated string automatically"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3078
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3079
    super warn:(resources string:aString)
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3080
!
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3081
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3082
warn:aString with:argument
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3083
    "like Objects warn, but translates the string via the
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3084
     resourcePack, thus giving a translated string automatically"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3085
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3086
    super warn:(resources string:aString with:argument)
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3087
! !
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3088
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3089
!View methodsFor:'drawing'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3090
48194c26a46c Initial revision
claus
parents:
diff changeset
  3091
drawEdgesForX:x y:y width:w height:h level:l 
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3092
		shadow:shadowColor light:lightColor
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3093
		halfShadow:halfShadowColor halfLight:halfLightColor
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3094
		style:edgeStyle
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3095
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3096
    "draw 3D edges into a rectangle"
48194c26a46c Initial revision
claus
parents:
diff changeset
  3097
48194c26a46c Initial revision
claus
parents:
diff changeset
  3098
    |topLeftFg botRightFg topLeftHalfFg botRightHalfFg
48194c26a46c Initial revision
claus
parents:
diff changeset
  3099
     count "{ Class: SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
  3100
     r     "{ Class: SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
  3101
     b     "{ Class: SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
  3102
     xi    "{ Class: SmallInteger }"
48194c26a46c Initial revision
claus
parents:
diff changeset
  3103
     yi    "{ Class: SmallInteger }"
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3104
     run paint|
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3105
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3106
    count := l.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3107
    (count < 0) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3108
	topLeftFg := shadowColor.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3109
	botRightFg := lightColor.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3110
	topLeftHalfFg := halfShadowColor.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3111
	botRightHalfFg := halfLightColor.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3112
	count := count negated
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3113
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3114
	topLeftFg := lightColor.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3115
	botRightFg := shadowColor.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3116
	topLeftHalfFg := halfLightColor.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3117
	botRightHalfFg := halfShadowColor.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3118
    ].
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3119
    topLeftHalfFg isNil ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3120
	topLeftHalfFg := topLeftFg
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3121
    ].
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3122
    botRightHalfFg isNil ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3123
	botRightHalfFg := botRightFg
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3124
    ].
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3125
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3126
    r := x + w - 1. "right"
48194c26a46c Initial revision
claus
parents:
diff changeset
  3127
    b := y + h - 1. "bottom"
48194c26a46c Initial revision
claus
parents:
diff changeset
  3128
48194c26a46c Initial revision
claus
parents:
diff changeset
  3129
    super lineWidth:0.
48194c26a46c Initial revision
claus
parents:
diff changeset
  3130
48194c26a46c Initial revision
claus
parents:
diff changeset
  3131
    "top and left edges"
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3132
    ((edgeStyle == #soft) and:[l > 0]) ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3133
	paint := topLeftHalfFg
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3134
    ] ifFalse:[
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3135
	paint := topLeftFg
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3136
    ].
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3137
    super paint:paint.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3138
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3139
    0 to:(count - 1) do:[:i |
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3140
	run := y + i.
78
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  3141
	super displayDeviceLineFromX:x y:run toX:r y:run. "top"
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3142
	run := x + i.
78
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  3143
	super displayDeviceLineFromX:run y:y toX:run y:b  "left"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3144
    ].
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3145
    (edgeStyle == #soft) ifTrue:[
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3146
"
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3147
	super paint:topLeftFg.
78
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  3148
	super displayDeviceLineFromX:x y:y toX:r y:y. 
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  3149
	super displayDeviceLineFromX:x y:y toX:x y:b        
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3150
"
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3151
	(l > 2) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3152
	    super paint:Black.
78
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  3153
	    super displayDeviceLineFromX:x y:y toX:r y:y. 
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  3154
	    super displayDeviceLineFromX:x y:y toX:x y:b. 
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3155
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3156
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  3157
48194c26a46c Initial revision
claus
parents:
diff changeset
  3158
    xi := x + 1.
48194c26a46c Initial revision
claus
parents:
diff changeset
  3159
    yi := y + 1.
48194c26a46c Initial revision
claus
parents:
diff changeset
  3160
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3161
"/ does not look good
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3162
"/ style == #st80 iftrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3163
"/  yi := yi + 1
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3164
"/ ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3165
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3166
    "bottom and right edges"
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3167
    (edgeStyle == #soft) ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3168
	paint := botRightHalfFg
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3169
    ] ifFalse:[
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3170
	paint := botRightFg
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3171
    ].
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3172
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3173
    super paint:paint.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3174
    0 to:(count - 1) do:[:i |
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3175
	run := b - i.
78
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  3176
	super displayDeviceLineFromX:xi-1 y:run toX:r y:run. "bottom"
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3177
	run := r - i.
78
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  3178
	super displayDeviceLineFromX:run y:yi-1 toX:run y:b.  "right"
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3179
	xi := xi + 1.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3180
	yi := yi + 1
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3181
    ].
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3182
    ((edgeStyle == #soft) and:[l > 1]) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3183
	super paint:Black "shadowColor".
78
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  3184
	super displayDeviceLineFromX:(x + 1-1) y:b toX:r y:b. 
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  3185
	super displayDeviceLineFromX:r y:(y + 1 - 1) toX:r y:b        
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3186
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  3187
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3188
48194c26a46c Initial revision
claus
parents:
diff changeset
  3189
drawEdgesForX:x y:y width:w height:h level:l
48194c26a46c Initial revision
claus
parents:
diff changeset
  3190
    "draw 3D edges into a rectangle"
48194c26a46c Initial revision
claus
parents:
diff changeset
  3191
48194c26a46c Initial revision
claus
parents:
diff changeset
  3192
    self drawEdgesForX:x y:y width:w height:h level:l 
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3193
		shadow:shadowColor 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3194
		light:lightColor
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3195
		halfShadow:nil 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3196
		halfLight:nil 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3197
		style:nil 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3198
!
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3199
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3200
drawEdges
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3201
    "draw all of my 3D edges"
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3202
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3203
    self drawEdgesForX:0 y:0 width:width height:height level:level
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3204
		shadow:shadowColor 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3205
		light:lightColor
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3206
		halfShadow:nil 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3207
		halfLight:nil 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3208
		style:nil 
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3209
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3210
48194c26a46c Initial revision
claus
parents:
diff changeset
  3211
drawLeftEdge
48194c26a46c Initial revision
claus
parents:
diff changeset
  3212
    "draw left 3D edge into window frame"
48194c26a46c Initial revision
claus
parents:
diff changeset
  3213
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3214
    self drawLeftEdgeLevel:level
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3215
		    shadow:shadowColor 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3216
		     light:lightColor
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3217
		     halfShadow:nil 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3218
		     halfLight:nil
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3219
		     style:nil.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3220
!
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3221
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3222
drawLeftEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3223
    |leftFg leftHalfFg paint
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3224
     count "{ Class: SmallInteger }" |
48194c26a46c Initial revision
claus
parents:
diff changeset
  3225
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3226
    count := level.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3227
    count == 0 ifTrue:[^ self].
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3228
    
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3229
    (count < 0) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3230
	leftFg := shadowColor.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3231
	leftHalfFg := halfShadowColor.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3232
	count := count negated.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3233
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3234
	leftFg := lightColor.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3235
	leftHalfFg := halfLightColor.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3236
    ].
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3237
    leftHalfFg isNil ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3238
	leftHalfFg := leftFg
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3239
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  3240
48194c26a46c Initial revision
claus
parents:
diff changeset
  3241
    super lineWidth:0.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3242
    ((edgeStyle == #soft) and:[level > 0]) ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3243
	paint := leftHalfFg
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3244
    ] ifFalse:[
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3245
	paint := leftFg
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3246
    ].
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3247
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3248
    super paint:paint.
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3249
    0 to:(count - 1) do:[:i |
78
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  3250
	super displayDeviceLineFromX:i y:i toX:i y:(height - 1 - i)
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3251
    ].
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3252
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3253
    ((edgeStyle == #soft) and:[level > 2]) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3254
	super paint:Black.
78
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  3255
	super displayDeviceLineFromX:0 y:0 toX:0 y:height-1. 
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3256
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  3257
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3258
48194c26a46c Initial revision
claus
parents:
diff changeset
  3259
drawRightEdge
48194c26a46c Initial revision
claus
parents:
diff changeset
  3260
    "draw right 3D edge into window frame"
48194c26a46c Initial revision
claus
parents:
diff changeset
  3261
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3262
    self drawRightEdgeLevel:level
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3263
		     shadow:shadowColor 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3264
		      light:lightColor
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3265
		      halfShadow:nil 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3266
		      halfLight:nil
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3267
		      style:nil.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3268
!
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3269
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3270
drawRightEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle 
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3271
    |rightFg
48194c26a46c Initial revision
claus
parents:
diff changeset
  3272
     count "{ Class: SmallInteger }" 
48194c26a46c Initial revision
claus
parents:
diff changeset
  3273
     r|
48194c26a46c Initial revision
claus
parents:
diff changeset
  3274
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3275
    count := level.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3276
    count == 0 ifTrue:[^ self].
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3277
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3278
    (count < 0) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3279
	rightFg := lightColor.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3280
	count := count negated
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3281
    ] ifFalse:[
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3282
	((edgeStyle == #soft) and:[level > 1]) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3283
	    rightFg := halfShadowColor
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3284
	] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3285
	    rightFg := shadowColor
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3286
	].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3287
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  3288
48194c26a46c Initial revision
claus
parents:
diff changeset
  3289
    super lineWidth:0.
48194c26a46c Initial revision
claus
parents:
diff changeset
  3290
    super paint:rightFg.
48194c26a46c Initial revision
claus
parents:
diff changeset
  3291
    0 to:(count - 1) do:[:i |
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3292
	r := width - 1 - i.
78
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  3293
	super displayDeviceLineFromX:r y:i toX:r y:(height - 1 - i)
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3294
    ].
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3295
    ((edgeStyle == #soft) and:[level > 1]) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3296
	super paint:shadowColor.
78
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  3297
	super displayDeviceLineFromX:width-1 y:1 toX:width-1 y:height-1. 
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3298
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  3299
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3300
48194c26a46c Initial revision
claus
parents:
diff changeset
  3301
drawTopEdge
48194c26a46c Initial revision
claus
parents:
diff changeset
  3302
    "draw top 3D edge into window frame"
48194c26a46c Initial revision
claus
parents:
diff changeset
  3303
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3304
    self drawTopEdgeLevel:level
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3305
		   shadow:shadowColor 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3306
		    light:lightColor
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3307
		    halfShadow:nil 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3308
		    halfLight:nil
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3309
		    style:nil.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3310
!
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3311
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3312
drawTopEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle 
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3313
    |topFg topHalfFg
48194c26a46c Initial revision
claus
parents:
diff changeset
  3314
     count "{ Class: SmallInteger }" |
48194c26a46c Initial revision
claus
parents:
diff changeset
  3315
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3316
    count := level.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3317
    count == 0 ifTrue:[^ self].
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3318
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3319
    (count < 0) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3320
	topFg := shadowColor.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3321
	topHalfFg := halfShadowColor.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3322
	count := count negated
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3323
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3324
	topFg := lightColor.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3325
	topHalfFg := halfLightColor.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3326
    ].
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3327
    topHalfFg isNil ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3328
	topHalfFg := topFg
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3329
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  3330
48194c26a46c Initial revision
claus
parents:
diff changeset
  3331
    super lineWidth:0.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3332
    ((edgeStyle == #soft) and:[level > 0]) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3333
	super paint:topHalfFg
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3334
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3335
	super paint:topFg
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3336
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  3337
    0 to:(count - 1) do:[:i |
78
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  3338
	super displayDeviceLineFromX:i y:i toX:(width - 1 - i) y:i
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3339
    ].
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3340
    ((edgeStyle == #soft) and:[level > 2]) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3341
	super paint:Black.
78
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  3342
	super displayDeviceLineFromX:0 y:0 toX:width-1 y:0. 
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3343
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  3344
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3345
48194c26a46c Initial revision
claus
parents:
diff changeset
  3346
drawBottomEdge
48194c26a46c Initial revision
claus
parents:
diff changeset
  3347
    "draw bottom 3D edge into window frame"
48194c26a46c Initial revision
claus
parents:
diff changeset
  3348
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3349
    self drawBottomEdgeLevel:level
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3350
		      shadow:shadowColor 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3351
		      light:lightColor
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3352
		      halfShadow:nil 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3353
		      halfLight:nil
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3354
		      style:nil.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3355
!
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3356
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3357
drawBottomEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3358
    |botFg
48194c26a46c Initial revision
claus
parents:
diff changeset
  3359
     count "{ Class: SmallInteger }" 
48194c26a46c Initial revision
claus
parents:
diff changeset
  3360
     b|
48194c26a46c Initial revision
claus
parents:
diff changeset
  3361
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3362
    count := level.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3363
    count == 0 ifTrue:[^ self].
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3364
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3365
    (count < 0) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3366
	botFg := lightColor.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3367
	count := count negated
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3368
    ] ifFalse:[
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3369
	((edgeStyle == #soft) and:[level > 1]) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3370
	    botFg := halfShadowColor
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3371
	] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3372
	    botFg := shadowColor
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3373
	].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3374
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  3375
48194c26a46c Initial revision
claus
parents:
diff changeset
  3376
    super lineWidth:0.
48194c26a46c Initial revision
claus
parents:
diff changeset
  3377
    super paint:botFg.
48194c26a46c Initial revision
claus
parents:
diff changeset
  3378
    0 to:(count - 1) do:[:i |
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3379
	b := height - 1 - i.
78
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  3380
	super displayDeviceLineFromX:i y:b toX:(width "- 1" - i) y:b
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3381
    ].
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3382
    ((edgeStyle == #soft) and:[level > 1]) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3383
	super paint:shadowColor.
78
1c9c22df3251 *** empty log message ***
claus
parents: 72
diff changeset
  3384
	super displayDeviceLineFromX:1 y:height-1 toX:width-1 y:height-1. 
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3385
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  3386
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3387
48194c26a46c Initial revision
claus
parents:
diff changeset
  3388
redrawEdges
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3389
    "redraw my edges (if any)"
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3390
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3391
    (level ~~ 0) ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3392
	self clipRect:nil.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3393
	self drawEdges.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3394
	self clipRect:innerClipRect
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3395
    ]                  
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3396
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3397
48194c26a46c Initial revision
claus
parents:
diff changeset
  3398
redraw
48194c26a46c Initial revision
claus
parents:
diff changeset
  3399
    "redraw myself
48194c26a46c Initial revision
claus
parents:
diff changeset
  3400
     if there is a model, this one shall redraw itself,
48194c26a46c Initial revision
claus
parents:
diff changeset
  3401
     otherwise we cannot do much here - has to be redefined in subclasses"
48194c26a46c Initial revision
claus
parents:
diff changeset
  3402
48194c26a46c Initial revision
claus
parents:
diff changeset
  3403
    model notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3404
	model update:self
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3405
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  3406
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3407
48194c26a46c Initial revision
claus
parents:
diff changeset
  3408
redrawX:x y:y width:w height:h
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3409
    "have to redraw part of myself, givel logical coordinates (if trans is nonNil)
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3410
     default is to redraw everything - subclasses should add intelligence"
48194c26a46c Initial revision
claus
parents:
diff changeset
  3411
48194c26a46c Initial revision
claus
parents:
diff changeset
  3412
    |area|
48194c26a46c Initial revision
claus
parents:
diff changeset
  3413
48194c26a46c Initial revision
claus
parents:
diff changeset
  3414
    area := Rectangle left:x top:y width:w height:h.      
48194c26a46c Initial revision
claus
parents:
diff changeset
  3415
    self clippedTo:area do:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3416
	controller notNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3417
	    "ST-80 updating"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3418
	    self update:#rectangle with:area
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3419
	] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3420
	    components notNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3421
		components do:[:aComponent |
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3422
		    |thisFrame is|
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3423
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3424
		    thisFrame := aComponent frame.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3425
		    (thisFrame intersects:area) ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3426
			is := thisFrame intersect:(x@y extent:w@h).
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3427
			is = thisFrame ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3428
			    aComponent redraw
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3429
			] ifFalse:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3430
			    aComponent redrawX:is left
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3431
					     y:is top
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3432
					 width:is width
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3433
					height:is height.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3434
			].        
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3435
			"/ aComponent drawIn:self offset:0@0
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3436
		    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3437
		]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3438
	    ] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3439
		self redraw
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3440
	    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3441
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3442
    ]                                                              
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3443
!
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3444
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3445
redrawDeviceX:x y:y width:w height:h
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3446
    "have to redraw part of the view.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3447
     The coordinates are in device space - if there is a transformation,
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3448
     must inverse-transform back to logical coordinates. (since the view thinks
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3449
     in its coordinate space)"
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3450
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3451
    |lx ly lw lh|
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3452
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3453
    lx := x.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3454
    ly := y.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3455
    lw := w.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3456
    lh := h.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3457
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3458
    transformation notNil ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3459
	lx := transformation applyInverseToX:lx.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3460
	ly := transformation applyInverseToY:ly.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3461
	lw := transformation applyInverseScaleX:lw.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3462
	lh := transformation applyInverseScaleY:lh.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3463
    ].
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3464
    self redrawX:lx y:ly width:lw height:lh
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3465
! !
48194c26a46c Initial revision
claus
parents:
diff changeset
  3466
48194c26a46c Initial revision
claus
parents:
diff changeset
  3467
!View methodsFor:'events'!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3468
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  3469
destroyed
32
bbfe290be580 *** empty log message ***
claus
parents: 28
diff changeset
  3470
    "view has been destroyed by someone else (usually window system)"
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  3471
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  3472
    shown := false.
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  3473
    super destroyed
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  3474
!
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  3475
32
bbfe290be580 *** empty log message ***
claus
parents: 28
diff changeset
  3476
terminate
bbfe290be580 *** empty log message ***
claus
parents: 28
diff changeset
  3477
    "window manager wants me to go away;
bbfe290be580 *** empty log message ***
claus
parents: 28
diff changeset
  3478
     - notice, that not all window managers are nice enough to 
bbfe290be580 *** empty log message ***
claus
parents: 28
diff changeset
  3479
       send this event, but simply destroy the view instead.
bbfe290be580 *** empty log message ***
claus
parents: 28
diff changeset
  3480
     Can be redefined in subclasses to do whatever cleanup is 
bbfe290be580 *** empty log message ***
claus
parents: 28
diff changeset
  3481
     required."
bbfe290be580 *** empty log message ***
claus
parents: 28
diff changeset
  3482
bbfe290be580 *** empty log message ***
claus
parents: 28
diff changeset
  3483
    ^ self destroy
bbfe290be580 *** empty log message ***
claus
parents: 28
diff changeset
  3484
!
bbfe290be580 *** empty log message ***
claus
parents: 28
diff changeset
  3485
bbfe290be580 *** empty log message ***
claus
parents: 28
diff changeset
  3486
saveAndTerminate
bbfe290be580 *** empty log message ***
claus
parents: 28
diff changeset
  3487
    "window manager wants me to save and go away; 
bbfe290be580 *** empty log message ***
claus
parents: 28
diff changeset
  3488
     - notice, that not all window managers are nice enough to 
bbfe290be580 *** empty log message ***
claus
parents: 28
diff changeset
  3489
       send this event, but simply destroy the view instead.
bbfe290be580 *** empty log message ***
claus
parents: 28
diff changeset
  3490
     Can be redefined in subclasses to do whatever is required
bbfe290be580 *** empty log message ***
claus
parents: 28
diff changeset
  3491
     to prepare for restart."
bbfe290be580 *** empty log message ***
claus
parents: 28
diff changeset
  3492
bbfe290be580 *** empty log message ***
claus
parents: 28
diff changeset
  3493
    ^ self destroy
bbfe290be580 *** empty log message ***
claus
parents: 28
diff changeset
  3494
!
bbfe290be580 *** empty log message ***
claus
parents: 28
diff changeset
  3495
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3496
sizeChanged:how
32
bbfe290be580 *** empty log message ***
claus
parents: 28
diff changeset
  3497
    "tell subviews if I change size.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3498
     How is either #smaller, #larger or nil, and is used to control the order,
32
bbfe290be580 *** empty log message ***
claus
parents: 28
diff changeset
  3499
     in which subviews are notified (possibly reducing redraw activity)"
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3500
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3501
    window notNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3502
	"compute new transformation"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3503
    ].
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3504
    subViews notNil ifTrue:[
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3505
	(how isNil "false" 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3506
	or:[how == #smaller]) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3507
	    subViews do:[:view |
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3508
		view superViewChangedSize
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3509
	    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3510
	] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3511
	    "doing it reverse speeds up resizing - usually subviews
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3512
	     are created from top-left to bottom-right; therefore
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3513
	     bottom-right views will be moved/resized first, then top-left ones;
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3514
	     this avoids multiple redraws of subviews"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3515
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3516
	    subViews reverseDo:[:view |
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3517
		view superViewChangedSize
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3518
	    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3519
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3520
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  3521
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3522
48194c26a46c Initial revision
claus
parents:
diff changeset
  3523
superViewChangedSize
48194c26a46c Initial revision
claus
parents:
diff changeset
  3524
    "my superView has changed size; if I have relative
48194c26a46c Initial revision
claus
parents:
diff changeset
  3525
     origin/extent or blocks to evaluate, do it now .."
48194c26a46c Initial revision
claus
parents:
diff changeset
  3526
48194c26a46c Initial revision
claus
parents:
diff changeset
  3527
    |oldWidth oldHeight oldTop oldLeft newExt newOrg
48194c26a46c Initial revision
claus
parents:
diff changeset
  3528
     winSuper newWidth newHeight newLeft newTop newCorner
48194c26a46c Initial revision
claus
parents:
diff changeset
  3529
     superWidth superHeight superWinWidth superWinHeight|
48194c26a46c Initial revision
claus
parents:
diff changeset
  3530
48194c26a46c Initial revision
claus
parents:
diff changeset
  3531
    oldWidth := width.
48194c26a46c Initial revision
claus
parents:
diff changeset
  3532
    oldHeight := height.
48194c26a46c Initial revision
claus
parents:
diff changeset
  3533
    oldTop := top.
48194c26a46c Initial revision
claus
parents:
diff changeset
  3534
    oldLeft := left.
48194c26a46c Initial revision
claus
parents:
diff changeset
  3535
48194c26a46c Initial revision
claus
parents:
diff changeset
  3536
    viewport notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3537
	"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3538
	 if this view has a viewPort, resize a la st-80
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3539
	"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3540
	superView isNil ifTrue:[^ self].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3541
	winSuper := superView window.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3542
	winSuper isNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3543
	    "take pixel size as window"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3544
	    winSuper := 0@0 extent:(superView width@superView height)
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3545
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3546
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3547
	superWidth := superView width.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3548
	superHeight := superView height.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3549
	superWinWidth := winSuper width.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3550
	superWinHeight := winSuper height.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3551
	newLeft := (viewport left - winSuper left) * superWidth // superWinWidth.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3552
	newTop := (viewport top - winSuper top) * superHeight // superWinHeight.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3553
	newWidth := superWidth * viewport width // superWinWidth.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3554
	newHeight := superHeight * viewport height // superWinHeight.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3555
	self pixelOrigin:(newLeft @ newTop).
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3556
	self pixelExtent:(newWidth @ newHeight).
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3557
	^ self
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3558
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  3559
48194c26a46c Initial revision
claus
parents:
diff changeset
  3560
    (originRule notNil) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3561
	newOrg := originRule value
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3562
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3563
	(relativeOrigin notNil) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3564
	    newOrg := self originFromRelativeOrigin.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3565
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3566
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  3567
48194c26a46c Initial revision
claus
parents:
diff changeset
  3568
    (cornerRule notNil) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3569
	newCorner := cornerRule value
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3570
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3571
	(relativeCorner notNil) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3572
	    newCorner := self cornerFromRelativeCorner
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3573
	] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3574
	    (extentRule notNil) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3575
		newExt := extentRule value
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3576
	    ] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3577
		(relativeExtent notNil) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3578
		    newExt := self extentFromRelativeExtent
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3579
		]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3580
	    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3581
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3582
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  3583
48194c26a46c Initial revision
claus
parents:
diff changeset
  3584
    newOrg notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3585
	((newOrg x == oldLeft) and:[newOrg y == oldTop]) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3586
	    newOrg := nil
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3587
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3588
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  3589
    newCorner notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3590
	(newCorner = self corner) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3591
	    newCorner := nil
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3592
	] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3593
	    self corner isNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3594
		newExt notNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3595
		    ((newExt x == oldWidth) and:[newExt y == oldHeight]) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3596
			newExt := nil
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3597
		    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3598
		].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3599
	    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3600
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3601
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  3602
48194c26a46c Initial revision
claus
parents:
diff changeset
  3603
    newCorner isNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3604
	newExt isNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3605
	    newOrg notNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3606
		self pixelOrigin:newOrg
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3607
	    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3608
	] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3609
	    newOrg isNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3610
		self pixelExtent:newExt
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3611
	    ] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3612
		self pixelOrigin:newOrg extent:newExt
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3613
	    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3614
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3615
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3616
	newOrg isNil ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3617
	    self pixelCorner:newCorner
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3618
	] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3619
	    self pixelOrigin:newOrg corner:newCorner
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3620
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3621
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  3622
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3623
48194c26a46c Initial revision
claus
parents:
diff changeset
  3624
configureX:x y:y width:newWidth height:newHeight
48194c26a46c Initial revision
claus
parents:
diff changeset
  3625
    "my size has changed by window manager action"
48194c26a46c Initial revision
claus
parents:
diff changeset
  3626
48194c26a46c Initial revision
claus
parents:
diff changeset
  3627
    |how anyEdge mustRedrawBottomEdge mustRedrawRightEdge|
48194c26a46c Initial revision
claus
parents:
diff changeset
  3628
48194c26a46c Initial revision
claus
parents:
diff changeset
  3629
    left := x.
48194c26a46c Initial revision
claus
parents:
diff changeset
  3630
    top := y.
48194c26a46c Initial revision
claus
parents:
diff changeset
  3631
    ((width ~~ newWidth) or:[height ~~ newHeight]) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3632
	realized ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3633
	    width := newWidth.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3634
	    height := newHeight.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3635
	    extentChanged := true.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3636
	    ^ self
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3637
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3638
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3639
	((newWidth <= width) and:[newHeight <= height]) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3640
	    how := #smaller
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3641
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3642
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3643
	level ~~ 0 ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3644
	    mustRedrawBottomEdge := newHeight < height.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3645
	    mustRedrawRightEdge := newWidth < width.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3646
	    anyEdge := mustRedrawBottomEdge or:[mustRedrawRightEdge]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3647
	] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3648
	    anyEdge := false
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3649
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3650
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3651
	width := newWidth.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3652
	height := newHeight.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3653
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3654
	"recompute inner-clip if needed"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3655
	self setInnerClip.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3656
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3657
	self sizeChanged:how.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3658
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3659
	(anyEdge and:[shown]) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3660
	    self clipRect:nil.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3661
	    mustRedrawBottomEdge ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3662
		self drawBottomEdge
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3663
	    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3664
	    mustRedrawRightEdge ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3665
		self drawRightEdge
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3666
	    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3667
	    self clipRect:innerClipRect
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3668
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3669
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  3670
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3671
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3672
coveredBy:aView
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3673
    "the receiver has been covered by another view;
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3674
     we are not interrested in that here (but see modalBox for more)."
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3675
!
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3676
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3677
mapped
48194c26a46c Initial revision
claus
parents:
diff changeset
  3678
    "the view has been mapped (by some outside
48194c26a46c Initial revision
claus
parents:
diff changeset
  3679
     action - i.e. window manager de-iconified me)"
48194c26a46c Initial revision
claus
parents:
diff changeset
  3680
48194c26a46c Initial revision
claus
parents:
diff changeset
  3681
    realized := true.
21
7b3da079729d *** empty log message ***
claus
parents: 20
diff changeset
  3682
    shown := true.
7b3da079729d *** empty log message ***
claus
parents: 20
diff changeset
  3683
    "backed views will not get expose events - have
7b3da079729d *** empty log message ***
claus
parents: 20
diff changeset
  3684
     to force a redraw here to get things drawn into
7b3da079729d *** empty log message ***
claus
parents: 20
diff changeset
  3685
     backing store"
7b3da079729d *** empty log message ***
claus
parents: 20
diff changeset
  3686
    backed ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3687
	self redraw
21
7b3da079729d *** empty log message ***
claus
parents: 20
diff changeset
  3688
    ]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3689
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3690
48194c26a46c Initial revision
claus
parents:
diff changeset
  3691
unmapped
48194c26a46c Initial revision
claus
parents:
diff changeset
  3692
    "the view has been unmapped (by some outside
48194c26a46c Initial revision
claus
parents:
diff changeset
  3693
     action - i.e. window manager iconified me)"
48194c26a46c Initial revision
claus
parents:
diff changeset
  3694
48194c26a46c Initial revision
claus
parents:
diff changeset
  3695
    shown := false
48194c26a46c Initial revision
claus
parents:
diff changeset
  3696
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3697
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3698
visibilityChange:how
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3699
    "the visibility of the view has changed (by some outside
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3700
     action - i.e. window manager rearranged things).
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3701
     Using this knowledge avoids useless redraw in obsucred views."
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3702
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3703
    how == #fullyObscured ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3704
	shown := false
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3705
    ] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3706
	shown := true.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3707
    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3708
!
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3709
12
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  3710
reparented
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  3711
    "the view has changed its parent by some outside
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  3712
     action - i.e. window manager has added a frame.
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  3713
     nothing done here"
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  3714
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  3715
    ^ self
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  3716
!
9f0995fac1fa *** empty log message ***
claus
parents: 6
diff changeset
  3717
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3718
exposeX:x y:y width:w height:h
48194c26a46c Initial revision
claus
parents:
diff changeset
  3719
    "a low level redraw event from device
48194c26a46c Initial revision
claus
parents:
diff changeset
  3720
      - let subclass handle the redraw and take care of edges here"
48194c26a46c Initial revision
claus
parents:
diff changeset
  3721
48194c26a46c Initial revision
claus
parents:
diff changeset
  3722
    |leftEdge topEdge rightEdge botEdge anyEdge nx ny nw nh|
48194c26a46c Initial revision
claus
parents:
diff changeset
  3723
48194c26a46c Initial revision
claus
parents:
diff changeset
  3724
    nw := w.
48194c26a46c Initial revision
claus
parents:
diff changeset
  3725
    nh := h.
48194c26a46c Initial revision
claus
parents:
diff changeset
  3726
    nx := x.
48194c26a46c Initial revision
claus
parents:
diff changeset
  3727
    ny := y.
48194c26a46c Initial revision
claus
parents:
diff changeset
  3728
48194c26a46c Initial revision
claus
parents:
diff changeset
  3729
    anyEdge := false.
48194c26a46c Initial revision
claus
parents:
diff changeset
  3730
48194c26a46c Initial revision
claus
parents:
diff changeset
  3731
    "check if there is a need to draw an edge"
48194c26a46c Initial revision
claus
parents:
diff changeset
  3732
48194c26a46c Initial revision
claus
parents:
diff changeset
  3733
    (margin ~~ 0) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3734
	leftEdge := false.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3735
	topEdge := false.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3736
	rightEdge := false.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3737
	botEdge := false.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3738
	(x < margin) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3739
	    nx := margin.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3740
	    nw := nw - (nx - x).
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3741
	    leftEdge := true.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3742
	    anyEdge := true
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3743
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3744
	((x + w - 1) >= (width - margin)) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3745
	    nw := (width - margin - nx).
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3746
	    rightEdge := true.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3747
	    anyEdge := true
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3748
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3749
	(y < margin) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3750
	    ny := margin.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3751
	    nh := nh - (ny - y).
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3752
	    topEdge := true.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3753
	    anyEdge := true
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3754
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3755
	((y + h - 1) >= (height - margin)) ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3756
	    nh := (height - margin - ny).
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3757
	    botEdge := true.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3758
	    anyEdge := true
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3759
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3760
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  3761
48194c26a46c Initial revision
claus
parents:
diff changeset
  3762
    "redraw inside area"
48194c26a46c Initial revision
claus
parents:
diff changeset
  3763
48194c26a46c Initial revision
claus
parents:
diff changeset
  3764
    self redrawX:nx y:ny width:nw height:nh.
48194c26a46c Initial revision
claus
parents:
diff changeset
  3765
48194c26a46c Initial revision
claus
parents:
diff changeset
  3766
    "redraw edge(s)"
48194c26a46c Initial revision
claus
parents:
diff changeset
  3767
48194c26a46c Initial revision
claus
parents:
diff changeset
  3768
    anyEdge ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3769
	self clipRect:nil.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3770
	(topEdge and:[leftEdge and:[botEdge and:[rightEdge]]]) ifTrue:[
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3771
	    self drawEdges
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3772
	] ifFalse:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3773
	    topEdge ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3774
		self drawTopEdge
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3775
	    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3776
	    leftEdge ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3777
		self drawLeftEdge
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3778
	    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3779
	    botEdge ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3780
		self drawBottomEdge
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3781
	    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3782
	    rightEdge ifTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3783
		self drawRightEdge
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3784
	    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3785
	].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3786
	self clipRect:innerClipRect
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3787
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  3788
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3789
48194c26a46c Initial revision
claus
parents:
diff changeset
  3790
keyPress:key x:x y:y
48194c26a46c Initial revision
claus
parents:
diff changeset
  3791
    "a key has been pressed.
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  3792
     if there is a keyboardHandler, pass input to him;
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  3793
     otherwise forward it to the superview, if there is any."
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  3794
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3795
    components notNil ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3796
	components do:[:aComponent |
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3797
	    |thisFrame|
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3798
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3799
	    thisFrame := aComponent frame.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3800
	    (thisFrame containsPointX:x y:y) ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3801
		aComponent keyPress:key x:x - thisFrame left
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3802
					y:y - thisFrame top.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3803
		^ self
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3804
	    ]
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3805
	]
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3806
    ].
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3807
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  3808
    "
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  3809
     allow forwarding events to the keyboardhandler
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  3810
    "
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3811
    keyboardHandler notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3812
	^ keyboardHandler keyPress:key x:x y:y
54
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  3813
    ].
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  3814
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  3815
    "
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  3816
     mhmh: consider this a kludge:
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  3817
     if there is a key-event in a subview, AND the key is not handled 
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  3818
     in the subview (such as SHIFT_L), AND the subviews topview has set
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  3819
     a keyboardHandler, which is the original subview, 
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  3820
     THEN we are cought in a recursive loop as:
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  3821
       subview keyPress -> superView keyPress -> handler(==subview) keyPress
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  3822
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  3823
     the following kludge checks for this, and breaks out.
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  3824
     Do you have any better idea ?
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  3825
    "
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  3826
    thisContext isRecursive ifTrue:[^ self].
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  3827
29a6b2f8e042 *** empty log message ***
claus
parents: 46
diff changeset
  3828
    superView notNil ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3829
	superView keyPress:key x:x y:y
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3830
    ] ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3831
	super keyPress:key x:x y:y
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3832
    ]
48194c26a46c Initial revision
claus
parents:
diff changeset
  3833
!
48194c26a46c Initial revision
claus
parents:
diff changeset
  3834
48194c26a46c Initial revision
claus
parents:
diff changeset
  3835
buttonPress:button x:x y:y
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3836
    "button was pressed - if its the middle button 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3837
     and there is a middleButtonMenu, show it.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3838
     If both a model and a menuSelector is is defined, ask the model for
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3839
     the menu and launch it. The menu is supposed to return an actionSelector
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3840
     which in turn is sent to the model."
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3841
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3842
    |menu actionSelector|
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3843
82
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3844
    components notNil ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3845
	components do:[:aComponent |
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3846
	    |thisFrame|
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3847
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3848
	    thisFrame := aComponent frame.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3849
	    (thisFrame containsPointX:x y:y) ifTrue:[
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3850
		aComponent buttonPress:button x:x - thisFrame left
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3851
					      y:y - thisFrame top.
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3852
		^ self
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3853
	    ]
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3854
	]
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3855
    ].
98a70bce6d51 *** empty log message ***
claus
parents: 81
diff changeset
  3856
46
7b331e9012fd *** empty log message ***
claus
parents: 42
diff changeset
  3857
    ((button == 2) or:[button == #menu]) ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3858
	"
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3859
	 try ST-80 style menus first:
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3860
	 if there is a model, and a menuSymbol is defined,
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3861
	 ask model for the menu and launch that if non-nil.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3862
	"
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3863
	(model notNil 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3864
	and:[menuSymbol notNil
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3865
	and:[menuSymbol isSymbol]]) ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3866
	    "
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3867
	     ask model for the menu
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3868
	    "
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3869
	    menu := model perform:menuSymbol.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3870
	    menu notNil ifTrue:[
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3871
		"
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3872
		 got one, launch the menu. It is supposed
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3873
		 to return an actionSelector.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3874
		"
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3875
		actionSelector := menu startUp.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3876
		(actionSelector notNil
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3877
		and:[actionSelector isSymbol]) ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3878
		    model perform:actionSelector
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3879
		]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3880
	    ].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3881
	    ^ self
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3882
	]
0
48194c26a46c Initial revision
claus
parents:
diff changeset
  3883
    ].
48194c26a46c Initial revision
claus
parents:
diff changeset
  3884
    super buttonPress:button x:x y:y
48194c26a46c Initial revision
claus
parents:
diff changeset
  3885
! !
36
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  3886
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  3887
!View methodsFor:'cursor animation'!
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  3888
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  3889
showBusyWhile:aBlock
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  3890
    "evaluate some time consuming block, while doing this,
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  3891
     show a spinning wheel cursor"
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  3892
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  3893
    |ok bitmaps cursors mask process oldCursor|
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  3894
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  3895
    oldCursor := cursor.
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3896
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3897
    ok := true.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3898
    bitmaps := #('wheel1' 'wheel2' 'wheel3' 'wheel4') 
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3899
	       collect:[:name |
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3900
		   |f|
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3901
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3902
		   f := Form fromFile:(name , '.xbm').
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3903
		   f isNil ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3904
			('no bitmap file: ' , name , '.xbm') errorPrintNL.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3905
			ok := false
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3906
		   ].
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3907
		   f
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3908
	       ].
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3909
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3910
    mask := Form fromFile:'wheelm.xbm'.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3911
    mask isNil ifTrue:[
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3912
	('no bitmap file: ' , mask , '.xbm') errorPrintNL.
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3913
	ok := false
41
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  3914
    ].
36
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  3915
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  3916
    ok ifFalse:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3917
	self cursor:Cursor wait.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3918
	aBlock valueNowOrOnUnwindDo:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3919
	    self cursor:oldCursor
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3920
	]
36
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  3921
    ] ifTrue:[
72
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3922
	cursors := bitmaps collect:[:form | (Cursor sourceForm:form
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3923
						      maskForm:mask
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3924
							  hotX:8
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3925
							  hotY:8) on:device].
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3926
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3927
	process := [
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3928
		    (Delay forSeconds:0.25) wait.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3929
		    [true] whileTrue:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3930
			cursors do:[:curs |
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3931
			    self cursor:curs.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3932
			    (Delay forSeconds:0.05) wait
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3933
			]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3934
		    ]
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3935
		   ] fork.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3936
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3937
	Processor activeProcess priority:7.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3938
	aBlock valueNowOrOnUnwindDo:[
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3939
	    Processor activeProcess priority:8.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3940
	    process terminate.
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3941
	    self cursor:oldCursor
3e84121988c3 *** empty log message ***
claus
parents: 60
diff changeset
  3942
	]
36
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  3943
    ].
41
08a32edcaaa0 *** empty log message ***
claus
parents: 36
diff changeset
  3944
81
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3945
    "
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3946
     View new realize showBusyWhile:[10 timesRepeat:[3000 factorial]]
4ba554473294 *** empty log message ***
claus
parents: 78
diff changeset
  3947
    "
36
b297468551c6 *** empty log message ***
claus
parents: 33
diff changeset
  3948
! !