SimpleView.st
author Claus Gittinger <cg@exept.de>
Wed, 15 Nov 1995 14:09:00 +0100
changeset 227 df0916a17ea2
parent 226 a953669c1ffe
child 248 a3938d4ff96a
permissions -rw-r--r--
*** empty log message ***
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
135
claus
parents:
diff changeset
     1
"
claus
parents:
diff changeset
     2
 COPYRIGHT (c) 1989 by Claus Gittinger
claus
parents:
diff changeset
     3
	      All Rights Reserved
claus
parents:
diff changeset
     4
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
claus
parents:
diff changeset
    10
 hereby transferred.
claus
parents:
diff changeset
    11
"
claus
parents:
diff changeset
    12
140
claus
parents: 138
diff changeset
    13
'From Smalltalk/X, Version:2.10.5 on 9-may-1995 at 12:08:03 pm'!
135
claus
parents:
diff changeset
    14
claus
parents:
diff changeset
    15
PseudoView subclass:#SimpleView
151
claus
parents: 145
diff changeset
    16
	 instanceVariableNames:'superView subViews components 
claus
parents: 145
diff changeset
    17
		styleSheet resources 
claus
parents: 145
diff changeset
    18
		borderColor borderWidth borderShape viewShape 
claus
parents: 145
diff changeset
    19
		top left
claus
parents: 145
diff changeset
    20
		extentChanged originChanged cornerChanged 
claus
parents: 145
diff changeset
    21
claus
parents: 145
diff changeset
    22
		relativeOrigin relativeExtent relativeCorner 
claus
parents: 145
diff changeset
    23
		originRule extentRule cornerRule
claus
parents: 145
diff changeset
    24
		insets viewport
claus
parents: 145
diff changeset
    25
claus
parents: 145
diff changeset
    26
		layout
claus
parents: 145
diff changeset
    27
		shown hiddenOnRealize name level margin innerClipRect 
claus
parents: 145
diff changeset
    28
		shadowColor lightColor 
claus
parents: 145
diff changeset
    29
		bitGravity viewGravity 
claus
parents: 145
diff changeset
    30
		controller windowGroup'
135
claus
parents:
diff changeset
    31
	 classVariableNames:'Grey CentPoint ViewSpacing DefaultStyle StyleSheet
142
claus
parents: 140
diff changeset
    32
		DefaultViewBackgroundColor DefaultBorderColor DefaultLightColor
claus
parents: 140
diff changeset
    33
		DefaultShadowColor DefaultBorderWidth DefaultFont
claus
parents: 140
diff changeset
    34
		DefaultFocusColor DefaultFocusBorderWidth'
135
claus
parents:
diff changeset
    35
	 poolDictionaries:''
claus
parents:
diff changeset
    36
	 category:'Views-Basic'
claus
parents:
diff changeset
    37
!
claus
parents:
diff changeset
    38
140
claus
parents: 138
diff changeset
    39
SimpleView class instanceVariableNames:'ClassResources'
claus
parents: 138
diff changeset
    40
claus
parents: 138
diff changeset
    41
!
135
claus
parents:
diff changeset
    42
claus
parents:
diff changeset
    43
!SimpleView class methodsFor:'documentation'!
claus
parents:
diff changeset
    44
claus
parents:
diff changeset
    45
copyright
claus
parents:
diff changeset
    46
"
claus
parents:
diff changeset
    47
 COPYRIGHT (c) 1989 by Claus Gittinger
claus
parents:
diff changeset
    48
	      All Rights Reserved
claus
parents:
diff changeset
    49
claus
parents:
diff changeset
    50
 This software is furnished under a license and may be used
claus
parents:
diff changeset
    51
 only in accordance with the terms of that license and with the
claus
parents:
diff changeset
    52
 inclusion of the above copyright notice.   This software may not
claus
parents:
diff changeset
    53
 be provided or otherwise made available to, or used by, any
claus
parents:
diff changeset
    54
 other person.  No title to or ownership of the software is
claus
parents:
diff changeset
    55
 hereby transferred.
claus
parents:
diff changeset
    56
"
claus
parents:
diff changeset
    57
!
claus
parents:
diff changeset
    58
claus
parents:
diff changeset
    59
version
227
df0916a17ea2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 226
diff changeset
    60
    ^ '$Header: /cvs/stx/stx/libview/SimpleView.st,v 1.28 1995-11-15 13:09:00 cg Exp $'
135
claus
parents:
diff changeset
    61
!
claus
parents:
diff changeset
    62
claus
parents:
diff changeset
    63
documentation
claus
parents:
diff changeset
    64
"
claus
parents:
diff changeset
    65
    this class implements functions common to all Views which do not work on / show a model. 
claus
parents:
diff changeset
    66
    Previously, all of this functionality used to be in the old View class, but has been
claus
parents:
diff changeset
    67
    separated into this new SimpleView (which does not know about models) and the new View, which
claus
parents:
diff changeset
    68
    does so.
claus
parents:
diff changeset
    69
    Instances of SimpleView are seldom used, most views in the system inherit 
claus
parents:
diff changeset
    70
    from this class. 
claus
parents:
diff changeset
    71
    However, sometimes a view is used to create a dummy view for framing 
claus
parents:
diff changeset
    72
    or layout purposes.
claus
parents:
diff changeset
    73
claus
parents:
diff changeset
    74
    Instance variables:
claus
parents:
diff changeset
    75
claus
parents:
diff changeset
    76
	superView               <View>                  my superview i.e. the view I am in
claus
parents:
diff changeset
    77
	subViews                <Collection>            the collection of subviews
151
claus
parents: 145
diff changeset
    78
	components              <Collection>            collection of gadgets (will be merged with subViews, soon)
claus
parents: 145
diff changeset
    79
135
claus
parents:
diff changeset
    80
	borderColor             <Color>                 color of border
claus
parents:
diff changeset
    81
	borderWidth             <Number>                borderWidth in pixels (device dep.)
claus
parents:
diff changeset
    82
	borderShape             <Form>                  shape of border (if device supports it)
claus
parents:
diff changeset
    83
	viewShape               <Form>                  shape of view (if device supports it)
151
claus
parents: 145
diff changeset
    84
	top                     <Number>                actual top coordinate (pixels) in superview
claus
parents: 145
diff changeset
    85
	left                    <Number>                actual left coordinate (pixels) in superview
135
claus
parents:
diff changeset
    86
	extendChanged           <Boolean>               true if extend changed during setup
claus
parents:
diff changeset
    87
	originChanged           <Boolean>               true if origin changed during setup
151
claus
parents: 145
diff changeset
    88
claus
parents: 145
diff changeset
    89
	viewport                <Rectangle>             my Rectangle in superviews coordinates
135
claus
parents:
diff changeset
    90
	relativeOrigin          <Number>                relative origin in percent within superview
claus
parents:
diff changeset
    91
	relativeExtent          <Number>                relative extent in percent within superview
151
claus
parents: 145
diff changeset
    92
	relativeCorner          <Number>                relative corner in percent within superview
135
claus
parents:
diff changeset
    93
	originRule              <Block>                 rule to compute origin if superview changes size
claus
parents:
diff changeset
    94
	extentRule              <Block>                 rule to compute extent if superview changes size
151
claus
parents: 145
diff changeset
    95
	cornerRule              <Block>                 rule to compute corner if superview changes size
claus
parents: 145
diff changeset
    96
	insets                  <Array>                 array with top, left, bottom & right insets (or nil)
claus
parents: 145
diff changeset
    97
claus
parents: 145
diff changeset
    98
	layout                  <LayoutObject>          not yet implemented - will replace the above layout
claus
parents: 145
diff changeset
    99
							variables.
claus
parents: 145
diff changeset
   100
135
claus
parents:
diff changeset
   101
	shown                   <Boolean>               true if visible (false if iconified, unmapped or covered)
151
claus
parents: 145
diff changeset
   102
	hiddenOnRealize         <Boolean>               dont show automatically when superview is realized
135
claus
parents:
diff changeset
   103
	name                    <String>                my name (future use for resources)
claus
parents:
diff changeset
   104
	level                   <Number>                3D level relative to superview
claus
parents:
diff changeset
   105
	margin                  <Number>                convenient margin
claus
parents:
diff changeset
   106
	innerClipRect           <Rectangle>             convenient inner clip (minus margin)
claus
parents:
diff changeset
   107
	shadowColor             <Color>                 color used to draw 3D shadowed edges
claus
parents:
diff changeset
   108
	lightColor              <Color>                 color used to draw 3D lighted edges
claus
parents:
diff changeset
   109
	bitGravity              <nil | Symbol>          gravity of contents (if device supports it)
claus
parents:
diff changeset
   110
	viewGravity             <nil | Symbol>          gravity of view (if device supports it)
claus
parents:
diff changeset
   111
	controller              <nil | Controller>      the controller (if any)
151
claus
parents: 145
diff changeset
   112
	windowGroup             <WindowGroup>           the windowGroup
135
claus
parents:
diff changeset
   113
claus
parents:
diff changeset
   114
claus
parents:
diff changeset
   115
    Class variables:
claus
parents:
diff changeset
   116
claus
parents:
diff changeset
   117
	Grey                    <Color>                 the color grey - its used so often
151
claus
parents: 145
diff changeset
   118
	ViewSpacing             <Number>                preferred spacing between views; 1mm
135
claus
parents:
diff changeset
   119
claus
parents:
diff changeset
   120
	CentPoint               <Point>                 100 @ 100 - its used so often
claus
parents:
diff changeset
   121
claus
parents:
diff changeset
   122
	StyleSheet              <ResourcePack>          contains all view-style specifics
claus
parents:
diff changeset
   123
claus
parents:
diff changeset
   124
claus
parents:
diff changeset
   125
    styleSheet parameters:
claus
parents:
diff changeset
   126
claus
parents:
diff changeset
   127
	popupShadow             <Boolean>               if true, popupViews show a shadow below
claus
parents:
diff changeset
   128
	popupLevel              <nil | Integer>         3D level
claus
parents:
diff changeset
   129
	borderWidth             <nil | Integer>         borderWidth (ignored in 3D styles)
claus
parents:
diff changeset
   130
	borderColor             <nil | Color>           borderColor (ignored in 3D styles)
claus
parents:
diff changeset
   131
	viewBackground          <nil | Color>           views background
claus
parents:
diff changeset
   132
	shadowColor             <nil | Color>           color for shadow edges (ignored in 2D styles)
claus
parents:
diff changeset
   133
	lightColor              <nil | Color>           color for light edges (ignored in 2D styles)
claus
parents:
diff changeset
   134
	font                    <nil | Font>            font to use
claus
parents:
diff changeset
   135
claus
parents:
diff changeset
   136
claus
parents:
diff changeset
   137
    TODO:
claus
parents:
diff changeset
   138
	get rid of relativeOrigin, relativeCorner, originRule, extentRule,
claus
parents:
diff changeset
   139
	and insets; replace by a single object which defines the size
claus
parents:
diff changeset
   140
	(mhmh - ST-80 seems to call this LayoutFrame ?)
claus
parents:
diff changeset
   141
	-> be prepared for a change here in the near future and ONLY use
151
claus
parents: 145
diff changeset
   142
	   access methods to get those instance variables' values
claus
parents: 145
diff changeset
   143
claus
parents: 145
diff changeset
   144
	get rid of 3D level & margin, move it to extra wrappers
claus
parents: 145
diff changeset
   145
	(although this will make view setup more complicated, it will remove
claus
parents: 145
diff changeset
   146
	 complexity from the internals of view. Also, it will allow for more
claus
parents: 145
diff changeset
   147
	 varieties of borders.)
claus
parents: 145
diff changeset
   148
        
135
claus
parents:
diff changeset
   149
	add components (could also call them gadgets or lightweight views)
claus
parents:
diff changeset
   150
	- views are expensive in terms of X resources. This would make all
claus
parents:
diff changeset
   151
	framing/edge and panel helper views become cheap ST objects, instead
claus
parents:
diff changeset
   152
	of views.
claus
parents:
diff changeset
   153
"
151
claus
parents: 145
diff changeset
   154
!
claus
parents: 145
diff changeset
   155
claus
parents: 145
diff changeset
   156
layoutComputation 
claus
parents: 145
diff changeset
   157
"
claus
parents: 145
diff changeset
   158
    Due to historic reasons, there are 2 mechanisms to resize a view:
claus
parents: 145
diff changeset
   159
	- (old, to be eliminated mechanism)
claus
parents: 145
diff changeset
   160
	    based upon info found in 
claus
parents: 145
diff changeset
   161
		relativeOrigin / relativeCorner / relativeExtent
claus
parents: 145
diff changeset
   162
		originRule / cornerRule / extentRule
claus
parents: 145
diff changeset
   163
claus
parents: 145
diff changeset
   164
	- (new, will migrate to that one)
claus
parents: 145
diff changeset
   165
	    letting a layoutObject compute things
claus
parents: 145
diff changeset
   166
claus
parents: 145
diff changeset
   167
    Actually, the old mechanism is just as powerful, as the new (layoutObject
claus
parents: 145
diff changeset
   168
    based) mechanism; with the help of block=rules, you can compute whatever
claus
parents: 145
diff changeset
   169
    geometry is desired.
claus
parents: 145
diff changeset
   170
    However, having 6 instance variables in every view creates some overhead,
claus
parents: 145
diff changeset
   171
    which can be avoided in most cases (most views are either fixed-size or
claus
parents: 145
diff changeset
   172
    relative-sized).
claus
parents: 145
diff changeset
   173
    Therefore (and also to make porting of ST-80 apps easier), ST/X will migrate 
claus
parents: 145
diff changeset
   174
    to use layoutObjects.
claus
parents: 145
diff changeset
   175
    You will not see a difference at the views protocol level, since
claus
parents: 145
diff changeset
   176
    existing interfaces will (silently) create layoutObjects as appropriate.
claus
parents: 145
diff changeset
   177
    However, you should remove all direct accesses to the above mentioned
claus
parents: 145
diff changeset
   178
    instance variables, to be prepared for that change.
claus
parents: 145
diff changeset
   179
claus
parents: 145
diff changeset
   180
    Notice, that a view recomputes its size whenever its superview
claus
parents: 145
diff changeset
   181
    changes size. This is done via:
claus
parents: 145
diff changeset
   182
	sizeChanged
claus
parents: 145
diff changeset
   183
	    -> allSubviews: superViewChangedSize
claus
parents: 145
diff changeset
   184
claus
parents: 145
diff changeset
   185
    If the geometry computation as performed in superViewChangedSize
claus
parents: 145
diff changeset
   186
    is not powerful enough for your application, you can either:
claus
parents: 145
diff changeset
   187
	- redefine superViewChangedSize
claus
parents: 145
diff changeset
   188
	- create a special layoutObject which computes a new layout.
claus
parents: 145
diff changeset
   189
"
claus
parents: 145
diff changeset
   190
!
claus
parents: 145
diff changeset
   191
claus
parents: 145
diff changeset
   192
examples 
claus
parents: 145
diff changeset
   193
"
claus
parents: 145
diff changeset
   194
    (all examples below use different viewBackgrounds, 
claus
parents: 145
diff changeset
   195
     to make the individual subviews visible)
claus
parents: 145
diff changeset
   196
claus
parents: 145
diff changeset
   197
    fixed position/size:
claus
parents: 145
diff changeset
   198
claus
parents: 145
diff changeset
   199
       |top v1 v2|
claus
parents: 145
diff changeset
   200
claus
parents: 145
diff changeset
   201
       top := StandardSystemView new.
claus
parents: 145
diff changeset
   202
       top extent:300@300.
claus
parents: 145
diff changeset
   203
claus
parents: 145
diff changeset
   204
       v1 := View origin:10@10
claus
parents: 145
diff changeset
   205
		  corner:50@50
claus
parents: 145
diff changeset
   206
		      in:top.
claus
parents: 145
diff changeset
   207
       v2 := View origin:60@10
claus
parents: 145
diff changeset
   208
		  corner:150@100
claus
parents: 145
diff changeset
   209
		      in:top.
claus
parents: 145
diff changeset
   210
claus
parents: 145
diff changeset
   211
       v1 viewBackground:(Color red).
claus
parents: 145
diff changeset
   212
       v2 viewBackground:(Color yellow).
claus
parents: 145
diff changeset
   213
claus
parents: 145
diff changeset
   214
       top open
claus
parents: 145
diff changeset
   215
claus
parents: 145
diff changeset
   216
claus
parents: 145
diff changeset
   217
    same, using ST-80 way of bulding up view hierarchies
claus
parents: 145
diff changeset
   218
    (recommended, if you plan to port applications later)
claus
parents: 145
diff changeset
   219
claus
parents: 145
diff changeset
   220
       |top v1 v2|
claus
parents: 145
diff changeset
   221
claus
parents: 145
diff changeset
   222
       top := StandardSystemView new.
claus
parents: 145
diff changeset
   223
       top extent:300@300.
claus
parents: 145
diff changeset
   224
claus
parents: 145
diff changeset
   225
       v1 := View new.
claus
parents: 145
diff changeset
   226
       v1 origin:10@10 corner:50@50.
claus
parents: 145
diff changeset
   227
claus
parents: 145
diff changeset
   228
       v2 := View new.
claus
parents: 145
diff changeset
   229
       v2 origin:60@10 corner:150@100.
claus
parents: 145
diff changeset
   230
claus
parents: 145
diff changeset
   231
       v1 viewBackground:(Color red).
claus
parents: 145
diff changeset
   232
       v2 viewBackground:(Color yellow).
claus
parents: 145
diff changeset
   233
claus
parents: 145
diff changeset
   234
       top add:v1.
claus
parents: 145
diff changeset
   235
       top add:v2.
claus
parents: 145
diff changeset
   236
claus
parents: 145
diff changeset
   237
       v1 viewBackground:(Color red).
claus
parents: 145
diff changeset
   238
       v2 viewBackground:(Color yellow).
claus
parents: 145
diff changeset
   239
claus
parents: 145
diff changeset
   240
       top open
claus
parents: 145
diff changeset
   241
claus
parents: 145
diff changeset
   242
claus
parents: 145
diff changeset
   243
    fixed origin, variable size:
claus
parents: 145
diff changeset
   244
claus
parents: 145
diff changeset
   245
       |top v1 v2|
claus
parents: 145
diff changeset
   246
claus
parents: 145
diff changeset
   247
       top := StandardSystemView new.
claus
parents: 145
diff changeset
   248
       top extent:300@300.
claus
parents: 145
diff changeset
   249
claus
parents: 145
diff changeset
   250
       v1 := View new.
claus
parents: 145
diff changeset
   251
       v1 origin:10@10 corner:50@0.5.
claus
parents: 145
diff changeset
   252
claus
parents: 145
diff changeset
   253
       v2 := View new.
claus
parents: 145
diff changeset
   254
       v2 origin:60@10 corner:150@0.5.
claus
parents: 145
diff changeset
   255
claus
parents: 145
diff changeset
   256
       v1 viewBackground:(Color red).
claus
parents: 145
diff changeset
   257
       v2 viewBackground:(Color yellow).
claus
parents: 145
diff changeset
   258
claus
parents: 145
diff changeset
   259
       top add:v1.
claus
parents: 145
diff changeset
   260
       top add:v2.
claus
parents: 145
diff changeset
   261
claus
parents: 145
diff changeset
   262
       top open
claus
parents: 145
diff changeset
   263
claus
parents: 145
diff changeset
   264
claus
parents: 145
diff changeset
   265
    fixed origin, variable size, 
claus
parents: 145
diff changeset
   266
    bottomInset for constant distance from bottom:
claus
parents: 145
diff changeset
   267
claus
parents: 145
diff changeset
   268
       |top v1 v2|
claus
parents: 145
diff changeset
   269
claus
parents: 145
diff changeset
   270
       top := StandardSystemView new.
claus
parents: 145
diff changeset
   271
       top extent:300@300.
claus
parents: 145
diff changeset
   272
claus
parents: 145
diff changeset
   273
       v1 := View new.
claus
parents: 145
diff changeset
   274
       v1 origin:10@10 corner:50@1.0.
claus
parents: 145
diff changeset
   275
       v1 bottomInset:10.
claus
parents: 145
diff changeset
   276
claus
parents: 145
diff changeset
   277
       v2 := View new.
claus
parents: 145
diff changeset
   278
       v2 origin:60@10 corner:150@1.0.
claus
parents: 145
diff changeset
   279
       v2 bottomInset:10.
claus
parents: 145
diff changeset
   280
claus
parents: 145
diff changeset
   281
       v1 viewBackground:(Color red).
claus
parents: 145
diff changeset
   282
       v2 viewBackground:(Color yellow).
claus
parents: 145
diff changeset
   283
claus
parents: 145
diff changeset
   284
       top add:v1.
claus
parents: 145
diff changeset
   285
       top add:v2.
claus
parents: 145
diff changeset
   286
claus
parents: 145
diff changeset
   287
       top open
claus
parents: 145
diff changeset
   288
claus
parents: 145
diff changeset
   289
claus
parents: 145
diff changeset
   290
    variable origin, variable size, 
claus
parents: 145
diff changeset
   291
claus
parents: 145
diff changeset
   292
       |top v1 v2|
claus
parents: 145
diff changeset
   293
claus
parents: 145
diff changeset
   294
       top := StandardSystemView new.
claus
parents: 145
diff changeset
   295
       top extent:300@300.
claus
parents: 145
diff changeset
   296
claus
parents: 145
diff changeset
   297
       v1 := View new.
claus
parents: 145
diff changeset
   298
       v1 origin:0.0@0.0 corner:0.5@0.5.
claus
parents: 145
diff changeset
   299
claus
parents: 145
diff changeset
   300
       v2 := View new.
claus
parents: 145
diff changeset
   301
       v2 origin:0.5@0.0 corner:1.0@0.5.
claus
parents: 145
diff changeset
   302
claus
parents: 145
diff changeset
   303
       v1 viewBackground:(Color red).
claus
parents: 145
diff changeset
   304
       v2 viewBackground:(Color yellow).
claus
parents: 145
diff changeset
   305
claus
parents: 145
diff changeset
   306
       top add:v1.
claus
parents: 145
diff changeset
   307
       top add:v2.
claus
parents: 145
diff changeset
   308
claus
parents: 145
diff changeset
   309
       top open
claus
parents: 145
diff changeset
   310
claus
parents: 145
diff changeset
   311
claus
parents: 145
diff changeset
   312
    variable origin, variable size, 
claus
parents: 145
diff changeset
   313
    insets for some constant distance
claus
parents: 145
diff changeset
   314
claus
parents: 145
diff changeset
   315
       |top v1 v2|
claus
parents: 145
diff changeset
   316
claus
parents: 145
diff changeset
   317
       top := StandardSystemView new.
claus
parents: 145
diff changeset
   318
       top extent:300@300.
claus
parents: 145
diff changeset
   319
claus
parents: 145
diff changeset
   320
       v1 := View new.
claus
parents: 145
diff changeset
   321
       v1 origin:0.0@0.0 corner:0.5@0.5.
claus
parents: 145
diff changeset
   322
       v1 rightInset:5.
claus
parents: 145
diff changeset
   323
claus
parents: 145
diff changeset
   324
       v2 := View new.
claus
parents: 145
diff changeset
   325
       v2 origin:0.5@0.0 corner:1.0@0.5.
claus
parents: 145
diff changeset
   326
       v2 leftInset:5.
claus
parents: 145
diff changeset
   327
claus
parents: 145
diff changeset
   328
       v1 viewBackground:(Color red).
claus
parents: 145
diff changeset
   329
       v2 viewBackground:(Color yellow).
claus
parents: 145
diff changeset
   330
claus
parents: 145
diff changeset
   331
       top add:v1.
claus
parents: 145
diff changeset
   332
       top add:v2.
claus
parents: 145
diff changeset
   333
claus
parents: 145
diff changeset
   334
       top open
claus
parents: 145
diff changeset
   335
claus
parents: 145
diff changeset
   336
claus
parents: 145
diff changeset
   337
    using layout objects (ST-80 style):
claus
parents: 145
diff changeset
   338
    fully specifying the frame
claus
parents: 145
diff changeset
   339
claus
parents: 145
diff changeset
   340
       |top v1 v2|
claus
parents: 145
diff changeset
   341
claus
parents: 145
diff changeset
   342
       top := StandardSystemView new.
claus
parents: 145
diff changeset
   343
       top extent:300@300.
claus
parents: 145
diff changeset
   344
claus
parents: 145
diff changeset
   345
       v1 := View new.
claus
parents: 145
diff changeset
   346
       v2 := View new.
claus
parents: 145
diff changeset
   347
claus
parents: 145
diff changeset
   348
       v1 viewBackground:(Color red).
claus
parents: 145
diff changeset
   349
       v2 viewBackground:(Color yellow).
claus
parents: 145
diff changeset
   350
claus
parents: 145
diff changeset
   351
       top add:v1 in:(LayoutFrame new
claus
parents: 145
diff changeset
   352
			leftFraction:0.25;
claus
parents: 145
diff changeset
   353
			rightFraction:0.75;
claus
parents: 145
diff changeset
   354
			topFraction:0.0;
claus
parents: 145
diff changeset
   355
			bottomFraction:0.5).
claus
parents: 145
diff changeset
   356
       top add:v2 in:(LayoutFrame new
claus
parents: 145
diff changeset
   357
			leftFraction:0.5;
claus
parents: 145
diff changeset
   358
			rightFraction:1.0;
claus
parents: 145
diff changeset
   359
			topFraction:0.5;
claus
parents: 145
diff changeset
   360
			bottomFraction:0.75).
claus
parents: 145
diff changeset
   361
claus
parents: 145
diff changeset
   362
       top open
claus
parents: 145
diff changeset
   363
claus
parents: 145
diff changeset
   364
claus
parents: 145
diff changeset
   365
    another one, with offsets:
claus
parents: 145
diff changeset
   366
claus
parents: 145
diff changeset
   367
       |top v1 v2|
claus
parents: 145
diff changeset
   368
claus
parents: 145
diff changeset
   369
       top := StandardSystemView new.
claus
parents: 145
diff changeset
   370
       top extent:300@300.
claus
parents: 145
diff changeset
   371
claus
parents: 145
diff changeset
   372
       v1 := View new.
claus
parents: 145
diff changeset
   373
       v2 := View new.
claus
parents: 145
diff changeset
   374
claus
parents: 145
diff changeset
   375
       v1 viewBackground:(Color red).
claus
parents: 145
diff changeset
   376
       v2 viewBackground:(Color yellow).
claus
parents: 145
diff changeset
   377
claus
parents: 145
diff changeset
   378
       top add:v1 in:(LayoutFrame new
claus
parents: 145
diff changeset
   379
			leftFraction:0.0 offset:10;
claus
parents: 145
diff changeset
   380
			rightFraction:1.0 offset:-10;
claus
parents: 145
diff changeset
   381
			topFraction:0.0 offset:10;
claus
parents: 145
diff changeset
   382
			bottomFraction:0.5).
claus
parents: 145
diff changeset
   383
       top add:v2 in:(LayoutFrame new
claus
parents: 145
diff changeset
   384
			leftFraction:0.0 offset:30;
claus
parents: 145
diff changeset
   385
			rightFraction:1.0 offset:-30;
claus
parents: 145
diff changeset
   386
			topFraction:0.5 offset:10;
claus
parents: 145
diff changeset
   387
			bottomFraction:0.75).
claus
parents: 145
diff changeset
   388
claus
parents: 145
diff changeset
   389
       top open
claus
parents: 145
diff changeset
   390
claus
parents: 145
diff changeset
   391
claus
parents: 145
diff changeset
   392
    specifying origin only. Extent is views preferred
claus
parents: 145
diff changeset
   393
    (notice, that plain views have some defaultExtent of 100@100)
claus
parents: 145
diff changeset
   394
claus
parents: 145
diff changeset
   395
       |top v1 v2|
claus
parents: 145
diff changeset
   396
claus
parents: 145
diff changeset
   397
       top := StandardSystemView new.
claus
parents: 145
diff changeset
   398
       top extent:300@300.
claus
parents: 145
diff changeset
   399
claus
parents: 145
diff changeset
   400
       v1 := View new.
claus
parents: 145
diff changeset
   401
       v2 := View new.
claus
parents: 145
diff changeset
   402
claus
parents: 145
diff changeset
   403
       v1 viewBackground:(Color red).
claus
parents: 145
diff changeset
   404
       v2 viewBackground:(Color yellow).
claus
parents: 145
diff changeset
   405
claus
parents: 145
diff changeset
   406
       top add:v1 in:(LayoutOrigin new
claus
parents: 145
diff changeset
   407
			leftFraction:0.25;
claus
parents: 145
diff changeset
   408
			topFraction:0.0).
claus
parents: 145
diff changeset
   409
       top add:v2 in:(LayoutOrigin new
claus
parents: 145
diff changeset
   410
			leftFraction:0.5;
claus
parents: 145
diff changeset
   411
			topFraction:0.5).
claus
parents: 145
diff changeset
   412
claus
parents: 145
diff changeset
   413
       top open
claus
parents: 145
diff changeset
   414
claus
parents: 145
diff changeset
   415
    same example, using buttons which compute their preferredBounds:
claus
parents: 145
diff changeset
   416
claus
parents: 145
diff changeset
   417
       |top v1 v2|
claus
parents: 145
diff changeset
   418
claus
parents: 145
diff changeset
   419
       top := StandardSystemView new.
claus
parents: 145
diff changeset
   420
       top extent:300@300.
claus
parents: 145
diff changeset
   421
claus
parents: 145
diff changeset
   422
       v1 := Button label:'foo'.
claus
parents: 145
diff changeset
   423
       v2 := Button label:'a very long buttonLabel'.
claus
parents: 145
diff changeset
   424
claus
parents: 145
diff changeset
   425
       v1 backgroundColor:(Color red).
claus
parents: 145
diff changeset
   426
       v2 backgroundColor:(Color yellow).
claus
parents: 145
diff changeset
   427
claus
parents: 145
diff changeset
   428
       top add:v1 in:(LayoutOrigin new
claus
parents: 145
diff changeset
   429
			leftFraction:0.25;
claus
parents: 145
diff changeset
   430
			topFraction:0.0).
claus
parents: 145
diff changeset
   431
       top add:v2 in:(LayoutOrigin new
claus
parents: 145
diff changeset
   432
			leftFraction:0.5;
claus
parents: 145
diff changeset
   433
			topFraction:0.5).
claus
parents: 145
diff changeset
   434
claus
parents: 145
diff changeset
   435
       top open
claus
parents: 145
diff changeset
   436
claus
parents: 145
diff changeset
   437
"
135
claus
parents:
diff changeset
   438
! !
claus
parents:
diff changeset
   439
claus
parents:
diff changeset
   440
!SimpleView class methodsFor:'initialization'!
claus
parents:
diff changeset
   441
claus
parents:
diff changeset
   442
initialize
claus
parents:
diff changeset
   443
    DefaultStyle isNil ifTrue:[
claus
parents:
diff changeset
   444
	Font initialize.
claus
parents:
diff changeset
   445
	Form initialize.
claus
parents:
diff changeset
   446
	Color initialize.
claus
parents:
diff changeset
   447
claus
parents:
diff changeset
   448
	Display notNil ifTrue:[
claus
parents:
diff changeset
   449
	    self defaultStyle:#normal.
claus
parents:
diff changeset
   450
	].
claus
parents:
diff changeset
   451
claus
parents:
diff changeset
   452
"/    self updateStyleCache.
claus
parents:
diff changeset
   453
	self == SimpleView ifTrue:[
claus
parents:
diff changeset
   454
	    Smalltalk addDependent:self   "/ to get language changes
claus
parents:
diff changeset
   455
	]
claus
parents:
diff changeset
   456
    ]
claus
parents:
diff changeset
   457
!
claus
parents:
diff changeset
   458
claus
parents:
diff changeset
   459
postAutoload
claus
parents:
diff changeset
   460
    self updateStyleCache.
claus
parents:
diff changeset
   461
! !
claus
parents:
diff changeset
   462
claus
parents:
diff changeset
   463
!SimpleView class methodsFor:'instance creation'!
claus
parents:
diff changeset
   464
140
claus
parents: 138
diff changeset
   465
on:aModel
claus
parents: 138
diff changeset
   466
    "create a new drawable on aModel"
claus
parents: 138
diff changeset
   467
claus
parents: 138
diff changeset
   468
    "although this one does not know about models,
claus
parents: 138
diff changeset
   469
     it can still send the model-assign message. This was done
claus
parents: 138
diff changeset
   470
     to catch obsolete calls to on:aDevice.
claus
parents: 138
diff changeset
   471
    "
claus
parents: 138
diff changeset
   472
    ^ self new model:aModel.
135
claus
parents:
diff changeset
   473
!
claus
parents:
diff changeset
   474
claus
parents:
diff changeset
   475
in:aView
claus
parents:
diff changeset
   476
    "return a new view as a subview of aView.
claus
parents:
diff changeset
   477
     If aView is nil, it is left unspecified, in which superview
claus
parents:
diff changeset
   478
     the new view will be placed. The view can later be assigned
claus
parents:
diff changeset
   479
     by adding it to the superview via #addSubView:.
claus
parents:
diff changeset
   480
     If realized and no superview has ever been set, it will come
claus
parents:
diff changeset
   481
     up as a topview."
claus
parents:
diff changeset
   482
claus
parents:
diff changeset
   483
    |newView|
claus
parents:
diff changeset
   484
claus
parents:
diff changeset
   485
    newView := self basicNew.
claus
parents:
diff changeset
   486
    aView notNil ifTrue:[
claus
parents:
diff changeset
   487
	newView device:(aView device).
claus
parents:
diff changeset
   488
	newView superView:aView.
claus
parents:
diff changeset
   489
    ] ifFalse:[
151
claus
parents: 145
diff changeset
   490
	newView device:Screen current "Display"
135
claus
parents:
diff changeset
   491
    ].
claus
parents:
diff changeset
   492
    newView initialize.
claus
parents:
diff changeset
   493
    aView notNil ifTrue:[aView addSubView:newView].
claus
parents:
diff changeset
   494
    ^ newView
claus
parents:
diff changeset
   495
!
claus
parents:
diff changeset
   496
140
claus
parents: 138
diff changeset
   497
label:label
claus
parents: 138
diff changeset
   498
    "create a new view with given label"
135
claus
parents:
diff changeset
   499
claus
parents:
diff changeset
   500
    ^ self origin:nil extent:nil borderWidth:nil
140
claus
parents: 138
diff changeset
   501
		      font:nil label:label in:nil
claus
parents: 138
diff changeset
   502
!
claus
parents: 138
diff changeset
   503
claus
parents: 138
diff changeset
   504
origin:origin corner:corner in:aView
135
claus
parents:
diff changeset
   505
    "create a new view as a subview of aView with given origin and extent"
claus
parents:
diff changeset
   506
140
claus
parents: 138
diff changeset
   507
    ^ self origin:origin corner:corner borderWidth:nil
135
claus
parents:
diff changeset
   508
			 font:nil label:nil in:aView
claus
parents:
diff changeset
   509
!
claus
parents:
diff changeset
   510
claus
parents:
diff changeset
   511
origin:anOrigin extent:anExtent borderWidth:bw font:aFont label:aLabel in:aView
claus
parents:
diff changeset
   512
    |newView|
claus
parents:
diff changeset
   513
claus
parents:
diff changeset
   514
    aView notNil ifTrue:[
claus
parents:
diff changeset
   515
	newView := self basicNew.
claus
parents:
diff changeset
   516
	newView device:(aView device).
claus
parents:
diff changeset
   517
	aView addSubView:newView.
claus
parents:
diff changeset
   518
	newView initialize
claus
parents:
diff changeset
   519
    ] ifFalse:[
151
claus
parents: 145
diff changeset
   520
	newView := self onDevice:Screen current "Display"
135
claus
parents:
diff changeset
   521
    ].
claus
parents:
diff changeset
   522
    bw notNil ifTrue:[newView borderWidth:bw].
claus
parents:
diff changeset
   523
    anExtent notNil ifTrue:[newView extent:anExtent].
claus
parents:
diff changeset
   524
    anOrigin notNil ifTrue:[newView origin:anOrigin].
claus
parents:
diff changeset
   525
    aFont notNil ifTrue:[newView font:aFont].
claus
parents:
diff changeset
   526
    aLabel notNil ifTrue:[newView label:aLabel].
claus
parents:
diff changeset
   527
    ^ newView
claus
parents:
diff changeset
   528
!
claus
parents:
diff changeset
   529
claus
parents:
diff changeset
   530
origin:anOrigin corner:aCorner borderWidth:bw font:aFont label:aLabel in:aView
claus
parents:
diff changeset
   531
    |newView|
claus
parents:
diff changeset
   532
claus
parents:
diff changeset
   533
    aView notNil ifTrue:[
claus
parents:
diff changeset
   534
	newView := self basicNew.
claus
parents:
diff changeset
   535
	newView device:(aView device).
claus
parents:
diff changeset
   536
	aView addSubView:newView.
claus
parents:
diff changeset
   537
	newView initialize
claus
parents:
diff changeset
   538
    ] ifFalse:[
151
claus
parents: 145
diff changeset
   539
	newView := self onDevice:Screen current "Display"
135
claus
parents:
diff changeset
   540
    ].
claus
parents:
diff changeset
   541
    bw notNil ifTrue:[newView borderWidth:bw].
claus
parents:
diff changeset
   542
    anOrigin notNil ifTrue:[newView origin:anOrigin].
claus
parents:
diff changeset
   543
    aCorner notNil ifTrue:[newView corner:aCorner].
claus
parents:
diff changeset
   544
    aFont notNil ifTrue:[newView font:aFont].
claus
parents:
diff changeset
   545
    aLabel notNil ifTrue:[newView label:aLabel].
claus
parents:
diff changeset
   546
    ^ newView
claus
parents:
diff changeset
   547
!
claus
parents:
diff changeset
   548
140
claus
parents: 138
diff changeset
   549
label:label in:aView
claus
parents: 138
diff changeset
   550
    "create a new view as subview of aView with given label"
135
claus
parents:
diff changeset
   551
claus
parents:
diff changeset
   552
    ^ self origin:nil extent:nil borderWidth:nil
140
claus
parents: 138
diff changeset
   553
		      font:nil label:label in:aView
claus
parents: 138
diff changeset
   554
!
claus
parents: 138
diff changeset
   555
claus
parents: 138
diff changeset
   556
onSameDeviceAs:anotherView
claus
parents: 138
diff changeset
   557
    "create a view on the same device as anotherView.
claus
parents: 138
diff changeset
   558
     Used with popUpMenus, which should be created on the device of
claus
parents: 138
diff changeset
   559
     its masterView."
claus
parents: 138
diff changeset
   560
claus
parents: 138
diff changeset
   561
    |device|
claus
parents: 138
diff changeset
   562
claus
parents: 138
diff changeset
   563
    anotherView notNil ifTrue:[
claus
parents: 138
diff changeset
   564
	device := anotherView device.
claus
parents: 138
diff changeset
   565
    ] ifFalse:[
151
claus
parents: 145
diff changeset
   566
	device := Screen current "Display".
140
claus
parents: 138
diff changeset
   567
    ].
claus
parents: 138
diff changeset
   568
    ^ self onDevice:device
claus
parents: 138
diff changeset
   569
!
claus
parents: 138
diff changeset
   570
claus
parents: 138
diff changeset
   571
extent:extent in:aView
claus
parents: 138
diff changeset
   572
    "create a new view as a subview of aView with given extent"
claus
parents: 138
diff changeset
   573
claus
parents: 138
diff changeset
   574
    ^ self origin:nil extent:extent borderWidth:nil
claus
parents: 138
diff changeset
   575
		      font:nil label:nil in:aView
135
claus
parents:
diff changeset
   576
!
claus
parents:
diff changeset
   577
claus
parents:
diff changeset
   578
origin:anOrigin extent:anExtent
claus
parents:
diff changeset
   579
		label:aLabel icon:aForm
claus
parents:
diff changeset
   580
		minExtent:minExtent maxExtent:maxExtent
claus
parents:
diff changeset
   581
    |newView|
claus
parents:
diff changeset
   582
151
claus
parents: 145
diff changeset
   583
    newView := self onDevice:Screen current "Display".
135
claus
parents:
diff changeset
   584
    anOrigin notNil ifTrue:[newView origin:anOrigin].
claus
parents:
diff changeset
   585
    anExtent notNil ifTrue:[newView extent:anExtent].
claus
parents:
diff changeset
   586
    aLabel notNil ifTrue:[newView label:aLabel].
claus
parents:
diff changeset
   587
    aForm notNil ifTrue:[newView icon:aForm].
claus
parents:
diff changeset
   588
    minExtent notNil ifTrue:[newView minExtent:minExtent].
claus
parents:
diff changeset
   589
    maxExtent notNil ifTrue:[newView maxExtent:maxExtent].
claus
parents:
diff changeset
   590
    ^ newView
claus
parents:
diff changeset
   591
!
claus
parents:
diff changeset
   592
140
claus
parents: 138
diff changeset
   593
extent:extent
claus
parents: 138
diff changeset
   594
    "create a new view with given extent"
claus
parents: 138
diff changeset
   595
claus
parents: 138
diff changeset
   596
    ^ self origin:nil extent:extent borderWidth:nil
claus
parents: 138
diff changeset
   597
		      font:nil label:nil in:nil
claus
parents: 138
diff changeset
   598
!
claus
parents: 138
diff changeset
   599
claus
parents: 138
diff changeset
   600
origin:origin extent:extent in:aView
claus
parents: 138
diff changeset
   601
    "create a new view as a subview of aView with given origin and extent"
claus
parents: 138
diff changeset
   602
claus
parents: 138
diff changeset
   603
    ^ self origin:origin extent:extent borderWidth:nil
claus
parents: 138
diff changeset
   604
			 font:nil label:nil in:aView
claus
parents: 138
diff changeset
   605
!
claus
parents: 138
diff changeset
   606
claus
parents: 138
diff changeset
   607
origin:origin in:aView
claus
parents: 138
diff changeset
   608
    "create a new view as a subview of aView with given origin"
claus
parents: 138
diff changeset
   609
claus
parents: 138
diff changeset
   610
    ^ self origin:origin extent:nil borderWidth:nil
claus
parents: 138
diff changeset
   611
			 font:nil label:nil in:aView
claus
parents: 138
diff changeset
   612
!
claus
parents: 138
diff changeset
   613
claus
parents: 138
diff changeset
   614
origin:origin extent:extent
claus
parents: 138
diff changeset
   615
    "create a new view with given origin and extent"
claus
parents: 138
diff changeset
   616
claus
parents: 138
diff changeset
   617
    ^ self origin:origin extent:extent borderWidth:nil
claus
parents: 138
diff changeset
   618
			 font:nil label:nil in:nil
claus
parents: 138
diff changeset
   619
!
claus
parents: 138
diff changeset
   620
claus
parents: 138
diff changeset
   621
origin:origin extent:extent borderWidth:bw in:aView
claus
parents: 138
diff changeset
   622
    "create a new view as a subview of aView with given origin, extent
claus
parents: 138
diff changeset
   623
     and borderWidth"
claus
parents: 138
diff changeset
   624
claus
parents: 138
diff changeset
   625
    ^ self origin:origin extent:extent borderWidth:bw
claus
parents: 138
diff changeset
   626
			 font:nil label:nil in:aView
claus
parents: 138
diff changeset
   627
!
claus
parents: 138
diff changeset
   628
claus
parents: 138
diff changeset
   629
origin:origin extent:extent borderWidth:bw
claus
parents: 138
diff changeset
   630
    "create a new view with given origin, extent and borderWidth"
claus
parents: 138
diff changeset
   631
claus
parents: 138
diff changeset
   632
    ^ self origin:origin extent:extent borderWidth:bw
claus
parents: 138
diff changeset
   633
			 font:nil label:nil in:nil
claus
parents: 138
diff changeset
   634
!
claus
parents: 138
diff changeset
   635
135
claus
parents:
diff changeset
   636
extent:extent label:label
claus
parents:
diff changeset
   637
    "create a new view with given extent and label"
claus
parents:
diff changeset
   638
claus
parents:
diff changeset
   639
    ^ self origin:nil extent:extent borderWidth:nil
claus
parents:
diff changeset
   640
		      font:nil label:label in:nil
claus
parents:
diff changeset
   641
!
claus
parents:
diff changeset
   642
140
claus
parents: 138
diff changeset
   643
origin:origin corner:corner 
claus
parents: 138
diff changeset
   644
    "create a new view with given origin and extent"
claus
parents: 138
diff changeset
   645
claus
parents: 138
diff changeset
   646
    ^ self origin:origin corner:corner borderWidth:nil
claus
parents: 138
diff changeset
   647
			 font:nil label:nil in:nil
claus
parents: 138
diff changeset
   648
!
claus
parents: 138
diff changeset
   649
135
claus
parents:
diff changeset
   650
origin:origin extent:extent label:label
claus
parents:
diff changeset
   651
    "create a new view with given origin, extent and label"
claus
parents:
diff changeset
   652
claus
parents:
diff changeset
   653
    ^ self origin:origin extent:extent borderWidth:nil
claus
parents:
diff changeset
   654
			 font:nil label:label in:nil
claus
parents:
diff changeset
   655
!
claus
parents:
diff changeset
   656
claus
parents:
diff changeset
   657
origin:origin extent:extent font:aFont label:label
claus
parents:
diff changeset
   658
    ^ self origin:origin extent:extent borderWidth:nil
claus
parents:
diff changeset
   659
			 font:nil label:label in:nil
claus
parents:
diff changeset
   660
!
claus
parents:
diff changeset
   661
claus
parents:
diff changeset
   662
origin:origin extent:extent font:aFont label:label in:aView
claus
parents:
diff changeset
   663
    ^ self origin:origin extent:extent borderWidth:nil
claus
parents:
diff changeset
   664
			 font:aFont label:label in:aView
claus
parents:
diff changeset
   665
!
claus
parents:
diff changeset
   666
claus
parents:
diff changeset
   667
origin:origin corner:corner borderWidth:bw in:aView
claus
parents:
diff changeset
   668
    "create a new view as a subview of aView with given origin and extent"
claus
parents:
diff changeset
   669
claus
parents:
diff changeset
   670
    ^ self origin:origin corner:corner borderWidth:bw
claus
parents:
diff changeset
   671
			 font:nil label:nil in:aView
claus
parents:
diff changeset
   672
! !
claus
parents:
diff changeset
   673
claus
parents:
diff changeset
   674
!SimpleView class methodsFor:'resources'!
claus
parents:
diff changeset
   675
claus
parents:
diff changeset
   676
classResources
claus
parents:
diff changeset
   677
    "if not already loaded, get the classes resourcePack
claus
parents:
diff changeset
   678
     and return it"
claus
parents:
diff changeset
   679
claus
parents:
diff changeset
   680
    ClassResources isNil ifTrue:[
claus
parents:
diff changeset
   681
	ClassResources := ResourcePack for:self.
claus
parents:
diff changeset
   682
    ].
claus
parents:
diff changeset
   683
    ^ ClassResources
claus
parents:
diff changeset
   684
!
claus
parents:
diff changeset
   685
claus
parents:
diff changeset
   686
classResources:aResourcePack
claus
parents:
diff changeset
   687
    "allow setting of the classResources"
claus
parents:
diff changeset
   688
claus
parents:
diff changeset
   689
    ClassResources := aResourcePack
claus
parents:
diff changeset
   690
!
claus
parents:
diff changeset
   691
claus
parents:
diff changeset
   692
flushAllClassResources
claus
parents:
diff changeset
   693
    "flush all classes resource translations.
claus
parents:
diff changeset
   694
     Needed after a resource file has changed."
claus
parents:
diff changeset
   695
claus
parents:
diff changeset
   696
    ResourcePack flushCachedResourcePacks.
140
claus
parents: 138
diff changeset
   697
    SimpleView flushClassResources.
claus
parents: 138
diff changeset
   698
    SimpleView allSubclasses do:[:aClass |
135
claus
parents:
diff changeset
   699
	aClass flushClassResources.
claus
parents:
diff changeset
   700
    ]
claus
parents:
diff changeset
   701
claus
parents:
diff changeset
   702
    "
claus
parents:
diff changeset
   703
     View flushAllClassResources
claus
parents:
diff changeset
   704
    "
claus
parents:
diff changeset
   705
    "to change the language:
claus
parents:
diff changeset
   706
	Language := #english.
claus
parents:
diff changeset
   707
	Smalltalk changed:#Language.
claus
parents:
diff changeset
   708
	View flushAllClassResources
claus
parents:
diff changeset
   709
     or:
claus
parents:
diff changeset
   710
	Language := #german.
claus
parents:
diff changeset
   711
	Smalltalk changed:#Language.
claus
parents:
diff changeset
   712
	View flushAllClassResources
claus
parents:
diff changeset
   713
    "     
claus
parents:
diff changeset
   714
!
claus
parents:
diff changeset
   715
claus
parents:
diff changeset
   716
flushClassResources
claus
parents:
diff changeset
   717
    "flush classes resource string translations.
claus
parents:
diff changeset
   718
     Needed whenever a resource file or language has changed"
claus
parents:
diff changeset
   719
claus
parents:
diff changeset
   720
    ClassResources := nil.
claus
parents:
diff changeset
   721
!
claus
parents:
diff changeset
   722
claus
parents:
diff changeset
   723
updateClassResources
claus
parents:
diff changeset
   724
    "flush classes resource string translations and reload them.
claus
parents:
diff changeset
   725
     Needed whenever a resource file or language has changed"
claus
parents:
diff changeset
   726
claus
parents:
diff changeset
   727
    ClassResources := nil.
claus
parents:
diff changeset
   728
    self classResources
claus
parents:
diff changeset
   729
! !
claus
parents:
diff changeset
   730
claus
parents:
diff changeset
   731
!SimpleView class methodsFor:'defaults'!
claus
parents:
diff changeset
   732
140
claus
parents: 138
diff changeset
   733
defaultExtent
claus
parents: 138
diff changeset
   734
    "define the default extent"
claus
parents: 138
diff changeset
   735
claus
parents: 138
diff changeset
   736
    CentPoint isNil ifTrue:[CentPoint := 100 @ 100].
claus
parents: 138
diff changeset
   737
    ^ CentPoint
claus
parents: 138
diff changeset
   738
!
claus
parents: 138
diff changeset
   739
135
claus
parents:
diff changeset
   740
viewSpacing
claus
parents:
diff changeset
   741
    "return a convenient number of pixels used to separate views (usually 1mm).
claus
parents:
diff changeset
   742
     Having this value here at a common place makes certain that all views
claus
parents:
diff changeset
   743
     get a common look"
claus
parents:
diff changeset
   744
claus
parents:
diff changeset
   745
    ^ ViewSpacing
claus
parents:
diff changeset
   746
!
claus
parents:
diff changeset
   747
claus
parents:
diff changeset
   748
defaultStyle:aStyle
claus
parents:
diff changeset
   749
    "set the view style for new views"
claus
parents:
diff changeset
   750
180
claus
parents: 176
diff changeset
   751
"/    aStyle ~~ DefaultStyle ifTrue:[
135
claus
parents:
diff changeset
   752
	DefaultStyle := aStyle.
claus
parents:
diff changeset
   753
	self updateAllStyleCaches.
180
claus
parents: 176
diff changeset
   754
"/    ]
135
claus
parents:
diff changeset
   755
claus
parents:
diff changeset
   756
    "
claus
parents:
diff changeset
   757
     View defaultStyle:#next. SystemBrowser start
claus
parents:
diff changeset
   758
     View defaultStyle:#motif. SystemBrowser start
claus
parents:
diff changeset
   759
     View defaultStyle:#iris. SystemBrowser start
claus
parents:
diff changeset
   760
     View defaultStyle:#st80. SystemBrowser start
claus
parents:
diff changeset
   761
     View defaultStyle:#normal. SystemBrowser start
claus
parents:
diff changeset
   762
    "
claus
parents:
diff changeset
   763
!
claus
parents:
diff changeset
   764
claus
parents:
diff changeset
   765
updateStyleCache
claus
parents:
diff changeset
   766
    "this method gets some heavily used style stuff and keeps
claus
parents:
diff changeset
   767
     it in class-variables for faster access.
claus
parents:
diff changeset
   768
     Subclasses should redefine this to load any cached style-values
claus
parents:
diff changeset
   769
     into faster class variables as well. These should NOT do a 
claus
parents:
diff changeset
   770
     super updateStyleCache, since this method is called for all view-classes
claus
parents:
diff changeset
   771
     anyway."
claus
parents:
diff changeset
   772
claus
parents:
diff changeset
   773
    |bgGrey|
claus
parents:
diff changeset
   774
claus
parents:
diff changeset
   775
    "
claus
parents:
diff changeset
   776
     when coming here the first time, we read the styleSheet
claus
parents:
diff changeset
   777
     and keep the values in fast class variables
claus
parents:
diff changeset
   778
    "
claus
parents:
diff changeset
   779
    StyleSheet isNil ifTrue:[
claus
parents:
diff changeset
   780
	DefaultStyle := #normal.
claus
parents:
diff changeset
   781
	StyleSheet := ViewStyle fromFile:'normal.style'.
claus
parents:
diff changeset
   782
    ].
claus
parents:
diff changeset
   783
claus
parents:
diff changeset
   784
    Grey := StyleSheet viewGrey.
claus
parents:
diff changeset
   785
    Grey isNil ifTrue:[
claus
parents:
diff changeset
   786
	Grey := Color grey
claus
parents:
diff changeset
   787
    ].
claus
parents:
diff changeset
   788
    Grey := Grey on:Display.
claus
parents:
diff changeset
   789
151
claus
parents: 145
diff changeset
   790
    StyleSheet fileReadFailed ifTrue:[
claus
parents: 145
diff changeset
   791
	bgGrey := White
135
claus
parents:
diff changeset
   792
    ] ifFalse:[
151
claus
parents: 145
diff changeset
   793
	Display hasGreyscales ifTrue:[
claus
parents: 145
diff changeset
   794
	    bgGrey := Grey
claus
parents: 145
diff changeset
   795
	] ifFalse:[
claus
parents: 145
diff changeset
   796
	    bgGrey := White 
claus
parents: 145
diff changeset
   797
	]
135
claus
parents:
diff changeset
   798
    ].
151
claus
parents: 145
diff changeset
   799
    bgGrey := bgGrey on:Display.
135
claus
parents:
diff changeset
   800
claus
parents:
diff changeset
   801
    ViewSpacing := StyleSheet at:'viewSpacing'.
claus
parents:
diff changeset
   802
    ViewSpacing isNil ifTrue:[
claus
parents:
diff changeset
   803
	ViewSpacing := Display verticalPixelPerMillimeter rounded.
claus
parents:
diff changeset
   804
    ].
claus
parents:
diff changeset
   805
claus
parents:
diff changeset
   806
    DefaultBorderColor := StyleSheet colorAt:'borderColor' default:Black.
151
claus
parents: 145
diff changeset
   807
claus
parents: 145
diff changeset
   808
    StyleSheet fileReadFailed ifTrue:[
claus
parents: 145
diff changeset
   809
	DefaultBorderWidth := 1.
claus
parents: 145
diff changeset
   810
	DefaultShadowColor := Black.
claus
parents: 145
diff changeset
   811
	DefaultLightColor :=  White.
claus
parents: 145
diff changeset
   812
	DefaultFocusColor := Black.
claus
parents: 145
diff changeset
   813
	DefaultFocusBorderWidth := 2.
claus
parents: 145
diff changeset
   814
	DefaultViewBackgroundColor := bgGrey.
claus
parents: 145
diff changeset
   815
    ] ifFalse:[
claus
parents: 145
diff changeset
   816
	DefaultBorderWidth := StyleSheet at:'borderWidth' default:0.
claus
parents: 145
diff changeset
   817
	DefaultViewBackgroundColor := StyleSheet colorAt:'viewBackground' default:bgGrey.
claus
parents: 145
diff changeset
   818
	DefaultShadowColor := StyleSheet colorAt:'shadowColor'.
claus
parents: 145
diff changeset
   819
	DefaultLightColor := StyleSheet colorAt:'lightColor'.
claus
parents: 145
diff changeset
   820
	DefaultFocusColor := StyleSheet colorAt:'focusColor' default:Color red.
claus
parents: 145
diff changeset
   821
	DefaultFocusBorderWidth := StyleSheet at:'focusBorderWidth' default:2.
claus
parents: 145
diff changeset
   822
    ].
135
claus
parents:
diff changeset
   823
claus
parents:
diff changeset
   824
    DefaultFont := StyleSheet at:'font'.
claus
parents:
diff changeset
   825
    DefaultFont isNil ifTrue:[
claus
parents:
diff changeset
   826
	DefaultFont := Font family:'courier' face:'medium' style:'roman' size:12.
claus
parents:
diff changeset
   827
    ].
claus
parents:
diff changeset
   828
claus
parents:
diff changeset
   829
    DefaultFont := DefaultFont on:Display.
claus
parents:
diff changeset
   830
claus
parents:
diff changeset
   831
    DefaultViewBackgroundColor isNil ifTrue:[
claus
parents:
diff changeset
   832
	'bad viewBackground in style - using white' errorPrintNL.
claus
parents:
diff changeset
   833
	DefaultViewBackgroundColor := White
claus
parents:
diff changeset
   834
    ].
claus
parents:
diff changeset
   835
!
claus
parents:
diff changeset
   836
140
claus
parents: 138
diff changeset
   837
defaultStyle
claus
parents: 138
diff changeset
   838
    "return the default view style"
claus
parents: 138
diff changeset
   839
claus
parents: 138
diff changeset
   840
    ^ DefaultStyle
claus
parents: 138
diff changeset
   841
claus
parents: 138
diff changeset
   842
    "
claus
parents: 138
diff changeset
   843
     View defaultStyle
claus
parents: 138
diff changeset
   844
    "
claus
parents: 138
diff changeset
   845
!
claus
parents: 138
diff changeset
   846
claus
parents: 138
diff changeset
   847
updateAllStyleCaches
claus
parents: 138
diff changeset
   848
    "reload all style caches in all view classes.
claus
parents: 138
diff changeset
   849
     Needed after a style change or when a style file has been changed"
claus
parents: 138
diff changeset
   850
claus
parents: 138
diff changeset
   851
    StyleSheet := ViewStyle fromFile:(DefaultStyle , '.style').
claus
parents: 138
diff changeset
   852
    StyleSheet fileReadFailed ifTrue:[
claus
parents: 138
diff changeset
   853
	('***** WARNING: no styleSheet for ' , DefaultStyle , '-style.') errorPrintNL.
151
claus
parents: 145
diff changeset
   854
	DefaultStyle ~~ #normal ifTrue:[
claus
parents: 145
diff changeset
   855
	    DefaultStyle := #normal.
claus
parents: 145
diff changeset
   856
	    StyleSheet := ViewStyle fromFile:(DefaultStyle , '.style').
claus
parents: 145
diff changeset
   857
        
claus
parents: 145
diff changeset
   858
	    StyleSheet fileReadFailed ifTrue:[
claus
parents: 145
diff changeset
   859
		'***** WARNING: not even a styleSheet for normal-style (using defaults).' errorPrintNL.
claus
parents: 145
diff changeset
   860
	    ]
140
claus
parents: 138
diff changeset
   861
	]
claus
parents: 138
diff changeset
   862
    ].
claus
parents: 138
diff changeset
   863
claus
parents: 138
diff changeset
   864
    "
claus
parents: 138
diff changeset
   865
     tell all view classes to flush any
claus
parents: 138
diff changeset
   866
     cached style-data
claus
parents: 138
diff changeset
   867
    "
claus
parents: 138
diff changeset
   868
    self changed:#style.
claus
parents: 138
diff changeset
   869
    SimpleView updateStyleCache.
claus
parents: 138
diff changeset
   870
    SimpleView allSubclassesDo:[:aClass |
claus
parents: 138
diff changeset
   871
	(aClass class implements:#updateStyleCache) ifTrue:[aClass updateStyleCache].
claus
parents: 138
diff changeset
   872
    ]
claus
parents: 138
diff changeset
   873
claus
parents: 138
diff changeset
   874
    "
claus
parents: 138
diff changeset
   875
     View updateAllStyleCaches
claus
parents: 138
diff changeset
   876
    "
claus
parents: 138
diff changeset
   877
!
claus
parents: 138
diff changeset
   878
claus
parents: 138
diff changeset
   879
defaultFont
claus
parents: 138
diff changeset
   880
    ^ DefaultFont notNil ifTrue:[DefaultFont] ifFalse:[super defaultFont]
claus
parents: 138
diff changeset
   881
!
claus
parents: 138
diff changeset
   882
135
claus
parents:
diff changeset
   883
styleSheet:aViewStyle
claus
parents:
diff changeset
   884
    "set the view style from a style-sheet"
claus
parents:
diff changeset
   885
claus
parents:
diff changeset
   886
    StyleSheet := aViewStyle.
claus
parents:
diff changeset
   887
    DefaultStyle := (StyleSheet at:'name' ifAbsent:'unknown') asSymbol.
claus
parents:
diff changeset
   888
    self updateAllStyleCaches.
claus
parents:
diff changeset
   889
! !
claus
parents:
diff changeset
   890
140
claus
parents: 138
diff changeset
   891
!SimpleView class methodsFor:'change & update'!
claus
parents: 138
diff changeset
   892
claus
parents: 138
diff changeset
   893
update:something
claus
parents: 138
diff changeset
   894
    something == #Language ifTrue:[
claus
parents: 138
diff changeset
   895
	"flush resources on language changes"
claus
parents: 138
diff changeset
   896
	self flushAllClassResources
135
claus
parents:
diff changeset
   897
    ]
claus
parents:
diff changeset
   898
! !
claus
parents:
diff changeset
   899
151
claus
parents: 145
diff changeset
   900
!SimpleView methodsFor:'copying'!
claus
parents: 145
diff changeset
   901
claus
parents: 145
diff changeset
   902
shallowCopyForFinalization
claus
parents: 145
diff changeset
   903
    "redefined for faster creation of finalization copies
claus
parents: 145
diff changeset
   904
     (only device, gcId and drawableId are needed)"
claus
parents: 145
diff changeset
   905
claus
parents: 145
diff changeset
   906
    |aCopy|
claus
parents: 145
diff changeset
   907
claus
parents: 145
diff changeset
   908
    aCopy := DeviceViewHandle basicNew.
claus
parents: 145
diff changeset
   909
    aCopy setDevice:device id:drawableId gcId:gcId.
claus
parents: 145
diff changeset
   910
    ^ aCopy
claus
parents: 145
diff changeset
   911
! !
claus
parents: 145
diff changeset
   912
135
claus
parents:
diff changeset
   913
!SimpleView methodsFor:'accessing-transformation'!
claus
parents:
diff changeset
   914
claus
parents:
diff changeset
   915
transformation 
claus
parents:
diff changeset
   916
    "return the transformation"
claus
parents:
diff changeset
   917
154
claus
parents: 153
diff changeset
   918
    |vP org|
135
claus
parents:
diff changeset
   919
claus
parents:
diff changeset
   920
    transformation isNil ifTrue:[
claus
parents:
diff changeset
   921
	"
claus
parents:
diff changeset
   922
	 fake a transformation, if I have a non-nil window
claus
parents:
diff changeset
   923
	"
claus
parents:
diff changeset
   924
	window notNil ifTrue:[
claus
parents:
diff changeset
   925
	    superView isNil ifTrue:[
154
claus
parents: 153
diff changeset
   926
		org := 0 @ 0
135
claus
parents:
diff changeset
   927
	    ] ifFalse:[
154
claus
parents: 153
diff changeset
   928
		org := self origin
135
claus
parents:
diff changeset
   929
	    ].
154
claus
parents: 153
diff changeset
   930
	    vP := org extent:(self extent).
claus
parents: 153
diff changeset
   931
	    ^ WindowingTransformation window:window viewport:vP
135
claus
parents:
diff changeset
   932
	]
claus
parents:
diff changeset
   933
    ].
claus
parents:
diff changeset
   934
    ^ transformation
claus
parents:
diff changeset
   935
!
claus
parents:
diff changeset
   936
claus
parents:
diff changeset
   937
viewRectangle
claus
parents:
diff changeset
   938
    "return the inside area"
claus
parents:
diff changeset
   939
claus
parents:
diff changeset
   940
    |m2|
claus
parents:
diff changeset
   941
140
claus
parents: 138
diff changeset
   942
"/    innerClipRect notNil ifTrue:[
claus
parents: 138
diff changeset
   943
"/        ^ innerClipRect
claus
parents: 138
diff changeset
   944
"/    ].
135
claus
parents:
diff changeset
   945
    m2 := margin + margin.
claus
parents:
diff changeset
   946
claus
parents:
diff changeset
   947
    ^ (margin @ margin) extent:((width - m2) @ (height - m2))
claus
parents:
diff changeset
   948
!
claus
parents:
diff changeset
   949
claus
parents:
diff changeset
   950
window
claus
parents:
diff changeset
   951
    "return my window (i.e. logical coordinate space).
claus
parents:
diff changeset
   952
     If there is no window, return the extent."
claus
parents:
diff changeset
   953
claus
parents:
diff changeset
   954
    window isNil ifTrue:[^ width @ height].
claus
parents:
diff changeset
   955
    ^ window
claus
parents:
diff changeset
   956
!
claus
parents:
diff changeset
   957
claus
parents:
diff changeset
   958
window:aRectangle
claus
parents:
diff changeset
   959
    "define my window (i.e. logical coordinate space)"
claus
parents:
diff changeset
   960
claus
parents:
diff changeset
   961
    window := aRectangle.
claus
parents:
diff changeset
   962
    subViews notNil ifTrue:[
claus
parents:
diff changeset
   963
	subViews do:[:s |
claus
parents:
diff changeset
   964
	    s superViewChangedSize
claus
parents:
diff changeset
   965
	]
claus
parents:
diff changeset
   966
    ]
claus
parents:
diff changeset
   967
claus
parents:
diff changeset
   968
"
claus
parents:
diff changeset
   969
    viewport isNil ifTrue:[
claus
parents:
diff changeset
   970
	viewport := aRectangle.
claus
parents:
diff changeset
   971
    ].
claus
parents:
diff changeset
   972
"
claus
parents:
diff changeset
   973
"
claus
parents:
diff changeset
   974
    superView notNil ifTrue:[
claus
parents:
diff changeset
   975
	self superViewChangedSize
claus
parents:
diff changeset
   976
    ] ifFalse:[
claus
parents:
diff changeset
   977
	originChanged := true.
claus
parents:
diff changeset
   978
	extentChanged := true
claus
parents:
diff changeset
   979
    ]
claus
parents:
diff changeset
   980
"
claus
parents:
diff changeset
   981
!
claus
parents:
diff changeset
   982
claus
parents:
diff changeset
   983
viewOrigin
claus
parents:
diff changeset
   984
    "return the viewOrigin; thats the coordinate of the contents 
claus
parents:
diff changeset
   985
     which is shown topLeft in the view 
claus
parents:
diff changeset
   986
     (i.e. the origin of the visible part of the contents)."
claus
parents:
diff changeset
   987
claus
parents:
diff changeset
   988
    transformation isNil ifTrue:[
claus
parents:
diff changeset
   989
	^ 0@0
claus
parents:
diff changeset
   990
    ].
claus
parents:
diff changeset
   991
    ^ transformation translation negated
claus
parents:
diff changeset
   992
!
claus
parents:
diff changeset
   993
claus
parents:
diff changeset
   994
setViewOrigin:aPoint
claus
parents:
diff changeset
   995
    "set the viewOrigin - i.e. virtually scroll without redrawing"
claus
parents:
diff changeset
   996
claus
parents:
diff changeset
   997
    |p|
claus
parents:
diff changeset
   998
claus
parents:
diff changeset
   999
    p := aPoint negated.
claus
parents:
diff changeset
  1000
    transformation isNil ifTrue:[
claus
parents:
diff changeset
  1001
	transformation := WindowingTransformation scale:1 translation:p 
claus
parents:
diff changeset
  1002
    ] ifFalse:[
claus
parents:
diff changeset
  1003
	transformation translation:p 
claus
parents:
diff changeset
  1004
    ].
claus
parents:
diff changeset
  1005
    clipRect notNil ifTrue:[
claus
parents:
diff changeset
  1006
	self setInnerClip.
claus
parents:
diff changeset
  1007
    ].
claus
parents:
diff changeset
  1008
!
claus
parents:
diff changeset
  1009
claus
parents:
diff changeset
  1010
viewport:aRectangle
claus
parents:
diff changeset
  1011
    "define my extend in my superviews coordinate-system."
claus
parents:
diff changeset
  1012
claus
parents:
diff changeset
  1013
"/    |relW relH relX relY winW winH|
claus
parents:
diff changeset
  1014
claus
parents:
diff changeset
  1015
    viewport := aRectangle.
claus
parents:
diff changeset
  1016
    self dimensionFromViewport
claus
parents:
diff changeset
  1017
"/
claus
parents:
diff changeset
  1018
"/    superView notNil ifTrue:[
claus
parents:
diff changeset
  1019
"/        superView window isNil ifTrue:[
claus
parents:
diff changeset
  1020
"/            winW := 1.
claus
parents:
diff changeset
  1021
"/            winH := 1
claus
parents:
diff changeset
  1022
"/        ] ifFalse:[
claus
parents:
diff changeset
  1023
"/            winW := superView window width.
claus
parents:
diff changeset
  1024
"/            winH := superView window height
claus
parents:
diff changeset
  1025
"/        ].
claus
parents:
diff changeset
  1026
"/        relW := (aRectangle width / winW) asFloat.
claus
parents:
diff changeset
  1027
"/        relH := (aRectangle height / winH) asFloat.
claus
parents:
diff changeset
  1028
"/        relX := (aRectangle left / winW) asFloat.
claus
parents:
diff changeset
  1029
"/        relY := (aRectangle top / winH) asFloat.
claus
parents:
diff changeset
  1030
"/        self origin:(relX @ relY) extent:(relW @ relH)
claus
parents:
diff changeset
  1031
"/    ]
claus
parents:
diff changeset
  1032
"/
claus
parents:
diff changeset
  1033
!
claus
parents:
diff changeset
  1034
claus
parents:
diff changeset
  1035
window:aRectangle viewport:vRect
claus
parents:
diff changeset
  1036
    window := aRectangle.
claus
parents:
diff changeset
  1037
    self viewport:vRect.
claus
parents:
diff changeset
  1038
    subViews notNil ifTrue:[
claus
parents:
diff changeset
  1039
	subViews do:[:s |
claus
parents:
diff changeset
  1040
	    s superViewChangedSize
claus
parents:
diff changeset
  1041
	]
claus
parents:
diff changeset
  1042
    ]
claus
parents:
diff changeset
  1043
!
claus
parents:
diff changeset
  1044
claus
parents:
diff changeset
  1045
scale
claus
parents:
diff changeset
  1046
    "return the scale factor (as point) of the transformation"
claus
parents:
diff changeset
  1047
claus
parents:
diff changeset
  1048
    transformation isNil ifTrue:[^ 1].
claus
parents:
diff changeset
  1049
    ^ transformation scale
claus
parents:
diff changeset
  1050
!
claus
parents:
diff changeset
  1051
claus
parents:
diff changeset
  1052
scale:aPoint
claus
parents:
diff changeset
  1053
    "set the scale factor of the transformation"
claus
parents:
diff changeset
  1054
claus
parents:
diff changeset
  1055
    transformation isNil ifTrue:[
claus
parents:
diff changeset
  1056
	aPoint = 1 ifTrue:[^ self].
claus
parents:
diff changeset
  1057
	transformation := WindowingTransformation scale:aPoint translation:0
claus
parents:
diff changeset
  1058
    ].
claus
parents:
diff changeset
  1059
claus
parents:
diff changeset
  1060
    transformation scale:aPoint.
claus
parents:
diff changeset
  1061
    self computeInnerClip
claus
parents:
diff changeset
  1062
!
claus
parents:
diff changeset
  1063
claus
parents:
diff changeset
  1064
xOriginOfContents
claus
parents:
diff changeset
  1065
    "return the x coordinate of the viewOrigin in pixels; 
claus
parents:
diff changeset
  1066
     used by scrollBars to compute thumb position within the document."
claus
parents:
diff changeset
  1067
claus
parents:
diff changeset
  1068
    ^ self viewOrigin x
claus
parents:
diff changeset
  1069
!
claus
parents:
diff changeset
  1070
claus
parents:
diff changeset
  1071
yOriginOfContents
claus
parents:
diff changeset
  1072
    "return the y coordinate of the viewOrigin in pixels; 
claus
parents:
diff changeset
  1073
     used by scrollBars to compute thumb position within the document."
claus
parents:
diff changeset
  1074
claus
parents:
diff changeset
  1075
    ^ self viewOrigin y
claus
parents:
diff changeset
  1076
!
claus
parents:
diff changeset
  1077
claus
parents:
diff changeset
  1078
heightOfContents
claus
parents:
diff changeset
  1079
    "return the height of the contents in logical units 
claus
parents:
diff changeset
  1080
     - defaults to views visible area here.
claus
parents:
diff changeset
  1081
    This method MUST be redefined in all view classess which are
claus
parents:
diff changeset
  1082
    going to be scrolled AND show data which has different size than
claus
parents:
diff changeset
  1083
    the view. For example, a view showing A4-size documents should return
claus
parents:
diff changeset
  1084
    the number of vertical pixels such a document has on this device.
claus
parents:
diff changeset
  1085
    A view showing a bitmap of height 1000 should return 1000.
claus
parents:
diff changeset
  1086
    If not redefined, scrollbars have no way of knowing the actual size
claus
parents:
diff changeset
  1087
    of the contents being shown. This is called by scrollBars to compute
claus
parents:
diff changeset
  1088
    the relative height of the document vs. the views actual size.
claus
parents:
diff changeset
  1089
    The value returned here must be based on a scale of 1, since users
claus
parents:
diff changeset
  1090
    of this will scale as appropriate."
claus
parents:
diff changeset
  1091
claus
parents:
diff changeset
  1092
    ^ self innerHeight max:(self maxSubViewBottom)
claus
parents:
diff changeset
  1093
!
claus
parents:
diff changeset
  1094
claus
parents:
diff changeset
  1095
widthOfContents
claus
parents:
diff changeset
  1096
claus
parents:
diff changeset
  1097
    ^ self innerWidth max:(self maxSubViewRight)
claus
parents:
diff changeset
  1098
claus
parents:
diff changeset
  1099
!
claus
parents:
diff changeset
  1100
claus
parents:
diff changeset
  1101
maxSubViewBottom 
claus
parents:
diff changeset
  1102
"/    subViews isNil ifTrue:[^ 0].
claus
parents:
diff changeset
  1103
"/    ^ subViews inject:0 into:[:maxSoFar :sub | (sub top + sub height) max:maxSoFar].
claus
parents:
diff changeset
  1104
      ^ 0
claus
parents:
diff changeset
  1105
!
claus
parents:
diff changeset
  1106
claus
parents:
diff changeset
  1107
maxSubViewRight 
claus
parents:
diff changeset
  1108
"/    subViews isNil ifTrue:[^ 0].
claus
parents:
diff changeset
  1109
"/    ^ subViews inject:0 into:[:maxSoFar :sub | (sub left + sub width) max:maxSoFar].
claus
parents:
diff changeset
  1110
    ^ 0
claus
parents:
diff changeset
  1111
! !
claus
parents:
diff changeset
  1112
claus
parents:
diff changeset
  1113
!SimpleView methodsFor:'accessing-misc'!
claus
parents:
diff changeset
  1114
claus
parents:
diff changeset
  1115
shown
151
claus
parents: 145
diff changeset
  1116
    "return true if the view is shown; false if not.
claus
parents: 145
diff changeset
  1117
     Shown means: the view is mapped and is not completely covered."
135
claus
parents:
diff changeset
  1118
claus
parents:
diff changeset
  1119
    ^ shown
claus
parents:
diff changeset
  1120
!
claus
parents:
diff changeset
  1121
claus
parents:
diff changeset
  1122
inputOnly
claus
parents:
diff changeset
  1123
    "return true, if this view is an input-only view;
claus
parents:
diff changeset
  1124
     input only views are transparent and can be layed on top of a view to
claus
parents:
diff changeset
  1125
     catch its input"
claus
parents:
diff changeset
  1126
claus
parents:
diff changeset
  1127
    ^ false
claus
parents:
diff changeset
  1128
!
claus
parents:
diff changeset
  1129
157
claus
parents: 154
diff changeset
  1130
isPopUpView
135
claus
parents:
diff changeset
  1131
    "return true, if this view should be put on top (raised) automatically.
claus
parents:
diff changeset
  1132
     usually this is true for alertBoxes etc."
claus
parents:
diff changeset
  1133
claus
parents:
diff changeset
  1134
    ^ false
claus
parents:
diff changeset
  1135
!
claus
parents:
diff changeset
  1136
claus
parents:
diff changeset
  1137
is3D
151
claus
parents: 145
diff changeset
  1138
    "return true, if my style is some kind of 3D style
claus
parents: 145
diff changeset
  1139
     This is OBSOLETE and will be removed."
claus
parents: 145
diff changeset
  1140
claus
parents: 145
diff changeset
  1141
    ^ styleSheet is3D
135
claus
parents:
diff changeset
  1142
!
claus
parents:
diff changeset
  1143
182
claus
parents: 180
diff changeset
  1144
styleSheet 
claus
parents: 180
diff changeset
  1145
    "return the styleSheet. This is set at early view-creation time,
claus
parents: 180
diff changeset
  1146
     from the defaultStyleSheet which is valid at that time.
claus
parents: 180
diff changeset
  1147
     It is not affected by later defaultStyle changes"
claus
parents: 180
diff changeset
  1148
claus
parents: 180
diff changeset
  1149
    ^ styleSheet
claus
parents: 180
diff changeset
  1150
claus
parents: 180
diff changeset
  1151
    "Created: 10.9.1995 / 11:02:20 / claus"
claus
parents: 180
diff changeset
  1152
!
claus
parents: 180
diff changeset
  1153
135
claus
parents:
diff changeset
  1154
viewGravity:gravity
claus
parents:
diff changeset
  1155
    "set the viewGravity - thats the direction where the view will move
claus
parents:
diff changeset
  1156
     when the superView is resized."
claus
parents:
diff changeset
  1157
claus
parents:
diff changeset
  1158
    viewGravity ~~ gravity ifTrue:[
claus
parents:
diff changeset
  1159
	viewGravity := gravity.
claus
parents:
diff changeset
  1160
	drawableId notNil ifTrue:[
claus
parents:
diff changeset
  1161
	    device setWindowGravity:gravity in:drawableId
claus
parents:
diff changeset
  1162
	]
claus
parents:
diff changeset
  1163
    ]
claus
parents:
diff changeset
  1164
!
claus
parents:
diff changeset
  1165
193
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1166
beInvisible
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1167
    self hidden:true.
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1168
    realized ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1169
	self unrealize
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1170
    ]
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1171
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1172
    "Created: 22.9.1995 / 15:29:01 / claus"
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1173
!
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1174
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1175
beVisible
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1176
    self hidden:false.
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1177
    realized ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1178
	self realize
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1179
    ]
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1180
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1181
    "
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1182
     |top topFrame check list|
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1183
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1184
     top := StandardSystemView new.
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1185
     top extent:150@400.
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1186
     topFrame := VerticalPanelView origin:0.0@0.0 corner:1.0@0.4 in:top.
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1187
     topFrame horizontalLayout:#leftSpace.
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1188
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1189
     topFrame add:(check := CheckBox label:'hidden').
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1190
     check pressAction:[list beInvisible].
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1191
     check releaseAction:[list beVisible].
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1192
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1193
     list := ScrollableView for:SelectionInListView.
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1194
     list origin:0.0@0.4 corner:1.0@1.0.
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1195
     list list:#('foo' 'bar' 'baz').
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1196
     top add:list.
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1197
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1198
     check turnOn.
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1199
     list beInvisible.
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1200
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1201
     top open
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1202
    "
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1203
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1204
    "Created: 22.9.1995 / 15:50:33 / claus"
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1205
!
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1206
140
claus
parents: 138
diff changeset
  1207
hidden:aBoolean
claus
parents: 138
diff changeset
  1208
    "if the argument is true, the receiver view will not
claus
parents: 138
diff changeset
  1209
     be realized automatically when superview is realized"
claus
parents: 138
diff changeset
  1210
151
claus
parents: 145
diff changeset
  1211
    self obsoleteMethodWarning:'use #hiddenOnRealize:'.
claus
parents: 145
diff changeset
  1212
    hiddenOnRealize := aBoolean
claus
parents: 145
diff changeset
  1213
!
claus
parents: 145
diff changeset
  1214
claus
parents: 145
diff changeset
  1215
isHiddenOnRealize:aBoolean
claus
parents: 145
diff changeset
  1216
    "return true, if the receiver will NOT be mapped when
claus
parents: 145
diff changeset
  1217
     realized. False otherwise.
claus
parents: 145
diff changeset
  1218
     The hiddenOnRealize flag is useful to create views which are
claus
parents: 145
diff changeset
  1219
     to be made visible conditionally or later."
claus
parents: 145
diff changeset
  1220
claus
parents: 145
diff changeset
  1221
    ^ hiddenOnRealize
claus
parents: 145
diff changeset
  1222
!
claus
parents: 145
diff changeset
  1223
claus
parents: 145
diff changeset
  1224
hiddenOnRealize:aBoolean
claus
parents: 145
diff changeset
  1225
    "if the argument is true, the receiver view will not
claus
parents: 145
diff changeset
  1226
     be mapped automatically when the superview is realized.
claus
parents: 145
diff changeset
  1227
     The hiddenOnRealize flag is useful to create views which are
claus
parents: 145
diff changeset
  1228
     to be made visible conditionally or later."
claus
parents: 145
diff changeset
  1229
claus
parents: 145
diff changeset
  1230
    hiddenOnRealize := aBoolean
140
claus
parents: 138
diff changeset
  1231
!
claus
parents: 138
diff changeset
  1232
135
claus
parents:
diff changeset
  1233
viewGravity
claus
parents:
diff changeset
  1234
    "return the viewGravity - thats the direction where the view will move
claus
parents:
diff changeset
  1235
     when the superView is resized."
claus
parents:
diff changeset
  1236
claus
parents:
diff changeset
  1237
    ^ viewGravity
claus
parents:
diff changeset
  1238
!
claus
parents:
diff changeset
  1239
claus
parents:
diff changeset
  1240
bitGravity
claus
parents:
diff changeset
  1241
    "return the bitGravity - thats the direction where the contents will move
claus
parents:
diff changeset
  1242
     when the the view is resized."
claus
parents:
diff changeset
  1243
claus
parents:
diff changeset
  1244
    ^ bitGravity
claus
parents:
diff changeset
  1245
!
claus
parents:
diff changeset
  1246
claus
parents:
diff changeset
  1247
bitGravity:gravity
claus
parents:
diff changeset
  1248
    "set the bitGravity - thats the direction where the contents will move
claus
parents:
diff changeset
  1249
     when the view is resized."
claus
parents:
diff changeset
  1250
claus
parents:
diff changeset
  1251
    bitGravity ~~ gravity ifTrue:[
claus
parents:
diff changeset
  1252
	bitGravity := gravity.
claus
parents:
diff changeset
  1253
	drawableId notNil ifTrue:[
claus
parents:
diff changeset
  1254
	    device setBitGravity:gravity in:drawableId
claus
parents:
diff changeset
  1255
	]
claus
parents:
diff changeset
  1256
    ]
claus
parents:
diff changeset
  1257
!
claus
parents:
diff changeset
  1258
claus
parents:
diff changeset
  1259
canDrop:anObjectOrCollection
claus
parents:
diff changeset
  1260
    "return true, if anObjectOrCollection can be
claus
parents:
diff changeset
  1261
     dropped in the receiver. This method should be
claus
parents:
diff changeset
  1262
     redefined in views which can take objects"
claus
parents:
diff changeset
  1263
claus
parents:
diff changeset
  1264
    ^ false
claus
parents:
diff changeset
  1265
!
claus
parents:
diff changeset
  1266
claus
parents:
diff changeset
  1267
hidden
claus
parents:
diff changeset
  1268
    "return true, if the view does not want to be realized
claus
parents:
diff changeset
  1269
     automatically when superview is realized"
claus
parents:
diff changeset
  1270
151
claus
parents: 145
diff changeset
  1271
    self obsoleteMethodWarning:'use #hiddenOnRealize'.
claus
parents: 145
diff changeset
  1272
    ^ hiddenOnRealize
153
claus
parents: 151
diff changeset
  1273
!
claus
parents: 151
diff changeset
  1274
claus
parents: 151
diff changeset
  1275
clipRect:aRectangle
claus
parents: 151
diff changeset
  1276
    "set the clipping rectangle for drawing (in logical coordinates);
claus
parents: 151
diff changeset
  1277
     a nil argument turn off clipping (i.e. whole view is drawable).
claus
parents: 151
diff changeset
  1278
     Redefined to care for any margin."
claus
parents: 151
diff changeset
  1279
claus
parents: 151
diff changeset
  1280
    |x y w h|
claus
parents: 151
diff changeset
  1281
claus
parents: 151
diff changeset
  1282
    aRectangle isNil ifTrue:[
claus
parents: 151
diff changeset
  1283
	clipRect isNil ifTrue:[^ self].
claus
parents: 151
diff changeset
  1284
	gcId notNil ifTrue:[
claus
parents: 151
diff changeset
  1285
	    device noClipIn:gcId
claus
parents: 151
diff changeset
  1286
	]
claus
parents: 151
diff changeset
  1287
    ] ifFalse:[
claus
parents: 151
diff changeset
  1288
	clipRect notNil ifTrue:[
claus
parents: 151
diff changeset
  1289
	    (clipRect = aRectangle) ifTrue:[^ self]
claus
parents: 151
diff changeset
  1290
	].
claus
parents: 151
diff changeset
  1291
	gcId notNil ifTrue:[
claus
parents: 151
diff changeset
  1292
	    x := aRectangle left.
claus
parents: 151
diff changeset
  1293
	    y := aRectangle top.
claus
parents: 151
diff changeset
  1294
	    w := aRectangle width.
claus
parents: 151
diff changeset
  1295
	    h := aRectangle height.
claus
parents: 151
diff changeset
  1296
	    transformation notNil ifTrue:[
claus
parents: 151
diff changeset
  1297
		x := transformation applyToX:x.
claus
parents: 151
diff changeset
  1298
		y := transformation applyToY:y.
claus
parents: 151
diff changeset
  1299
		w := transformation applyScaleX:w.
claus
parents: 151
diff changeset
  1300
		h := transformation applyScaleY:h.
claus
parents: 151
diff changeset
  1301
	    ].
claus
parents: 151
diff changeset
  1302
	    (x isMemberOf:SmallInteger) ifFalse:[
claus
parents: 151
diff changeset
  1303
		w := w + (x - x truncated).
claus
parents: 151
diff changeset
  1304
		x := x truncated
claus
parents: 151
diff changeset
  1305
	    ].
claus
parents: 151
diff changeset
  1306
	    (y isMemberOf:SmallInteger) ifFalse:[
claus
parents: 151
diff changeset
  1307
		h := h + (y - y truncated).
claus
parents: 151
diff changeset
  1308
		y := y truncated
claus
parents: 151
diff changeset
  1309
	    ].
claus
parents: 151
diff changeset
  1310
	    (w isMemberOf:SmallInteger) ifFalse:[
claus
parents: 151
diff changeset
  1311
		w := w truncated + 1
claus
parents: 151
diff changeset
  1312
	    ].
claus
parents: 151
diff changeset
  1313
	    (h isMemberOf:SmallInteger) ifFalse:[
claus
parents: 151
diff changeset
  1314
		h := h truncated + 1
claus
parents: 151
diff changeset
  1315
	    ].
claus
parents: 151
diff changeset
  1316
	    x < margin ifTrue:[
claus
parents: 151
diff changeset
  1317
		x := margin.
claus
parents: 151
diff changeset
  1318
	    ].
claus
parents: 151
diff changeset
  1319
	    y < margin ifTrue:[
claus
parents: 151
diff changeset
  1320
		y := margin.
claus
parents: 151
diff changeset
  1321
	    ].
claus
parents: 151
diff changeset
  1322
	    x + w - 1 >= (width-margin) ifTrue:[
claus
parents: 151
diff changeset
  1323
		w := width - margin - x
claus
parents: 151
diff changeset
  1324
	    ].
claus
parents: 151
diff changeset
  1325
	    y + h - 1 >= (height-margin) ifTrue:[
claus
parents: 151
diff changeset
  1326
		h := height - margin - y
claus
parents: 151
diff changeset
  1327
	    ].
claus
parents: 151
diff changeset
  1328
	    device setClipX:x y:y width:w height:h in:gcId
claus
parents: 151
diff changeset
  1329
	]
claus
parents: 151
diff changeset
  1330
    ].
claus
parents: 151
diff changeset
  1331
    clipRect := aRectangle
claus
parents: 151
diff changeset
  1332
!
claus
parents: 151
diff changeset
  1333
claus
parents: 151
diff changeset
  1334
name:aString
claus
parents: 151
diff changeset
  1335
    "set my name component to be used for resource-access"
claus
parents: 151
diff changeset
  1336
claus
parents: 151
diff changeset
  1337
    name := aString
claus
parents: 151
diff changeset
  1338
!
claus
parents: 151
diff changeset
  1339
claus
parents: 151
diff changeset
  1340
name
claus
parents: 151
diff changeset
  1341
    "return my name component to be used for resource-access"
claus
parents: 151
diff changeset
  1342
claus
parents: 151
diff changeset
  1343
    ^ name
claus
parents: 151
diff changeset
  1344
!
claus
parents: 151
diff changeset
  1345
claus
parents: 151
diff changeset
  1346
fullName
claus
parents: 151
diff changeset
  1347
    "return my full name to be used for resource-access"
claus
parents: 151
diff changeset
  1348
claus
parents: 151
diff changeset
  1349
    superView notNil ifTrue:[
claus
parents: 151
diff changeset
  1350
	^ superView fullName , '.' , name
claus
parents: 151
diff changeset
  1351
    ].
claus
parents: 151
diff changeset
  1352
    ^ name
claus
parents: 151
diff changeset
  1353
!
claus
parents: 151
diff changeset
  1354
claus
parents: 151
diff changeset
  1355
processName
claus
parents: 151
diff changeset
  1356
    "return a string to be shown in the process monitor"
claus
parents: 151
diff changeset
  1357
claus
parents: 151
diff changeset
  1358
    ^ self name
135
claus
parents:
diff changeset
  1359
! !
claus
parents:
diff changeset
  1360
140
claus
parents: 138
diff changeset
  1361
!SimpleView methodsFor:'ST-80 compatibility'!
claus
parents: 138
diff changeset
  1362
claus
parents: 138
diff changeset
  1363
sensor
claus
parents: 138
diff changeset
  1364
    "return the views sensor"
claus
parents: 138
diff changeset
  1365
claus
parents: 138
diff changeset
  1366
    windowGroup notNil ifTrue:[
claus
parents: 138
diff changeset
  1367
	^ windowGroup sensor.
135
claus
parents:
diff changeset
  1368
    ].
140
claus
parents: 138
diff changeset
  1369
    ^ nil
claus
parents: 138
diff changeset
  1370
!
claus
parents: 138
diff changeset
  1371
claus
parents: 138
diff changeset
  1372
checkForEvents
claus
parents: 138
diff changeset
  1373
    (shown and:[windowGroup notNil]) ifTrue:[windowGroup processEvents].
claus
parents: 138
diff changeset
  1374
! !
claus
parents: 138
diff changeset
  1375
claus
parents: 138
diff changeset
  1376
!SimpleView methodsFor:'accessing-mvc'!
claus
parents: 138
diff changeset
  1377
claus
parents: 138
diff changeset
  1378
controller
claus
parents: 138
diff changeset
  1379
    "return the controller. For non MVC views, return nil"
claus
parents: 138
diff changeset
  1380
claus
parents: 138
diff changeset
  1381
    ^ controller
claus
parents: 138
diff changeset
  1382
!
claus
parents: 138
diff changeset
  1383
claus
parents: 138
diff changeset
  1384
windowGroup
claus
parents: 138
diff changeset
  1385
    "return the window group. For old style views, return nil"
claus
parents: 138
diff changeset
  1386
claus
parents: 138
diff changeset
  1387
    ^ windowGroup
claus
parents: 138
diff changeset
  1388
!
claus
parents: 138
diff changeset
  1389
claus
parents: 138
diff changeset
  1390
controller:aController
claus
parents: 138
diff changeset
  1391
    "set the controller"
claus
parents: 138
diff changeset
  1392
claus
parents: 138
diff changeset
  1393
    controller := aController.
claus
parents: 138
diff changeset
  1394
    controller notNil ifTrue:[
claus
parents: 138
diff changeset
  1395
	controller view:self.
135
claus
parents:
diff changeset
  1396
    ]
claus
parents:
diff changeset
  1397
!
claus
parents:
diff changeset
  1398
140
claus
parents: 138
diff changeset
  1399
model
135
claus
parents:
diff changeset
  1400
    ^ nil
claus
parents:
diff changeset
  1401
!
claus
parents:
diff changeset
  1402
140
claus
parents: 138
diff changeset
  1403
windowGroup:aGroup
claus
parents: 138
diff changeset
  1404
    "set the window group."
claus
parents: 138
diff changeset
  1405
claus
parents: 138
diff changeset
  1406
    windowGroup := aGroup
193
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1407
!
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1408
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1409
aspect:aspectSymbol
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1410
    "ST-80 style updating: If a views aspectSymbol is nonNil, 
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1411
     it will respond to changes of this aspect from the model.
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1412
     Alias for aspectMessage: for ST-80 compatibility."
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1413
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1414
    self aspectMessage:aspectSymbol
135
claus
parents:
diff changeset
  1415
! !
claus
parents:
diff changeset
  1416
claus
parents:
diff changeset
  1417
!SimpleView methodsFor:'event handling'!
claus
parents:
diff changeset
  1418
140
claus
parents: 138
diff changeset
  1419
mapped
claus
parents: 138
diff changeset
  1420
    "the view has been mapped (by some outside
claus
parents: 138
diff changeset
  1421
     action - i.e. window manager de-iconified me)"
claus
parents: 138
diff changeset
  1422
claus
parents: 138
diff changeset
  1423
    "
claus
parents: 138
diff changeset
  1424
     the old code was:
claus
parents: 138
diff changeset
  1425
claus
parents: 138
diff changeset
  1426
	realized := true.
claus
parents: 138
diff changeset
  1427
	shown := true.
claus
parents: 138
diff changeset
  1428
	...
claus
parents: 138
diff changeset
  1429
claus
parents: 138
diff changeset
  1430
     this created a race condition, if the view was
claus
parents: 138
diff changeset
  1431
     realized and shortly after unrealized - before the mapped event
claus
parents: 138
diff changeset
  1432
     arrived. This lead to shown being set to true even thought the
claus
parents: 138
diff changeset
  1433
     view was not. Boy - that was a bad one (hard to reproduce and hard to find).
claus
parents: 138
diff changeset
  1434
    "
claus
parents: 138
diff changeset
  1435
claus
parents: 138
diff changeset
  1436
    realized ifTrue:[
claus
parents: 138
diff changeset
  1437
	shown := true.
claus
parents: 138
diff changeset
  1438
	"
claus
parents: 138
diff changeset
  1439
	 backed views will not get expose events - have
claus
parents: 138
diff changeset
  1440
	 to force a redraw here to get things drawn into
claus
parents: 138
diff changeset
  1441
	 backing store.
claus
parents: 138
diff changeset
  1442
	"
claus
parents: 138
diff changeset
  1443
	backed ifTrue:[
claus
parents: 138
diff changeset
  1444
	    self redraw
claus
parents: 138
diff changeset
  1445
	].
claus
parents: 138
diff changeset
  1446
	subViews notNil ifTrue:[
claus
parents: 138
diff changeset
  1447
	    subViews do:[:v |
claus
parents: 138
diff changeset
  1448
		v superViewMapped
claus
parents: 138
diff changeset
  1449
	    ]
claus
parents: 138
diff changeset
  1450
	]
claus
parents: 138
diff changeset
  1451
    ]
claus
parents: 138
diff changeset
  1452
!
claus
parents: 138
diff changeset
  1453
claus
parents: 138
diff changeset
  1454
superViewChangedSize
claus
parents: 138
diff changeset
  1455
    "my superView has changed size; if I have relative
claus
parents: 138
diff changeset
  1456
     origin/extent or blocks to evaluate, do it now .."
claus
parents: 138
diff changeset
  1457
claus
parents: 138
diff changeset
  1458
    |oldWidth oldHeight oldTop oldLeft newExt newOrg
claus
parents: 138
diff changeset
  1459
     winSuper newWidth newHeight newLeft newTop
151
claus
parents: 145
diff changeset
  1460
     superWidth superHeight superWinWidth superWinHeight
claus
parents: 145
diff changeset
  1461
     r|
140
claus
parents: 138
diff changeset
  1462
claus
parents: 138
diff changeset
  1463
    oldWidth := width.
claus
parents: 138
diff changeset
  1464
    oldHeight := height.
claus
parents: 138
diff changeset
  1465
    oldTop := top.
claus
parents: 138
diff changeset
  1466
    oldLeft := left.
claus
parents: 138
diff changeset
  1467
151
claus
parents: 145
diff changeset
  1468
    "
claus
parents: 145
diff changeset
  1469
     if this view has a viewPort, resize a la ST-80 V2.x
claus
parents: 145
diff changeset
  1470
     this will vanish - dont use it.
claus
parents: 145
diff changeset
  1471
    "
140
claus
parents: 138
diff changeset
  1472
    viewport notNil ifTrue:[
claus
parents: 138
diff changeset
  1473
	superView isNil ifTrue:[^ self].
claus
parents: 138
diff changeset
  1474
	winSuper := superView window.
claus
parents: 138
diff changeset
  1475
	winSuper isNil ifTrue:[
claus
parents: 138
diff changeset
  1476
	    "take pixel size as window"
claus
parents: 138
diff changeset
  1477
	    winSuper := 0@0 extent:(superView width@superView height)
claus
parents: 138
diff changeset
  1478
	].
claus
parents: 138
diff changeset
  1479
claus
parents: 138
diff changeset
  1480
	superWidth := superView width.
claus
parents: 138
diff changeset
  1481
	superHeight := superView height.
claus
parents: 138
diff changeset
  1482
	superWinWidth := winSuper width.
claus
parents: 138
diff changeset
  1483
	superWinHeight := winSuper height.
claus
parents: 138
diff changeset
  1484
	newLeft := (viewport left - winSuper left) * superWidth // superWinWidth.
claus
parents: 138
diff changeset
  1485
	newTop := (viewport top - winSuper top) * superHeight // superWinHeight.
claus
parents: 138
diff changeset
  1486
	newWidth := superWidth * viewport width // superWinWidth.
claus
parents: 138
diff changeset
  1487
	newHeight := superHeight * viewport height // superWinHeight.
claus
parents: 138
diff changeset
  1488
	self pixelOrigin:(newLeft @ newTop).
claus
parents: 138
diff changeset
  1489
	self pixelExtent:(newWidth @ newHeight).
claus
parents: 138
diff changeset
  1490
	^ self
claus
parents: 138
diff changeset
  1491
    ].
claus
parents: 138
diff changeset
  1492
151
claus
parents: 145
diff changeset
  1493
    "
claus
parents: 145
diff changeset
  1494
     slowly migrating to use layoutObjects ...
claus
parents: 145
diff changeset
  1495
    "
claus
parents: 145
diff changeset
  1496
    layout isNil ifTrue:[
claus
parents: 145
diff changeset
  1497
	newOrg := self computeOrigin.
claus
parents: 145
diff changeset
  1498
	newExt := self computeExtent.
claus
parents: 145
diff changeset
  1499
    ] ifFalse:[
claus
parents: 145
diff changeset
  1500
	r := (layout rectangleRelativeTo:(superView viewRectangle)
claus
parents: 145
diff changeset
  1501
			       preferred:(self preferredBounds)).
claus
parents: 145
diff changeset
  1502
	newOrg := r origin rounded.
claus
parents: 145
diff changeset
  1503
	newExt := r extent rounded.
claus
parents: 145
diff changeset
  1504
"/ newOrg printNL.
claus
parents: 145
diff changeset
  1505
"/ newExt printNL.
claus
parents: 145
diff changeset
  1506
    ].
140
claus
parents: 138
diff changeset
  1507
claus
parents: 138
diff changeset
  1508
    newOrg notNil ifTrue:[
claus
parents: 138
diff changeset
  1509
	((newOrg x == oldLeft) and:[newOrg y == oldTop]) ifTrue:[
claus
parents: 138
diff changeset
  1510
	    newOrg := nil
claus
parents: 138
diff changeset
  1511
	]
claus
parents: 138
diff changeset
  1512
    ].
claus
parents: 138
diff changeset
  1513
    newExt notNil ifTrue:[
claus
parents: 138
diff changeset
  1514
	((newExt x == width) and:[newExt y == height]) ifTrue:[
claus
parents: 138
diff changeset
  1515
	    newExt := nil
claus
parents: 138
diff changeset
  1516
	]
claus
parents: 138
diff changeset
  1517
    ].
claus
parents: 138
diff changeset
  1518
claus
parents: 138
diff changeset
  1519
    newExt isNil ifTrue:[
claus
parents: 138
diff changeset
  1520
	newOrg notNil ifTrue:[
claus
parents: 138
diff changeset
  1521
	    self pixelOrigin:newOrg
claus
parents: 138
diff changeset
  1522
	]
claus
parents: 138
diff changeset
  1523
    ] ifFalse:[
claus
parents: 138
diff changeset
  1524
	newOrg isNil ifTrue:[
claus
parents: 138
diff changeset
  1525
	    self pixelExtent:newExt
claus
parents: 138
diff changeset
  1526
	] ifFalse:[
claus
parents: 138
diff changeset
  1527
	    self pixelOrigin:newOrg extent:newExt
claus
parents: 138
diff changeset
  1528
	]
claus
parents: 138
diff changeset
  1529
    ]
claus
parents: 138
diff changeset
  1530
!
claus
parents: 138
diff changeset
  1531
193
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1532
subViewChangedSize
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1533
    "some subview has changed its size; we are not interrested
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1534
     in that here, but some geometry managers redefine this, to reorganize
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1535
     components if that happens."
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1536
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1537
    ^ self
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1538
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1539
    "Created: 22.9.1995 / 14:44:59 / claus"
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1540
!
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1541
140
claus
parents: 138
diff changeset
  1542
configureX:x y:y width:newWidth height:newHeight
claus
parents: 138
diff changeset
  1543
    "my size has changed by window manager action"
claus
parents: 138
diff changeset
  1544
180
claus
parents: 176
diff changeset
  1545
    |how anyEdge mustRedrawBottomEdge mustRedrawRightEdge p|
claus
parents: 176
diff changeset
  1546
claus
parents: 176
diff changeset
  1547
    (superView isNil 
claus
parents: 176
diff changeset
  1548
    and:[drawableId notNil]) ifTrue:[
claus
parents: 176
diff changeset
  1549
	"/ have to be careful - some window managers (motif) wrap another
claus
parents: 176
diff changeset
  1550
	"/ view around and the reported origin is relative to that.
claus
parents: 176
diff changeset
  1551
	"/ not relative to the screen.
claus
parents: 176
diff changeset
  1552
	p := device translatePoint:0@0 from:drawableId to:device rootWindowId.
claus
parents: 176
diff changeset
  1553
	left := p x.
claus
parents: 176
diff changeset
  1554
	top := p y.
claus
parents: 176
diff changeset
  1555
    ] ifFalse:[
claus
parents: 176
diff changeset
  1556
	left := x.
claus
parents: 176
diff changeset
  1557
	top := y.
claus
parents: 176
diff changeset
  1558
    ].
140
claus
parents: 138
diff changeset
  1559
    ((width ~~ newWidth) or:[height ~~ newHeight]) ifTrue:[
claus
parents: 138
diff changeset
  1560
	realized ifFalse:[
claus
parents: 138
diff changeset
  1561
	    width := newWidth.
claus
parents: 138
diff changeset
  1562
	    height := newHeight.
claus
parents: 138
diff changeset
  1563
	    extentChanged := true.
claus
parents: 138
diff changeset
  1564
	    ^ self
claus
parents: 138
diff changeset
  1565
	].
claus
parents: 138
diff changeset
  1566
claus
parents: 138
diff changeset
  1567
	((newWidth <= width) and:[newHeight <= height]) ifTrue:[
claus
parents: 138
diff changeset
  1568
	    how := #smaller
claus
parents: 138
diff changeset
  1569
	].
claus
parents: 138
diff changeset
  1570
claus
parents: 138
diff changeset
  1571
	level ~~ 0 ifTrue:[
claus
parents: 138
diff changeset
  1572
	    mustRedrawBottomEdge := newHeight < height.
claus
parents: 138
diff changeset
  1573
	    mustRedrawRightEdge := newWidth < width.
claus
parents: 138
diff changeset
  1574
	    anyEdge := mustRedrawBottomEdge or:[mustRedrawRightEdge]
claus
parents: 138
diff changeset
  1575
	] ifFalse:[
claus
parents: 138
diff changeset
  1576
	    anyEdge := false
claus
parents: 138
diff changeset
  1577
	].
claus
parents: 138
diff changeset
  1578
claus
parents: 138
diff changeset
  1579
	width := newWidth.
claus
parents: 138
diff changeset
  1580
	height := newHeight.
claus
parents: 138
diff changeset
  1581
claus
parents: 138
diff changeset
  1582
	"recompute inner-clip if needed"
claus
parents: 138
diff changeset
  1583
	self setInnerClip.
claus
parents: 138
diff changeset
  1584
claus
parents: 138
diff changeset
  1585
	"
claus
parents: 138
diff changeset
  1586
	 must first process pending exposes;
claus
parents: 138
diff changeset
  1587
	 otherwise, those may be drawn at a wrong position
claus
parents: 138
diff changeset
  1588
	"
claus
parents: 138
diff changeset
  1589
	windowGroup notNil ifTrue:[
claus
parents: 138
diff changeset
  1590
	    windowGroup processExposeEvents
claus
parents: 138
diff changeset
  1591
	].
claus
parents: 138
diff changeset
  1592
	self sizeChanged:how.
claus
parents: 138
diff changeset
  1593
claus
parents: 138
diff changeset
  1594
	(anyEdge and:[shown]) ifTrue:[
claus
parents: 138
diff changeset
  1595
	    self clipRect:nil.
claus
parents: 138
diff changeset
  1596
	    mustRedrawBottomEdge ifTrue:[
claus
parents: 138
diff changeset
  1597
		self drawBottomEdge
claus
parents: 138
diff changeset
  1598
	    ].
claus
parents: 138
diff changeset
  1599
	    mustRedrawRightEdge ifTrue:[
claus
parents: 138
diff changeset
  1600
		self drawRightEdge
claus
parents: 138
diff changeset
  1601
	    ].
claus
parents: 138
diff changeset
  1602
	    self clipRect:innerClipRect
claus
parents: 138
diff changeset
  1603
	]
claus
parents: 138
diff changeset
  1604
    ]
138
claus
parents: 137
diff changeset
  1605
!
claus
parents: 137
diff changeset
  1606
135
claus
parents:
diff changeset
  1607
exposeX:x y:y width:w height:h
claus
parents:
diff changeset
  1608
    "a low level redraw event from device
claus
parents:
diff changeset
  1609
      - let subclass handle the redraw and take care of edges here"
claus
parents:
diff changeset
  1610
claus
parents:
diff changeset
  1611
    |leftEdge topEdge rightEdge botEdge anyEdge nx ny nw nh old|
claus
parents:
diff changeset
  1612
claus
parents:
diff changeset
  1613
    nw := w.
claus
parents:
diff changeset
  1614
    nh := h.
claus
parents:
diff changeset
  1615
    nx := x.
claus
parents:
diff changeset
  1616
    ny := y.
claus
parents:
diff changeset
  1617
claus
parents:
diff changeset
  1618
    anyEdge := false.
claus
parents:
diff changeset
  1619
claus
parents:
diff changeset
  1620
    "
claus
parents:
diff changeset
  1621
     check if there is a need to draw an edge (i.e. if margin is hit)
claus
parents:
diff changeset
  1622
    "
claus
parents:
diff changeset
  1623
    (margin ~~ 0) ifTrue:[
claus
parents:
diff changeset
  1624
	leftEdge := false.
claus
parents:
diff changeset
  1625
	topEdge := false.
claus
parents:
diff changeset
  1626
	rightEdge := false.
claus
parents:
diff changeset
  1627
	botEdge := false.
claus
parents:
diff changeset
  1628
	transformation notNil ifTrue:[
claus
parents:
diff changeset
  1629
	    "
claus
parents:
diff changeset
  1630
	     need device coordinates for this test
claus
parents:
diff changeset
  1631
	    "
claus
parents:
diff changeset
  1632
	    nx := transformation applyToX:nx.
claus
parents:
diff changeset
  1633
	    ny := transformation applyToY:ny.
claus
parents:
diff changeset
  1634
	    nw := transformation applyScaleX:nw.
claus
parents:
diff changeset
  1635
	    nh := transformation applyScaleY:nh.
claus
parents:
diff changeset
  1636
	].
claus
parents:
diff changeset
  1637
	"
claus
parents:
diff changeset
  1638
	 adjust expose rectangle, to exclude the margin.
claus
parents:
diff changeset
  1639
	 Care for rounding errors ...
claus
parents:
diff changeset
  1640
	"
claus
parents:
diff changeset
  1641
	(nx isMemberOf:SmallInteger) ifFalse:[
claus
parents:
diff changeset
  1642
	    old := nx.
claus
parents:
diff changeset
  1643
	    nx := nx truncated.
claus
parents:
diff changeset
  1644
	    nw := nw + (nx - old).
claus
parents:
diff changeset
  1645
	].
claus
parents:
diff changeset
  1646
	(ny isMemberOf:SmallInteger) ifFalse:[
claus
parents:
diff changeset
  1647
	    old := ny.
claus
parents:
diff changeset
  1648
	    ny := ny truncated.
claus
parents:
diff changeset
  1649
	    nh := nh + (ny - old).
claus
parents:
diff changeset
  1650
	].
claus
parents:
diff changeset
  1651
	(nw isMemberOf:SmallInteger) ifFalse:[
claus
parents:
diff changeset
  1652
	    nw := nw truncated + 1
claus
parents:
diff changeset
  1653
	].
claus
parents:
diff changeset
  1654
	(nh isMemberOf:SmallInteger) ifFalse:[
claus
parents:
diff changeset
  1655
	    nh := nh truncated + 1
claus
parents:
diff changeset
  1656
	].
claus
parents:
diff changeset
  1657
	(nx < margin) ifTrue:[
claus
parents:
diff changeset
  1658
	    old := nx.
claus
parents:
diff changeset
  1659
	    nx := margin.
claus
parents:
diff changeset
  1660
	    nw := nw - (nx - old).
claus
parents:
diff changeset
  1661
	    leftEdge := anyEdge := true.
claus
parents:
diff changeset
  1662
	].
claus
parents:
diff changeset
  1663
	((nx + nw - 1) >= (width - margin)) ifTrue:[
claus
parents:
diff changeset
  1664
	    nw := (width - margin - nx).
claus
parents:
diff changeset
  1665
	    rightEdge := anyEdge := true.
claus
parents:
diff changeset
  1666
	].
claus
parents:
diff changeset
  1667
	(ny < margin) ifTrue:[
claus
parents:
diff changeset
  1668
	    old := ny.
claus
parents:
diff changeset
  1669
	    ny := margin.
claus
parents:
diff changeset
  1670
	    nh := nh - (ny - old).
claus
parents:
diff changeset
  1671
	    topEdge := anyEdge := true.
claus
parents:
diff changeset
  1672
	].
claus
parents:
diff changeset
  1673
	((ny + nh - 1) >= (height - margin)) ifTrue:[
claus
parents:
diff changeset
  1674
	    nh := (height - margin - ny).
claus
parents:
diff changeset
  1675
	    botEdge := anyEdge := true.
claus
parents:
diff changeset
  1676
	].
claus
parents:
diff changeset
  1677
	transformation notNil ifTrue:[
claus
parents:
diff changeset
  1678
	    "
claus
parents:
diff changeset
  1679
	     need logical coordinates for redraw
claus
parents:
diff changeset
  1680
	    "
claus
parents:
diff changeset
  1681
	    nx := transformation applyInverseToX:nx.
claus
parents:
diff changeset
  1682
	    ny := transformation applyInverseToY:ny.
claus
parents:
diff changeset
  1683
	    nw := transformation applyInverseScaleX:nw.
claus
parents:
diff changeset
  1684
	    nh := transformation applyInverseScaleY:nh.
claus
parents:
diff changeset
  1685
	].
claus
parents:
diff changeset
  1686
    ].
claus
parents:
diff changeset
  1687
claus
parents:
diff changeset
  1688
    "
claus
parents:
diff changeset
  1689
     redraw inside area
claus
parents:
diff changeset
  1690
    "
claus
parents:
diff changeset
  1691
    self redrawX:nx y:ny width:nw height:nh.
claus
parents:
diff changeset
  1692
claus
parents:
diff changeset
  1693
    "
claus
parents:
diff changeset
  1694
     redraw edge(s)
claus
parents:
diff changeset
  1695
    "
claus
parents:
diff changeset
  1696
    anyEdge ifTrue:[
claus
parents:
diff changeset
  1697
	self clipRect:nil.
claus
parents:
diff changeset
  1698
	(topEdge and:[leftEdge and:[botEdge and:[rightEdge]]]) ifTrue:[
claus
parents:
diff changeset
  1699
	    self drawEdges
claus
parents:
diff changeset
  1700
	] ifFalse:[
claus
parents:
diff changeset
  1701
	    topEdge ifTrue:[
claus
parents:
diff changeset
  1702
		self drawTopEdge
claus
parents:
diff changeset
  1703
	    ].
claus
parents:
diff changeset
  1704
	    leftEdge ifTrue:[
claus
parents:
diff changeset
  1705
		self drawLeftEdge
claus
parents:
diff changeset
  1706
	    ].
claus
parents:
diff changeset
  1707
	    botEdge ifTrue:[
claus
parents:
diff changeset
  1708
		self drawBottomEdge
claus
parents:
diff changeset
  1709
	    ].
claus
parents:
diff changeset
  1710
	    rightEdge ifTrue:[
claus
parents:
diff changeset
  1711
		self drawRightEdge
claus
parents:
diff changeset
  1712
	    ]
claus
parents:
diff changeset
  1713
	].
claus
parents:
diff changeset
  1714
	self clipRect:innerClipRect
claus
parents:
diff changeset
  1715
    ]
claus
parents:
diff changeset
  1716
!
claus
parents:
diff changeset
  1717
claus
parents:
diff changeset
  1718
superViewMapped
claus
parents:
diff changeset
  1719
    "my superview was mapped (became visible)"
claus
parents:
diff changeset
  1720
claus
parents:
diff changeset
  1721
    realized ifTrue:[
claus
parents:
diff changeset
  1722
	shown := true.
claus
parents:
diff changeset
  1723
	subViews notNil ifTrue:[
claus
parents:
diff changeset
  1724
	    subViews do:[:v |
claus
parents:
diff changeset
  1725
		v superViewMapped
claus
parents:
diff changeset
  1726
	    ]
claus
parents:
diff changeset
  1727
	]
claus
parents:
diff changeset
  1728
    ].
claus
parents:
diff changeset
  1729
!
claus
parents:
diff changeset
  1730
140
claus
parents: 138
diff changeset
  1731
unmapped
claus
parents: 138
diff changeset
  1732
    "the view has been unmapped 
claus
parents: 138
diff changeset
  1733
     (either by some outside action - i.e. window manager iconified me,
claus
parents: 138
diff changeset
  1734
     or due to unmapping of my parentView)"
claus
parents: 138
diff changeset
  1735
claus
parents: 138
diff changeset
  1736
    shown := false.
claus
parents: 138
diff changeset
  1737
    subViews notNil ifTrue:[
claus
parents: 138
diff changeset
  1738
	subViews do:[:v |
claus
parents: 138
diff changeset
  1739
	    v superViewUnmapped
135
claus
parents:
diff changeset
  1740
	]
claus
parents:
diff changeset
  1741
    ]
claus
parents:
diff changeset
  1742
!
claus
parents:
diff changeset
  1743
140
claus
parents: 138
diff changeset
  1744
coveredBy:aView
claus
parents: 138
diff changeset
  1745
    "the receiver has been covered by another view;
claus
parents: 138
diff changeset
  1746
     we are not interrested in that here (but see modalBox for more)."
claus
parents: 138
diff changeset
  1747
!
claus
parents: 138
diff changeset
  1748
claus
parents: 138
diff changeset
  1749
superViewUnmapped
claus
parents: 138
diff changeset
  1750
    "my superView was unmapped"
claus
parents: 138
diff changeset
  1751
claus
parents: 138
diff changeset
  1752
    self unmapped
claus
parents: 138
diff changeset
  1753
!
claus
parents: 138
diff changeset
  1754
claus
parents: 138
diff changeset
  1755
sizeChanged:how
claus
parents: 138
diff changeset
  1756
    "tell subviews if I change size.
claus
parents: 138
diff changeset
  1757
     How is either #smaller, #larger or nil, and is used to control the order,
claus
parents: 138
diff changeset
  1758
     in which subviews are notified (possibly reducing redraw activity)"
claus
parents: 138
diff changeset
  1759
claus
parents: 138
diff changeset
  1760
    window notNil ifTrue:[
claus
parents: 138
diff changeset
  1761
	"compute new transformation"
135
claus
parents:
diff changeset
  1762
    ].
140
claus
parents: 138
diff changeset
  1763
    subViews notNil ifTrue:[
claus
parents: 138
diff changeset
  1764
	(how isNil "false" 
claus
parents: 138
diff changeset
  1765
	or:[how == #smaller]) ifTrue:[
claus
parents: 138
diff changeset
  1766
	    subViews do:[:view |
claus
parents: 138
diff changeset
  1767
		view superViewChangedSize
claus
parents: 138
diff changeset
  1768
	    ]
claus
parents: 138
diff changeset
  1769
	] ifFalse:[
claus
parents: 138
diff changeset
  1770
	    "doing it reverse speeds up resizing - usually subviews
claus
parents: 138
diff changeset
  1771
	     are created from top-left to bottom-right; therefore
claus
parents: 138
diff changeset
  1772
	     bottom-right views will be moved/resized first, then top-left ones;
claus
parents: 138
diff changeset
  1773
	     this avoids multiple redraws of subviews"
claus
parents: 138
diff changeset
  1774
claus
parents: 138
diff changeset
  1775
	    subViews reverseDo:[:view |
claus
parents: 138
diff changeset
  1776
		view superViewChangedSize
claus
parents: 138
diff changeset
  1777
	    ]
135
claus
parents:
diff changeset
  1778
	]
claus
parents:
diff changeset
  1779
    ].
140
claus
parents: 138
diff changeset
  1780
    self changed:#sizeOfView with:how.
193
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1781
    superView notNil ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1782
	superView subViewChangedSize
Claus Gittinger <cg@exept.de>
parents: 192
diff changeset
  1783
    ]
140
claus
parents: 138
diff changeset
  1784
!
claus
parents: 138
diff changeset
  1785
claus
parents: 138
diff changeset
  1786
reparented
claus
parents: 138
diff changeset
  1787
    "the view has changed its parent by some outside
claus
parents: 138
diff changeset
  1788
     action - i.e. window manager has added a frame.
claus
parents: 138
diff changeset
  1789
     nothing done here"
claus
parents: 138
diff changeset
  1790
claus
parents: 138
diff changeset
  1791
    ^ self
claus
parents: 138
diff changeset
  1792
!
claus
parents: 138
diff changeset
  1793
claus
parents: 138
diff changeset
  1794
keyPress:key x:x y:y
claus
parents: 138
diff changeset
  1795
    "a key has been pressed. If there are components,
claus
parents: 138
diff changeset
  1796
     pass it to the corresponding one. 
claus
parents: 138
diff changeset
  1797
     Otherwise, forward it to the superview, if there is any."
claus
parents: 138
diff changeset
  1798
claus
parents: 138
diff changeset
  1799
    components notNil ifTrue:[
claus
parents: 138
diff changeset
  1800
	components do:[:aComponent |
claus
parents: 138
diff changeset
  1801
	    |thisFrame|
claus
parents: 138
diff changeset
  1802
claus
parents: 138
diff changeset
  1803
	    thisFrame := aComponent frame.
claus
parents: 138
diff changeset
  1804
	    (thisFrame containsPointX:x y:y) ifTrue:[
claus
parents: 138
diff changeset
  1805
		aComponent keyPress:key x:x - thisFrame left
claus
parents: 138
diff changeset
  1806
					y:y - thisFrame top.
claus
parents: 138
diff changeset
  1807
		^ self
claus
parents: 138
diff changeset
  1808
	    ]
135
claus
parents:
diff changeset
  1809
	]
claus
parents:
diff changeset
  1810
    ].
claus
parents:
diff changeset
  1811
140
claus
parents: 138
diff changeset
  1812
    x >= 0 ifTrue:[
claus
parents: 138
diff changeset
  1813
	superView notNil ifTrue:[
claus
parents: 138
diff changeset
  1814
	    WindowEvent
claus
parents: 138
diff changeset
  1815
		sendEvent:#keyPress:x:y:
claus
parents: 138
diff changeset
  1816
		arguments:(Array with:key with:0 with:0)
claus
parents: 138
diff changeset
  1817
		view:superView
135
claus
parents:
diff changeset
  1818
	] ifFalse:[
140
claus
parents: 138
diff changeset
  1819
	    super keyPress:key x:x y:y
135
claus
parents:
diff changeset
  1820
	]
claus
parents:
diff changeset
  1821
    ]
claus
parents:
diff changeset
  1822
!
claus
parents:
diff changeset
  1823
claus
parents:
diff changeset
  1824
buttonPress:button x:x y:y
claus
parents:
diff changeset
  1825
    "button was pressed - if its the middle button 
claus
parents:
diff changeset
  1826
     and there is a middleButtonMenu, show it.
claus
parents:
diff changeset
  1827
     If both a model and a menuSelector is is defined, ask the model for
claus
parents:
diff changeset
  1828
     the menu and launch it. The menu is supposed to return an actionSelector
claus
parents:
diff changeset
  1829
     which in turn is sent to the model."
claus
parents:
diff changeset
  1830
153
claus
parents: 151
diff changeset
  1831
    |menu menuPerformer actionSelector actionArg|
135
claus
parents:
diff changeset
  1832
claus
parents:
diff changeset
  1833
    components notNil ifTrue:[
claus
parents:
diff changeset
  1834
	components do:[:aComponent |
claus
parents:
diff changeset
  1835
	    |thisFrame|
claus
parents:
diff changeset
  1836
claus
parents:
diff changeset
  1837
	    thisFrame := aComponent frame.
claus
parents:
diff changeset
  1838
	    (thisFrame containsPointX:x y:y) ifTrue:[
claus
parents:
diff changeset
  1839
		aComponent buttonPress:button x:x - thisFrame left
claus
parents:
diff changeset
  1840
					      y:y - thisFrame top.
claus
parents:
diff changeset
  1841
		^ self
claus
parents:
diff changeset
  1842
	    ]
claus
parents:
diff changeset
  1843
	]
claus
parents:
diff changeset
  1844
    ].
claus
parents:
diff changeset
  1845
claus
parents:
diff changeset
  1846
    ((button == 2) or:[button == #menu]) ifTrue:[
claus
parents:
diff changeset
  1847
	"
claus
parents:
diff changeset
  1848
	 try ST-80 style menus first:
claus
parents:
diff changeset
  1849
	 if there is a model, and a menuMessage is defined,
claus
parents:
diff changeset
  1850
	 ask model for the menu and launch that if non-nil.
claus
parents:
diff changeset
  1851
	"
claus
parents:
diff changeset
  1852
	menu := self yellowButtonMenu.
claus
parents:
diff changeset
  1853
	menu notNil ifTrue:[
claus
parents:
diff changeset
  1854
	    "
claus
parents:
diff changeset
  1855
	     got one, launch the menu. It is supposed
claus
parents:
diff changeset
  1856
	     to return an actionSelector.
claus
parents:
diff changeset
  1857
	    "
claus
parents:
diff changeset
  1858
	    menuPerformer := self menuPerformer.
claus
parents:
diff changeset
  1859
	    "
claus
parents:
diff changeset
  1860
	     a temporary kludge: subMenus dont know about 
claus
parents:
diff changeset
  1861
	     actionSelectors yet ...
claus
parents:
diff changeset
  1862
	    "
claus
parents:
diff changeset
  1863
	    menu receiver isNil ifTrue:[
claus
parents:
diff changeset
  1864
		menu receiver:menuPerformer
claus
parents:
diff changeset
  1865
	    ].
claus
parents:
diff changeset
  1866
	    actionSelector := menu startUp.
claus
parents:
diff changeset
  1867
142
claus
parents: 140
diff changeset
  1868
	    "
153
claus
parents: 151
diff changeset
  1869
	     mhmh - kludge for selectors with argument
claus
parents: 151
diff changeset
  1870
	    "
claus
parents: 151
diff changeset
  1871
	    (actionSelector isMemberOf:Array) ifTrue:[
claus
parents: 151
diff changeset
  1872
		actionArg := actionSelector at:2.
claus
parents: 151
diff changeset
  1873
		actionSelector := actionSelector at:1.
claus
parents: 151
diff changeset
  1874
	    ].
claus
parents: 151
diff changeset
  1875
claus
parents: 151
diff changeset
  1876
	    "
142
claus
parents: 140
diff changeset
  1877
	     mhmh - ST-80 seems to send some to the model and
claus
parents: 140
diff changeset
  1878
	     others (copy/cut/paste) to the controller/view
153
claus
parents: 151
diff changeset
  1879
	     Simulate this behavior, by looking what the model responds to.
142
claus
parents: 140
diff changeset
  1880
	    "
135
claus
parents:
diff changeset
  1881
	    (actionSelector notNil
claus
parents:
diff changeset
  1882
	    and:[actionSelector isSymbol]) ifTrue:[
142
claus
parents: 140
diff changeset
  1883
		(menuPerformer respondsTo:actionSelector) ifFalse:[
153
claus
parents: 151
diff changeset
  1884
		    (self respondsTo:actionSelector) ifTrue:[
claus
parents: 151
diff changeset
  1885
			menuPerformer := self
claus
parents: 151
diff changeset
  1886
		    ]
142
claus
parents: 140
diff changeset
  1887
		].
153
claus
parents: 151
diff changeset
  1888
		actionSelector numArgs ~~ 0 ifTrue:[
claus
parents: 151
diff changeset
  1889
		    menuPerformer perform:actionSelector with:actionArg
claus
parents: 151
diff changeset
  1890
		] ifFalse:[
claus
parents: 151
diff changeset
  1891
		    menuPerformer perform:actionSelector
claus
parents: 151
diff changeset
  1892
		]
135
claus
parents:
diff changeset
  1893
	    ].
claus
parents:
diff changeset
  1894
	    ^ self
claus
parents:
diff changeset
  1895
	].
claus
parents:
diff changeset
  1896
    ].
claus
parents:
diff changeset
  1897
    super buttonPress:button x:x y:y
claus
parents:
diff changeset
  1898
!
claus
parents:
diff changeset
  1899
140
claus
parents: 138
diff changeset
  1900
hasKeyboardFocus:aBoolean
135
claus
parents:
diff changeset
  1901
    ^ self
claus
parents:
diff changeset
  1902
!
claus
parents:
diff changeset
  1903
claus
parents:
diff changeset
  1904
focusIn
claus
parents:
diff changeset
  1905
    "got keyboard focus"
claus
parents:
diff changeset
  1906
claus
parents:
diff changeset
  1907
    self showFocus
claus
parents:
diff changeset
  1908
!
claus
parents:
diff changeset
  1909
claus
parents:
diff changeset
  1910
visibilityChange:how
claus
parents:
diff changeset
  1911
    "the visibility of the view has changed (by some outside
claus
parents:
diff changeset
  1912
     action - i.e. window manager rearranged things).
claus
parents:
diff changeset
  1913
     Using this knowledge avoids useless redraw in obsucred views."
claus
parents:
diff changeset
  1914
claus
parents:
diff changeset
  1915
    how == #fullyObscured ifTrue:[
claus
parents:
diff changeset
  1916
	shown := false
claus
parents:
diff changeset
  1917
    ] ifFalse:[
claus
parents:
diff changeset
  1918
	shown := true.
claus
parents:
diff changeset
  1919
    ]
claus
parents:
diff changeset
  1920
!
claus
parents:
diff changeset
  1921
140
claus
parents: 138
diff changeset
  1922
focusOut
claus
parents: 138
diff changeset
  1923
    "lost keyboard focus"
claus
parents: 138
diff changeset
  1924
claus
parents: 138
diff changeset
  1925
    self showNoFocus
claus
parents: 138
diff changeset
  1926
!
claus
parents: 138
diff changeset
  1927
135
claus
parents:
diff changeset
  1928
destroyed
claus
parents:
diff changeset
  1929
    "view has been destroyed by someone else (usually window system)"
claus
parents:
diff changeset
  1930
claus
parents:
diff changeset
  1931
    shown := false.
claus
parents:
diff changeset
  1932
    super destroyed
claus
parents:
diff changeset
  1933
!
claus
parents:
diff changeset
  1934
157
claus
parents: 154
diff changeset
  1935
terminate
claus
parents: 154
diff changeset
  1936
    "window manager wants me to go away;
claus
parents: 154
diff changeset
  1937
     - notice, that not all window managers are nice enough to 
claus
parents: 154
diff changeset
  1938
       send this event, but simply destroy the view instead.
claus
parents: 154
diff changeset
  1939
     Can be redefined in subclasses to do whatever cleanup is 
claus
parents: 154
diff changeset
  1940
     required."
claus
parents: 154
diff changeset
  1941
claus
parents: 154
diff changeset
  1942
    ^ self destroy
claus
parents: 154
diff changeset
  1943
!
claus
parents: 154
diff changeset
  1944
135
claus
parents:
diff changeset
  1945
saveAndTerminate
claus
parents:
diff changeset
  1946
    "window manager wants me to save and go away; 
claus
parents:
diff changeset
  1947
     - notice, that not all window managers are nice enough to 
claus
parents:
diff changeset
  1948
       send this event, but simply destroy the view instead.
claus
parents:
diff changeset
  1949
     Can be redefined in subclasses to do whatever is required
claus
parents:
diff changeset
  1950
     to prepare for restart."
claus
parents:
diff changeset
  1951
claus
parents:
diff changeset
  1952
    ^ self destroy
claus
parents:
diff changeset
  1953
! !
claus
parents:
diff changeset
  1954
140
claus
parents: 138
diff changeset
  1955
!SimpleView methodsFor:'private'!
claus
parents: 138
diff changeset
  1956
claus
parents: 138
diff changeset
  1957
setInnerClip
claus
parents: 138
diff changeset
  1958
    "compute, and set the inside clip-area"
claus
parents: 138
diff changeset
  1959
claus
parents: 138
diff changeset
  1960
    self computeInnerClip.
claus
parents: 138
diff changeset
  1961
    self clipRect:innerClipRect
claus
parents: 138
diff changeset
  1962
!
claus
parents: 138
diff changeset
  1963
claus
parents: 138
diff changeset
  1964
computeInnerClip
claus
parents: 138
diff changeset
  1965
    "compute, but do not set the inside clip-area"
claus
parents: 138
diff changeset
  1966
claus
parents: 138
diff changeset
  1967
    |m2 nX nY nW nH|
claus
parents: 138
diff changeset
  1968
claus
parents: 138
diff changeset
  1969
    (margin ~~ 0) ifTrue:[
claus
parents: 138
diff changeset
  1970
	m2 := margin + margin.
claus
parents: 138
diff changeset
  1971
	nX := nY := margin.
claus
parents: 138
diff changeset
  1972
	nW := width - m2.
claus
parents: 138
diff changeset
  1973
	nH := height - m2.
claus
parents: 138
diff changeset
  1974
	transformation notNil ifTrue:[
claus
parents: 138
diff changeset
  1975
	    nX := transformation applyInverseToX:nX.
claus
parents: 138
diff changeset
  1976
	    nY := transformation applyInverseToY:nY.
claus
parents: 138
diff changeset
  1977
	    nW := transformation applyInverseScaleX:nW.
claus
parents: 138
diff changeset
  1978
	    nH := transformation applyInverseScaleY:nH.
claus
parents: 138
diff changeset
  1979
	].
claus
parents: 138
diff changeset
  1980
	innerClipRect := Rectangle 
claus
parents: 138
diff changeset
  1981
				 left:nX 
claus
parents: 138
diff changeset
  1982
				 top:nY 
claus
parents: 138
diff changeset
  1983
				 width:nW 
claus
parents: 138
diff changeset
  1984
				 height:nH
claus
parents: 138
diff changeset
  1985
    ] ifFalse:[
claus
parents: 138
diff changeset
  1986
	"no clipping"
claus
parents: 138
diff changeset
  1987
	innerClipRect := nil
claus
parents: 138
diff changeset
  1988
    ]
claus
parents: 138
diff changeset
  1989
!
claus
parents: 138
diff changeset
  1990
claus
parents: 138
diff changeset
  1991
pixelOrigin:origin extent:extent
claus
parents: 138
diff changeset
  1992
    "set the views origin and extent in pixels"
claus
parents: 138
diff changeset
  1993
claus
parents: 138
diff changeset
  1994
    |newLeft newTop newWidth newHeight how 
claus
parents: 138
diff changeset
  1995
     mustRedrawBottomEdge mustRedrawRightEdge mustRepaintBottom
claus
parents: 138
diff changeset
  1996
     mustRepaintRight sameOrigin oldWidth oldHeight|
claus
parents: 138
diff changeset
  1997
claus
parents: 138
diff changeset
  1998
    newLeft := origin x.
claus
parents: 138
diff changeset
  1999
    newTop := origin y.
claus
parents: 138
diff changeset
  2000
    sameOrigin := ((newTop == top) and:[newLeft == left]).
claus
parents: 138
diff changeset
  2001
claus
parents: 138
diff changeset
  2002
    newWidth := extent x.
claus
parents: 138
diff changeset
  2003
    newHeight := extent y.
claus
parents: 138
diff changeset
  2004
claus
parents: 138
diff changeset
  2005
    "
claus
parents: 138
diff changeset
  2006
     X complains badly if you try to create/resize a view with
claus
parents: 138
diff changeset
  2007
     a dimension <= 0 ... (although I think that 0 maks sense ...)
claus
parents: 138
diff changeset
  2008
    "
claus
parents: 138
diff changeset
  2009
    newWidth < 1 ifTrue:[
claus
parents: 138
diff changeset
  2010
	newWidth := 1.
claus
parents: 138
diff changeset
  2011
    ].
claus
parents: 138
diff changeset
  2012
    newHeight < 1 ifTrue:[
claus
parents: 138
diff changeset
  2013
	newHeight := 1
claus
parents: 138
diff changeset
  2014
    ].
claus
parents: 138
diff changeset
  2015
claus
parents: 138
diff changeset
  2016
    ((newWidth == width) and:[newHeight == height]) ifTrue:[
claus
parents: 138
diff changeset
  2017
	sameOrigin ifTrue:[^ self].
claus
parents: 138
diff changeset
  2018
	^ self pixelOrigin:origin
claus
parents: 138
diff changeset
  2019
    ].
claus
parents: 138
diff changeset
  2020
    top := newTop.
claus
parents: 138
diff changeset
  2021
    left := newLeft.
claus
parents: 138
diff changeset
  2022
claus
parents: 138
diff changeset
  2023
"/    shown ifTrue:[                  "4-nov-94 actually correct,"
claus
parents: 138
diff changeset
  2024
    drawableId notNil ifTrue:[        "but theres a bug in menus when resized while hidden"
151
claus
parents: 145
diff changeset
  2025
	mustRedrawBottomEdge := (level ~~ 0) and:[newHeight < height].
claus
parents: 145
diff changeset
  2026
	mustRedrawRightEdge := (level ~~ 0) and:[newWidth < width].
claus
parents: 145
diff changeset
  2027
claus
parents: 145
diff changeset
  2028
	((newHeight <= height) and:[newWidth <= width]) ifTrue:[
claus
parents: 145
diff changeset
  2029
	    how := #smaller
claus
parents: 145
diff changeset
  2030
	].
claus
parents: 145
diff changeset
  2031
140
claus
parents: 138
diff changeset
  2032
	mustRepaintRight := false.
claus
parents: 138
diff changeset
  2033
	mustRepaintBottom := false.
claus
parents: 138
diff changeset
  2034
	(level ~~ 0) ifTrue:[
claus
parents: 138
diff changeset
  2035
	    "clear the old edges"
claus
parents: 138
diff changeset
  2036
claus
parents: 138
diff changeset
  2037
	    newWidth > width ifTrue:[
claus
parents: 138
diff changeset
  2038
		self clipRect:nil.
claus
parents: 138
diff changeset
  2039
		self paint:viewBackground.
claus
parents: 138
diff changeset
  2040
		self fillDeviceRectangleX:(width - margin)
claus
parents: 138
diff changeset
  2041
					y:0
claus
parents: 138
diff changeset
  2042
				    width:margin
claus
parents: 138
diff changeset
  2043
				   height:height.
claus
parents: 138
diff changeset
  2044
		mustRepaintRight := true.
claus
parents: 138
diff changeset
  2045
		oldWidth := width
claus
parents: 138
diff changeset
  2046
	    ].
claus
parents: 138
diff changeset
  2047
	    newHeight > height ifTrue:[
claus
parents: 138
diff changeset
  2048
		self clipRect:nil.
claus
parents: 138
diff changeset
  2049
		self paint:viewBackground.
claus
parents: 138
diff changeset
  2050
		self fillDeviceRectangleX:0
claus
parents: 138
diff changeset
  2051
					y:(height - margin)
claus
parents: 138
diff changeset
  2052
				    width:width
claus
parents: 138
diff changeset
  2053
				   height:margin.
claus
parents: 138
diff changeset
  2054
		mustRepaintBottom := true.
claus
parents: 138
diff changeset
  2055
		oldHeight := height
claus
parents: 138
diff changeset
  2056
	    ]
claus
parents: 138
diff changeset
  2057
	].
claus
parents: 138
diff changeset
  2058
claus
parents: 138
diff changeset
  2059
	width := newWidth.
claus
parents: 138
diff changeset
  2060
	height := newHeight.
claus
parents: 138
diff changeset
  2061
claus
parents: 138
diff changeset
  2062
	self setInnerClip.
claus
parents: 138
diff changeset
  2063
claus
parents: 138
diff changeset
  2064
	"if view becomes smaller, send sizeChanged first"
claus
parents: 138
diff changeset
  2065
	(how == #smaller) ifTrue:[
claus
parents: 138
diff changeset
  2066
	    self sizeChanged:how
claus
parents: 138
diff changeset
  2067
	].
claus
parents: 138
diff changeset
  2068
claus
parents: 138
diff changeset
  2069
	"have to tell X, when extent of view is changed"
claus
parents: 138
diff changeset
  2070
	sameOrigin ifTrue:[
claus
parents: 138
diff changeset
  2071
	    device resizeWindow:drawableId width:width height:height.
claus
parents: 138
diff changeset
  2072
	] ifFalse:[
claus
parents: 138
diff changeset
  2073
	    "claus: some xservers seem to do better when resizing
claus
parents: 138
diff changeset
  2074
	     first ...."
claus
parents: 138
diff changeset
  2075
" 
claus
parents: 138
diff changeset
  2076
	    (how == #smaller) ifTrue:[
claus
parents: 138
diff changeset
  2077
		device resizeWindow:drawableId width:width height:height.
claus
parents: 138
diff changeset
  2078
		device moveWindow:drawableId x:left y:top
claus
parents: 138
diff changeset
  2079
	    ] ifFalse:[
claus
parents: 138
diff changeset
  2080
		device moveResizeWindow:drawableId x:left y:top width:width height:height
claus
parents: 138
diff changeset
  2081
	    ].
claus
parents: 138
diff changeset
  2082
" 
claus
parents: 138
diff changeset
  2083
	    device moveResizeWindow:drawableId x:left y:top
claus
parents: 138
diff changeset
  2084
					   width:width height:height.
claus
parents: 138
diff changeset
  2085
" "
claus
parents: 138
diff changeset
  2086
	].
claus
parents: 138
diff changeset
  2087
claus
parents: 138
diff changeset
  2088
	"if view becomes bigger, send sizeChanged after"
claus
parents: 138
diff changeset
  2089
	(how ~~ #smaller) ifTrue:[
claus
parents: 138
diff changeset
  2090
	    self sizeChanged:how
claus
parents: 138
diff changeset
  2091
	].
claus
parents: 138
diff changeset
  2092
claus
parents: 138
diff changeset
  2093
	(mustRedrawBottomEdge or:[mustRedrawRightEdge]) ifTrue:[
claus
parents: 138
diff changeset
  2094
	    self clipRect:nil.
claus
parents: 138
diff changeset
  2095
	    mustRedrawBottomEdge ifTrue:[
claus
parents: 138
diff changeset
  2096
		self drawBottomEdge
claus
parents: 138
diff changeset
  2097
	    ].
claus
parents: 138
diff changeset
  2098
	    mustRedrawRightEdge ifTrue:[
claus
parents: 138
diff changeset
  2099
		self drawRightEdge
claus
parents: 138
diff changeset
  2100
	    ].
claus
parents: 138
diff changeset
  2101
	    self clipRect:innerClipRect
claus
parents: 138
diff changeset
  2102
	].
claus
parents: 138
diff changeset
  2103
claus
parents: 138
diff changeset
  2104
	mustRepaintRight ifTrue:[
claus
parents: 138
diff changeset
  2105
	    self redrawDeviceX:(oldWidth - margin)
claus
parents: 138
diff changeset
  2106
			     y:0
claus
parents: 138
diff changeset
  2107
			 width:margin
claus
parents: 138
diff changeset
  2108
			height:height.
claus
parents: 138
diff changeset
  2109
	].
claus
parents: 138
diff changeset
  2110
	mustRepaintBottom ifTrue:[
claus
parents: 138
diff changeset
  2111
	    self redrawDeviceX:0
claus
parents: 138
diff changeset
  2112
			     y:(oldHeight - margin)
claus
parents: 138
diff changeset
  2113
			 width:width
claus
parents: 138
diff changeset
  2114
			height:margin.
claus
parents: 138
diff changeset
  2115
	].
claus
parents: 138
diff changeset
  2116
    ] ifFalse:[
claus
parents: 138
diff changeset
  2117
	"otherwise memorize the need for a sizeChanged message"
claus
parents: 138
diff changeset
  2118
claus
parents: 138
diff changeset
  2119
	width := newWidth.
claus
parents: 138
diff changeset
  2120
	height := newHeight.
claus
parents: 138
diff changeset
  2121
	sameOrigin ifFalse:[
claus
parents: 138
diff changeset
  2122
	    originChanged := true.
claus
parents: 138
diff changeset
  2123
	].
claus
parents: 138
diff changeset
  2124
	extentChanged := true
claus
parents: 138
diff changeset
  2125
    ]
claus
parents: 138
diff changeset
  2126
!
claus
parents: 138
diff changeset
  2127
claus
parents: 138
diff changeset
  2128
originFromRelativeOrigin:aPoint
claus
parents: 138
diff changeset
  2129
    "compute & return pixel origin from relativeOrigin, aPoint"
claus
parents: 138
diff changeset
  2130
claus
parents: 138
diff changeset
  2131
    |p l t|
claus
parents: 138
diff changeset
  2132
claus
parents: 138
diff changeset
  2133
    p := self pointFromRelative:aPoint.
claus
parents: 138
diff changeset
  2134
claus
parents: 138
diff changeset
  2135
    insets isNil ifTrue:[
claus
parents: 138
diff changeset
  2136
	^ p
claus
parents: 138
diff changeset
  2137
    ].
claus
parents: 138
diff changeset
  2138
    l := insets at:1.
claus
parents: 138
diff changeset
  2139
    t := insets at:2.
claus
parents: 138
diff changeset
  2140
claus
parents: 138
diff changeset
  2141
"/  l := t := 0.
claus
parents: 138
diff changeset
  2142
"/    leftInset notNil ifTrue:[
claus
parents: 138
diff changeset
  2143
"/        l := leftInset
claus
parents: 138
diff changeset
  2144
"/    ].
claus
parents: 138
diff changeset
  2145
"/    topInset notNil ifTrue:[
claus
parents: 138
diff changeset
  2146
"/        t := topInset
claus
parents: 138
diff changeset
  2147
"/    ].
claus
parents: 138
diff changeset
  2148
    ((l ~~ 0) or:[t ~~ 0]) ifTrue:[
claus
parents: 138
diff changeset
  2149
	^ (p x + l) @ (p y + t)
claus
parents: 138
diff changeset
  2150
    ].
claus
parents: 138
diff changeset
  2151
    ^ p
claus
parents: 138
diff changeset
  2152
!
claus
parents: 138
diff changeset
  2153
claus
parents: 138
diff changeset
  2154
pixelOrigin:origin
claus
parents: 138
diff changeset
  2155
    "set the views origin in pixels. For subviews. the origin is relative
claus
parents: 138
diff changeset
  2156
     to the superviews top-left. For topViews, its the screen origin."
claus
parents: 138
diff changeset
  2157
claus
parents: 138
diff changeset
  2158
    |newLeft newTop|
claus
parents: 138
diff changeset
  2159
claus
parents: 138
diff changeset
  2160
    newLeft := origin x.
claus
parents: 138
diff changeset
  2161
    newTop := origin y.
claus
parents: 138
diff changeset
  2162
    ((newTop ~~ top) or:[newLeft ~~ left]) ifTrue:[
claus
parents: 138
diff changeset
  2163
	top := newTop.
claus
parents: 138
diff changeset
  2164
	left := newLeft.
claus
parents: 138
diff changeset
  2165
claus
parents: 138
diff changeset
  2166
	"
claus
parents: 138
diff changeset
  2167
	 if the receiver is visible, or is a topView, perform the
claus
parents: 138
diff changeset
  2168
	 operation right away - otherwise, simply remember that the
claus
parents: 138
diff changeset
  2169
	 origin has changed - will tell the display once we get realized
claus
parents: 138
diff changeset
  2170
	"
151
claus
parents: 145
diff changeset
  2171
"/        (shown 
claus
parents: 145
diff changeset
  2172
"/        or:[superView isNil and:[drawableId notNil]]) ifTrue:[
claus
parents: 145
diff changeset
  2173
claus
parents: 145
diff changeset
  2174
	"/ no, have to do it if drawableId is there
claus
parents: 145
diff changeset
  2175
	"/ (otherwise, we could not move unmapped views around ...
claus
parents: 145
diff changeset
  2176
	"/
claus
parents: 145
diff changeset
  2177
	drawableId notNil ifTrue:[
140
claus
parents: 138
diff changeset
  2178
	    device moveWindow:drawableId x:left y:top
claus
parents: 138
diff changeset
  2179
	] ifFalse:[
claus
parents: 138
diff changeset
  2180
	    originChanged := true
135
claus
parents:
diff changeset
  2181
	]
claus
parents:
diff changeset
  2182
    ]
claus
parents:
diff changeset
  2183
!
claus
parents:
diff changeset
  2184
140
claus
parents: 138
diff changeset
  2185
pixelExtent:extent
claus
parents: 138
diff changeset
  2186
    "set the views extent in pixels"
claus
parents: 138
diff changeset
  2187
claus
parents: 138
diff changeset
  2188
    self pixelOrigin:(left @ top) extent:extent
claus
parents: 138
diff changeset
  2189
!
claus
parents: 138
diff changeset
  2190
claus
parents: 138
diff changeset
  2191
cornerFromRelativeCorner:aPoint
claus
parents: 138
diff changeset
  2192
    "compute & return pixel corner from a relativeCorner, aPoint"
claus
parents: 138
diff changeset
  2193
claus
parents: 138
diff changeset
  2194
    |p r b bw|
claus
parents: 138
diff changeset
  2195
claus
parents: 138
diff changeset
  2196
    p := self pointFromRelative:aPoint.
claus
parents: 138
diff changeset
  2197
claus
parents: 138
diff changeset
  2198
    bw := borderWidth.
claus
parents: 138
diff changeset
  2199
    insets isNil ifTrue:[
claus
parents: 138
diff changeset
  2200
	bw == 0 ifTrue:[
claus
parents: 138
diff changeset
  2201
	    ^ p
claus
parents: 138
diff changeset
  2202
	].
claus
parents: 138
diff changeset
  2203
	^ (p x - bw) @ (p y - bw)
claus
parents: 138
diff changeset
  2204
    ].
claus
parents: 138
diff changeset
  2205
    r := (insets at:3) + bw.
claus
parents: 138
diff changeset
  2206
    b := (insets at:4) + bw.
claus
parents: 138
diff changeset
  2207
claus
parents: 138
diff changeset
  2208
"/    r := b := bw.
claus
parents: 138
diff changeset
  2209
"/    rightInset notNil ifTrue:[
claus
parents: 138
diff changeset
  2210
"/        r := rightInset + bw
claus
parents: 138
diff changeset
  2211
"/    ].
claus
parents: 138
diff changeset
  2212
"/    bottomInset notNil ifTrue:[
claus
parents: 138
diff changeset
  2213
"/        b := bottomInset + bw
claus
parents: 138
diff changeset
  2214
"/    ].
claus
parents: 138
diff changeset
  2215
    ((r ~~ 0) or:[b ~~ 0]) ifTrue:[
claus
parents: 138
diff changeset
  2216
	^ (p x - r) @ (p y - b)
claus
parents: 138
diff changeset
  2217
    ].
claus
parents: 138
diff changeset
  2218
    ^ p
claus
parents: 138
diff changeset
  2219
!
claus
parents: 138
diff changeset
  2220
claus
parents: 138
diff changeset
  2221
cornerFromRelativeCorner
claus
parents: 138
diff changeset
  2222
    "compute & return pixel corner from relativeCorner"
claus
parents: 138
diff changeset
  2223
claus
parents: 138
diff changeset
  2224
    ^ self cornerFromRelativeCorner:relativeCorner
claus
parents: 138
diff changeset
  2225
!
claus
parents: 138
diff changeset
  2226
claus
parents: 138
diff changeset
  2227
pointFromRelative:p
claus
parents: 138
diff changeset
  2228
    "compute absolute coordinate from p"
claus
parents: 138
diff changeset
  2229
claus
parents: 138
diff changeset
  2230
    |newX newY rel inRect bw superWidth superHeight superLeft superTop |
claus
parents: 138
diff changeset
  2231
claus
parents: 138
diff changeset
  2232
    bw := borderWidth.
claus
parents: 138
diff changeset
  2233
claus
parents: 138
diff changeset
  2234
    superView isNil ifTrue:[
claus
parents: 138
diff changeset
  2235
	superWidth := device width + bw.      
claus
parents: 138
diff changeset
  2236
	superHeight := device height + bw.
claus
parents: 138
diff changeset
  2237
	superLeft := superTop := 0.
claus
parents: 138
diff changeset
  2238
    ] ifFalse:[
claus
parents: 138
diff changeset
  2239
	inRect := superView viewRectangle.
claus
parents: 138
diff changeset
  2240
	superWidth := inRect width.
claus
parents: 138
diff changeset
  2241
	superHeight := inRect height.
claus
parents: 138
diff changeset
  2242
	superLeft := inRect left.
claus
parents: 138
diff changeset
  2243
	superTop := inRect top.
claus
parents: 138
diff changeset
  2244
    ].
claus
parents: 138
diff changeset
  2245
claus
parents: 138
diff changeset
  2246
    rel := p x.
claus
parents: 138
diff changeset
  2247
    rel isInteger ifTrue:[
claus
parents: 138
diff changeset
  2248
	newX := rel
claus
parents: 138
diff changeset
  2249
    ] ifFalse:[
claus
parents: 138
diff changeset
  2250
	newX := (rel * superWidth) asInteger + superLeft.
claus
parents: 138
diff changeset
  2251
	(bw ~~ 0) ifTrue:[
claus
parents: 138
diff changeset
  2252
	    rel ~= 1.0 ifTrue:[
claus
parents: 138
diff changeset
  2253
		newX := newX - bw
claus
parents: 138
diff changeset
  2254
	    ]
claus
parents: 138
diff changeset
  2255
	]
claus
parents: 138
diff changeset
  2256
    ].
claus
parents: 138
diff changeset
  2257
claus
parents: 138
diff changeset
  2258
    rel := p y.
claus
parents: 138
diff changeset
  2259
    rel isInteger ifTrue:[
claus
parents: 138
diff changeset
  2260
	newY := rel
claus
parents: 138
diff changeset
  2261
    ] ifFalse:[
claus
parents: 138
diff changeset
  2262
	newY := (rel * superHeight) asInteger + superTop.
claus
parents: 138
diff changeset
  2263
	(bw ~~ 0) ifTrue:[
claus
parents: 138
diff changeset
  2264
	    rel ~= 1.0 ifTrue:[
claus
parents: 138
diff changeset
  2265
		newY := newY - bw
claus
parents: 138
diff changeset
  2266
	    ]
claus
parents: 138
diff changeset
  2267
	]
claus
parents: 138
diff changeset
  2268
    ].
claus
parents: 138
diff changeset
  2269
    ^ newX @ newY
claus
parents: 138
diff changeset
  2270
!
claus
parents: 138
diff changeset
  2271
claus
parents: 138
diff changeset
  2272
originFromRelativeOrigin
claus
parents: 138
diff changeset
  2273
    "compute & return pixel origin from relativeOrigin"
claus
parents: 138
diff changeset
  2274
claus
parents: 138
diff changeset
  2275
    ^ self originFromRelativeOrigin:relativeOrigin
claus
parents: 138
diff changeset
  2276
!
claus
parents: 138
diff changeset
  2277
claus
parents: 138
diff changeset
  2278
pixelCorner:corner
claus
parents: 138
diff changeset
  2279
    "set the views corner in pixels"
claus
parents: 138
diff changeset
  2280
claus
parents: 138
diff changeset
  2281
    |w h|
claus
parents: 138
diff changeset
  2282
180
claus
parents: 176
diff changeset
  2283
    w := corner x - left + 1.
claus
parents: 176
diff changeset
  2284
    h := corner y - top + 1.
140
claus
parents: 138
diff changeset
  2285
    self pixelOrigin:(left @ top) extent:(w @ h)
180
claus
parents: 176
diff changeset
  2286
claus
parents: 176
diff changeset
  2287
    "Modified: 31.8.1995 / 18:20:22 / claus"
140
claus
parents: 138
diff changeset
  2288
!
claus
parents: 138
diff changeset
  2289
claus
parents: 138
diff changeset
  2290
extentFromRelativeExtent:aPoint
claus
parents: 138
diff changeset
  2291
    "compute & return pixel extent from relativeExtent, aPoint"
claus
parents: 138
diff changeset
  2292
claus
parents: 138
diff changeset
  2293
    |rel newX newY inRect bw2 i|
claus
parents: 138
diff changeset
  2294
claus
parents: 138
diff changeset
  2295
    superView isNil ifTrue:[
claus
parents: 138
diff changeset
  2296
	inRect := 0@0 extent:device extent
claus
parents: 138
diff changeset
  2297
    ] ifFalse:[
claus
parents: 138
diff changeset
  2298
	inRect := superView viewRectangle.
claus
parents: 138
diff changeset
  2299
    ].
claus
parents: 138
diff changeset
  2300
claus
parents: 138
diff changeset
  2301
    bw2 := borderWidth * 2.
claus
parents: 138
diff changeset
  2302
claus
parents: 138
diff changeset
  2303
    rel := aPoint x.
175
claus
parents: 173
diff changeset
  2304
    rel isInteger ifFalse:[
140
claus
parents: 138
diff changeset
  2305
	newX := (rel * (inRect width + bw2)) asInteger + inRect left.
claus
parents: 138
diff changeset
  2306
	(borderWidth ~~ 0) ifTrue:[
claus
parents: 138
diff changeset
  2307
	    newX := newX - borderWidth
claus
parents: 138
diff changeset
  2308
	].
175
claus
parents: 173
diff changeset
  2309
    ] ifTrue:[
140
claus
parents: 138
diff changeset
  2310
	newX := rel
claus
parents: 138
diff changeset
  2311
    ].
claus
parents: 138
diff changeset
  2312
claus
parents: 138
diff changeset
  2313
    rel := aPoint y.
175
claus
parents: 173
diff changeset
  2314
    rel isInteger ifFalse:[
140
claus
parents: 138
diff changeset
  2315
	newY := (rel * (inRect height + bw2)) asInteger + inRect top.
claus
parents: 138
diff changeset
  2316
	(borderWidth ~~ 0) ifTrue:[
claus
parents: 138
diff changeset
  2317
	    newY := newY - borderWidth
claus
parents: 138
diff changeset
  2318
	].
175
claus
parents: 173
diff changeset
  2319
    ] ifTrue:[
140
claus
parents: 138
diff changeset
  2320
	newY := rel
claus
parents: 138
diff changeset
  2321
    ].
claus
parents: 138
diff changeset
  2322
claus
parents: 138
diff changeset
  2323
    insets notNil ifTrue:[
claus
parents: 138
diff changeset
  2324
	i := insets at:1.   "top"
claus
parents: 138
diff changeset
  2325
	(i  ~~ 0) ifTrue:[
claus
parents: 138
diff changeset
  2326
	    newX := newX - i
claus
parents: 138
diff changeset
  2327
	].
claus
parents: 138
diff changeset
  2328
	i := insets at:3.   "left"
claus
parents: 138
diff changeset
  2329
	(i  ~~ 0) ifTrue:[
claus
parents: 138
diff changeset
  2330
	    newX := newX - i
claus
parents: 138
diff changeset
  2331
	].
claus
parents: 138
diff changeset
  2332
	i := insets at:2.   "right"
claus
parents: 138
diff changeset
  2333
	(i ~~ 0) ifTrue:[
claus
parents: 138
diff changeset
  2334
	    newY := newY - i
claus
parents: 138
diff changeset
  2335
	].
claus
parents: 138
diff changeset
  2336
	i := insets at:4.   "bottom"
claus
parents: 138
diff changeset
  2337
	(i ~~ 0) ifTrue:[
claus
parents: 138
diff changeset
  2338
	    newY := newY - i
claus
parents: 138
diff changeset
  2339
	].
claus
parents: 138
diff changeset
  2340
    ].
claus
parents: 138
diff changeset
  2341
    ^ newX @ newY
claus
parents: 138
diff changeset
  2342
!
claus
parents: 138
diff changeset
  2343
claus
parents: 138
diff changeset
  2344
extentFromRelativeExtent
claus
parents: 138
diff changeset
  2345
    "compute & return pixel extent from relativeExtent"
claus
parents: 138
diff changeset
  2346
claus
parents: 138
diff changeset
  2347
    ^ self extentFromRelativeExtent:relativeExtent
claus
parents: 138
diff changeset
  2348
!
claus
parents: 138
diff changeset
  2349
claus
parents: 138
diff changeset
  2350
pixelOrigin:origin corner:corner
180
claus
parents: 176
diff changeset
  2351
    "set the views origin and corner in pixels"
140
claus
parents: 138
diff changeset
  2352
claus
parents: 138
diff changeset
  2353
    |w h|
claus
parents: 138
diff changeset
  2354
180
claus
parents: 176
diff changeset
  2355
    w := corner x - origin x + 1.
claus
parents: 176
diff changeset
  2356
    h := corner y - origin y + 1.
140
claus
parents: 138
diff changeset
  2357
    self pixelOrigin:origin extent:(w @ h)
180
claus
parents: 176
diff changeset
  2358
claus
parents: 176
diff changeset
  2359
    "Modified: 31.8.1995 / 18:24:16 / claus"
140
claus
parents: 138
diff changeset
  2360
!
claus
parents: 138
diff changeset
  2361
claus
parents: 138
diff changeset
  2362
setBorderColor
claus
parents: 138
diff changeset
  2363
    "set my borderColor"
claus
parents: 138
diff changeset
  2364
claus
parents: 138
diff changeset
  2365
    |id dither|
claus
parents: 138
diff changeset
  2366
claus
parents: 138
diff changeset
  2367
    drawableId notNil ifTrue:[
claus
parents: 138
diff changeset
  2368
	borderColor := borderColor on:device.
claus
parents: 138
diff changeset
  2369
	id := borderColor colorId.
claus
parents: 138
diff changeset
  2370
	id notNil ifTrue:[
claus
parents: 138
diff changeset
  2371
	    device setWindowBorderColor:id in:drawableId
claus
parents: 138
diff changeset
  2372
	] ifFalse:[
claus
parents: 138
diff changeset
  2373
	    dither := borderColor ditherForm.
claus
parents: 138
diff changeset
  2374
	    dither notNil ifTrue:[
claus
parents: 138
diff changeset
  2375
		device setWindowBorderPixmap:(dither id) in:drawableId
claus
parents: 138
diff changeset
  2376
	    ] ifFalse:[
145
claus
parents: 144
diff changeset
  2377
		'VIEW: bad borderColor' errorPrintNL
135
claus
parents:
diff changeset
  2378
	    ]
claus
parents:
diff changeset
  2379
	]
claus
parents:
diff changeset
  2380
    ]
claus
parents:
diff changeset
  2381
!
claus
parents:
diff changeset
  2382
140
claus
parents: 138
diff changeset
  2383
dimensionFromViewport
claus
parents: 138
diff changeset
  2384
    "define my origin/extend from viewport"
claus
parents: 138
diff changeset
  2385
claus
parents: 138
diff changeset
  2386
    |relW relH relX relY winW winH org ext|
claus
parents: 138
diff changeset
  2387
claus
parents: 138
diff changeset
  2388
    superView notNil ifTrue:[
claus
parents: 138
diff changeset
  2389
	superView window isNil ifTrue:[
claus
parents: 138
diff changeset
  2390
"
claus
parents: 138
diff changeset
  2391
	    v := superView.
claus
parents: 138
diff changeset
  2392
	    (v notNil and:[v window isNil]) whileTrue:[
claus
parents: 138
diff changeset
  2393
		v := v superview
claus
parents: 138
diff changeset
  2394
	    ].
claus
parents: 138
diff changeset
  2395
	    v notNil ifTrue:[
claus
parents: 138
diff changeset
  2396
		w := v window
claus
parents: 138
diff changeset
  2397
	    ].
claus
parents: 138
diff changeset
  2398
"
claus
parents: 138
diff changeset
  2399
"
claus
parents: 138
diff changeset
  2400
	    winW := 1.
claus
parents: 138
diff changeset
  2401
	    winH := 1
claus
parents: 138
diff changeset
  2402
"
claus
parents: 138
diff changeset
  2403
	    winW := superView width.
claus
parents: 138
diff changeset
  2404
	    winH := superView height.
claus
parents: 138
diff changeset
  2405
claus
parents: 138
diff changeset
  2406
	] ifFalse:[
claus
parents: 138
diff changeset
  2407
	    winW := superView window width.
claus
parents: 138
diff changeset
  2408
	    winH := superView window height
claus
parents: 138
diff changeset
  2409
	].
claus
parents: 138
diff changeset
  2410
	relW := (viewport width / winW) asFloat.
claus
parents: 138
diff changeset
  2411
	relH := (viewport height / winH) asFloat.
claus
parents: 138
diff changeset
  2412
	relX := (viewport left / winW) asFloat.
claus
parents: 138
diff changeset
  2413
	relY := (viewport top / winH) asFloat.
claus
parents: 138
diff changeset
  2414
	"bad coding style ... misuse other method"
claus
parents: 138
diff changeset
  2415
	relativeOrigin := (relX @ relY).
claus
parents: 138
diff changeset
  2416
	org := self originFromRelativeOrigin.
claus
parents: 138
diff changeset
  2417
	relativeOrigin := nil.
claus
parents: 138
diff changeset
  2418
claus
parents: 138
diff changeset
  2419
	"bad coding style ...misuse other method"
claus
parents: 138
diff changeset
  2420
	relativeExtent := (relW @ relH).
claus
parents: 138
diff changeset
  2421
	ext := self extentFromRelativeExtent.
claus
parents: 138
diff changeset
  2422
	relativeExtent := nil.
claus
parents: 138
diff changeset
  2423
claus
parents: 138
diff changeset
  2424
	self pixelOrigin:org extent:ext.
claus
parents: 138
diff changeset
  2425
    ]
claus
parents: 138
diff changeset
  2426
! !
claus
parents: 138
diff changeset
  2427
claus
parents: 138
diff changeset
  2428
!SimpleView methodsFor:'accessing-dimensions'!
claus
parents: 138
diff changeset
  2429
151
claus
parents: 145
diff changeset
  2430
layout
claus
parents: 145
diff changeset
  2431
    "return the layout object which controls my geometry.
claus
parents: 145
diff changeset
  2432
     Currently, this is nil in most cases, and my geometry is
claus
parents: 145
diff changeset
  2433
     defined by relativeOrigin/relativeCorner/relativeExtent,
claus
parents: 145
diff changeset
  2434
     originRule/extentRule/cornerRule and inset.
claus
parents: 145
diff changeset
  2435
     Applications should be changed to use layoutObjects,
claus
parents: 145
diff changeset
  2436
     since the above listed instance variables will vanish."
claus
parents: 145
diff changeset
  2437
claus
parents: 145
diff changeset
  2438
    ^ layout
claus
parents: 145
diff changeset
  2439
!
claus
parents: 145
diff changeset
  2440
157
claus
parents: 154
diff changeset
  2441
geometryLayout
claus
parents: 154
diff changeset
  2442
    "this method will vanish, as soon as all implementations of
claus
parents: 154
diff changeset
  2443
     #layout: are removed ...
claus
parents: 154
diff changeset
  2444
     (conflict for example in label>>layout:).
claus
parents: 154
diff changeset
  2445
     DO NOT USE #geometryLayout: in your code; it will be removed without
claus
parents: 154
diff changeset
  2446
     notice."
claus
parents: 154
diff changeset
  2447
claus
parents: 154
diff changeset
  2448
    ^ here layout
claus
parents: 154
diff changeset
  2449
!
claus
parents: 154
diff changeset
  2450
153
claus
parents: 151
diff changeset
  2451
geometryLayout:aLayoutObject
claus
parents: 151
diff changeset
  2452
    "this method will vanish, as soon as all implementations of
claus
parents: 151
diff changeset
  2453
     #layout: are removed ...
claus
parents: 151
diff changeset
  2454
     (conflict for example in label>>layout:).
claus
parents: 151
diff changeset
  2455
     DO NOT USE #geometryLayout: in your code; it will be removed without
claus
parents: 151
diff changeset
  2456
     notice."
claus
parents: 151
diff changeset
  2457
claus
parents: 151
diff changeset
  2458
    here layout:aLayoutObject
claus
parents: 151
diff changeset
  2459
!
claus
parents: 151
diff changeset
  2460
151
claus
parents: 145
diff changeset
  2461
layout:aLayoutObject
claus
parents: 145
diff changeset
  2462
    "set the layout object which controls my geometry.
claus
parents: 145
diff changeset
  2463
     Currently, this is almost nowhere used but views will be
claus
parents: 145
diff changeset
  2464
     incrementally changed to use this new geometry management."
claus
parents: 145
diff changeset
  2465
claus
parents: 145
diff changeset
  2466
    layout := aLayoutObject.
192
13a9d4bafa7e *** empty log message ***
claus
parents: 190
diff changeset
  2467
    superView isNil ifTrue:[
13a9d4bafa7e *** empty log message ***
claus
parents: 190
diff changeset
  2468
	originChanged := cornerChanged := extentChanged := true
13a9d4bafa7e *** empty log message ***
claus
parents: 190
diff changeset
  2469
    ] ifFalse:[
13a9d4bafa7e *** empty log message ***
claus
parents: 190
diff changeset
  2470
	self superViewChangedSize.
13a9d4bafa7e *** empty log message ***
claus
parents: 190
diff changeset
  2471
    ]
13a9d4bafa7e *** empty log message ***
claus
parents: 190
diff changeset
  2472
13a9d4bafa7e *** empty log message ***
claus
parents: 190
diff changeset
  2473
    "Modified: 19.9.1995 / 16:17:25 / claus"
151
claus
parents: 145
diff changeset
  2474
!
claus
parents: 145
diff changeset
  2475
140
claus
parents: 138
diff changeset
  2476
computeOrigin
151
claus
parents: 145
diff changeset
  2477
    "compute my origin; if I have a layoutObject, a relative origin
claus
parents: 145
diff changeset
  2478
     or blocks to evaluate, compute it now ..
claus
parents: 145
diff changeset
  2479
     Blocks may return relative values or nil; nil means: take current value.
claus
parents: 145
diff changeset
  2480
     Returns the origin point in device coordinates (pixels)."
140
claus
parents: 138
diff changeset
  2481
claus
parents: 138
diff changeset
  2482
    |newOrg x y|
claus
parents: 138
diff changeset
  2483
151
claus
parents: 145
diff changeset
  2484
    "
claus
parents: 145
diff changeset
  2485
     slowly migrating to use layoutObjects ...
claus
parents: 145
diff changeset
  2486
    "
claus
parents: 145
diff changeset
  2487
    layout notNil ifTrue:[
claus
parents: 145
diff changeset
  2488
	^ (layout rectangleRelativeTo:(superView viewRectangle)
claus
parents: 145
diff changeset
  2489
			    preferred:(self preferredBounds)) origin rounded
claus
parents: 145
diff changeset
  2490
    ].
claus
parents: 145
diff changeset
  2491
140
claus
parents: 138
diff changeset
  2492
    (originRule notNil) ifTrue:[
claus
parents: 138
diff changeset
  2493
	newOrg := originRule value.
claus
parents: 138
diff changeset
  2494
	"
claus
parents: 138
diff changeset
  2495
	 allow return of relative values ...
claus
parents: 138
diff changeset
  2496
	"
claus
parents: 138
diff changeset
  2497
	x := newOrg x.
claus
parents: 138
diff changeset
  2498
	y := newOrg y.
claus
parents: 138
diff changeset
  2499
	x isNil ifTrue:[x := self origin x].
claus
parents: 138
diff changeset
  2500
	y isNil ifTrue:[y := self origin y].
claus
parents: 138
diff changeset
  2501
	((x isInteger not) or:[y isInteger not]) ifTrue:[
claus
parents: 138
diff changeset
  2502
	    newOrg := self originFromRelativeOrigin:x@y.
claus
parents: 138
diff changeset
  2503
	]
claus
parents: 138
diff changeset
  2504
    ] ifFalse:[
claus
parents: 138
diff changeset
  2505
	(relativeOrigin notNil) ifTrue:[
claus
parents: 138
diff changeset
  2506
	    newOrg := self originFromRelativeOrigin:relativeOrigin.
claus
parents: 138
diff changeset
  2507
	] ifFalse:[
claus
parents: 138
diff changeset
  2508
	    ^ (left @ top).
claus
parents: 138
diff changeset
  2509
	].
claus
parents: 138
diff changeset
  2510
    ].
claus
parents: 138
diff changeset
  2511
    ^ newOrg
claus
parents: 138
diff changeset
  2512
!
claus
parents: 138
diff changeset
  2513
claus
parents: 138
diff changeset
  2514
computeExtent
151
claus
parents: 145
diff changeset
  2515
    "compute my extent; if I have a layoutObject, a relative extent 
claus
parents: 145
diff changeset
  2516
     or blocks to evaluate, compute it now ..
140
claus
parents: 138
diff changeset
  2517
     There is one catch here, if the dimension was defined
claus
parents: 138
diff changeset
  2518
     by origin/corner, compute them here and take that value.
151
claus
parents: 145
diff changeset
  2519
     I.e. origin/corner definition has precedence over extent definition.
claus
parents: 145
diff changeset
  2520
     Returns the extent in device coordinates (pixels)."
140
claus
parents: 138
diff changeset
  2521
claus
parents: 138
diff changeset
  2522
    |newOrg newExt newCorner x y|
claus
parents: 138
diff changeset
  2523
151
claus
parents: 145
diff changeset
  2524
    "
claus
parents: 145
diff changeset
  2525
     slowly migrating to use layoutObjects ...
claus
parents: 145
diff changeset
  2526
    "
claus
parents: 145
diff changeset
  2527
    layout notNil ifTrue:[
claus
parents: 145
diff changeset
  2528
	^ (layout rectangleRelativeTo:(superView viewRectangle)
claus
parents: 145
diff changeset
  2529
			    preferred:(self preferredBounds)) extent rounded
claus
parents: 145
diff changeset
  2530
    ].
claus
parents: 145
diff changeset
  2531
140
claus
parents: 138
diff changeset
  2532
    (cornerRule notNil) ifTrue:[
claus
parents: 138
diff changeset
  2533
	newCorner := cornerRule value.
claus
parents: 138
diff changeset
  2534
	"
claus
parents: 138
diff changeset
  2535
	 allow return of relative values ...
claus
parents: 138
diff changeset
  2536
	"
claus
parents: 138
diff changeset
  2537
	x := newCorner x.
claus
parents: 138
diff changeset
  2538
	y := newCorner y.
claus
parents: 138
diff changeset
  2539
	x isNil ifTrue:[x := self corner x].
claus
parents: 138
diff changeset
  2540
	y isNil ifTrue:[y := self corner y].
claus
parents: 138
diff changeset
  2541
	((x isInteger not) or:[y isInteger not]) ifTrue:[
claus
parents: 138
diff changeset
  2542
	    newCorner := self cornerFromRelativeCorner:x@y
claus
parents: 138
diff changeset
  2543
	]
claus
parents: 138
diff changeset
  2544
    ] ifFalse:[
claus
parents: 138
diff changeset
  2545
	(relativeCorner notNil) ifTrue:[
claus
parents: 138
diff changeset
  2546
	    newCorner := self cornerFromRelativeCorner:relativeCorner
claus
parents: 138
diff changeset
  2547
	] ifFalse:[
claus
parents: 138
diff changeset
  2548
	    (extentRule notNil) ifTrue:[
claus
parents: 138
diff changeset
  2549
		newExt := extentRule value.
claus
parents: 138
diff changeset
  2550
		"
claus
parents: 138
diff changeset
  2551
		 allow return of relative values ...
claus
parents: 138
diff changeset
  2552
		"
claus
parents: 138
diff changeset
  2553
		x := newExt x.
claus
parents: 138
diff changeset
  2554
		y := newExt y.
claus
parents: 138
diff changeset
  2555
		x isNil ifTrue:[x := width].
claus
parents: 138
diff changeset
  2556
		y isNil ifTrue:[y := height].
claus
parents: 138
diff changeset
  2557
		((x isInteger not) or:[y isInteger not]) ifTrue:[
claus
parents: 138
diff changeset
  2558
		    newExt := self extentFromRelativeExtent:x@y
claus
parents: 138
diff changeset
  2559
		]
claus
parents: 138
diff changeset
  2560
	    ] ifFalse:[
claus
parents: 138
diff changeset
  2561
		(relativeExtent notNil) ifTrue:[
claus
parents: 138
diff changeset
  2562
		    newExt := self extentFromRelativeExtent:relativeExtent
claus
parents: 138
diff changeset
  2563
		] ifFalse:[
claus
parents: 138
diff changeset
  2564
		    newExt := (width @ height).
claus
parents: 138
diff changeset
  2565
		].
claus
parents: 138
diff changeset
  2566
	    ].
claus
parents: 138
diff changeset
  2567
	].
claus
parents: 138
diff changeset
  2568
    ].
claus
parents: 138
diff changeset
  2569
claus
parents: 138
diff changeset
  2570
    newCorner notNil ifTrue:[
claus
parents: 138
diff changeset
  2571
	newOrg := self computeOrigin.
claus
parents: 138
diff changeset
  2572
	^ newCorner - newOrg.
claus
parents: 138
diff changeset
  2573
    ].
claus
parents: 138
diff changeset
  2574
    ^ newExt.
claus
parents: 138
diff changeset
  2575
!
claus
parents: 138
diff changeset
  2576
claus
parents: 138
diff changeset
  2577
extent:extent
151
claus
parents: 145
diff changeset
  2578
    "set the views extent; 
claus
parents: 145
diff changeset
  2579
     extent may be:
claus
parents: 145
diff changeset
  2580
	a point 
claus
parents: 145
diff changeset
  2581
	    where integer fields mean 'pixel-values'
claus
parents: 145
diff changeset
  2582
	    and float values mean 'relative-to-superview'
claus
parents: 145
diff changeset
  2583
	    and nil means 'leave current value';
claus
parents: 145
diff changeset
  2584
     or a block returning a point which is interpreted as above.
claus
parents: 145
diff changeset
  2585
     Be careful when using relative extents: rounding errors may
claus
parents: 145
diff changeset
  2586
     accumulate. Better use origin/corner. 
claus
parents: 145
diff changeset
  2587
     Best: migrate to use layour objects."
140
claus
parents: 138
diff changeset
  2588
claus
parents: 138
diff changeset
  2589
    |w h pixelExtent e|
claus
parents: 138
diff changeset
  2590
claus
parents: 138
diff changeset
  2591
    extent isBlock ifTrue:[
claus
parents: 138
diff changeset
  2592
	extentRule := extent.
claus
parents: 138
diff changeset
  2593
	drawableId notNil ifTrue:[
claus
parents: 138
diff changeset
  2594
	    pixelExtent := extent value
claus
parents: 138
diff changeset
  2595
	] ifFalse:[
claus
parents: 138
diff changeset
  2596
	    extentChanged := true
claus
parents: 138
diff changeset
  2597
	]
claus
parents: 138
diff changeset
  2598
    ] ifFalse:[
claus
parents: 138
diff changeset
  2599
	w := extent x.
claus
parents: 138
diff changeset
  2600
	h := extent y.
claus
parents: 138
diff changeset
  2601
	w isNil ifTrue:[w := width].
claus
parents: 138
diff changeset
  2602
	h isNil ifTrue:[h := height].
claus
parents: 138
diff changeset
  2603
	e := w@h.
claus
parents: 138
diff changeset
  2604
	((w isInteger not) or:[h isInteger not]) ifTrue:[
claus
parents: 138
diff changeset
  2605
	    relativeExtent := e.
claus
parents: 138
diff changeset
  2606
	    pixelExtent := self extentFromRelativeExtent.
claus
parents: 138
diff changeset
  2607
	    pixelExtent isNil ifTrue:[
claus
parents: 138
diff changeset
  2608
		extentChanged := true
claus
parents: 138
diff changeset
  2609
	    ]
claus
parents: 138
diff changeset
  2610
	] ifFalse:[
claus
parents: 138
diff changeset
  2611
	    pixelExtent := e
claus
parents: 138
diff changeset
  2612
	]
claus
parents: 138
diff changeset
  2613
    ].
claus
parents: 138
diff changeset
  2614
    pixelExtent notNil ifTrue:[
claus
parents: 138
diff changeset
  2615
	self pixelExtent:pixelExtent
claus
parents: 138
diff changeset
  2616
    ]
claus
parents: 138
diff changeset
  2617
!
claus
parents: 138
diff changeset
  2618
claus
parents: 138
diff changeset
  2619
origin:origin
151
claus
parents: 145
diff changeset
  2620
    "set the views origin; 
claus
parents: 145
diff changeset
  2621
     origin may be:
claus
parents: 145
diff changeset
  2622
	a point 
claus
parents: 145
diff changeset
  2623
	    where integer fields mean 'pixel-values'
claus
parents: 145
diff changeset
  2624
	    and float values mean 'relative-to-superview'
claus
parents: 145
diff changeset
  2625
	    and nil means 'take current value';
claus
parents: 145
diff changeset
  2626
     or a block returning a point which is interpreted as above.
claus
parents: 145
diff changeset
  2627
     Please migrate to use layout objects."
140
claus
parents: 138
diff changeset
  2628
claus
parents: 138
diff changeset
  2629
    |newLeft newTop pixelOrigin o|
claus
parents: 138
diff changeset
  2630
claus
parents: 138
diff changeset
  2631
    origin isBlock ifTrue:[
claus
parents: 138
diff changeset
  2632
	originRule := origin.
claus
parents: 138
diff changeset
  2633
	drawableId notNil ifTrue:[
claus
parents: 138
diff changeset
  2634
	    pixelOrigin := origin value
claus
parents: 138
diff changeset
  2635
	] ifFalse:[
claus
parents: 138
diff changeset
  2636
	    originChanged := true
claus
parents: 138
diff changeset
  2637
	]
claus
parents: 138
diff changeset
  2638
    ] ifFalse:[
claus
parents: 138
diff changeset
  2639
	o := origin.
claus
parents: 138
diff changeset
  2640
	newLeft := origin x.
claus
parents: 138
diff changeset
  2641
	newTop := origin y.
claus
parents: 138
diff changeset
  2642
	newLeft isNil ifTrue:[newLeft := left].
claus
parents: 138
diff changeset
  2643
	newTop isNil ifTrue:[newTop := top].
claus
parents: 138
diff changeset
  2644
	o := newLeft @ newTop.
claus
parents: 138
diff changeset
  2645
	((newLeft isInteger not) or:[newTop isInteger not]) ifTrue:[
claus
parents: 138
diff changeset
  2646
	    relativeOrigin := o.
claus
parents: 138
diff changeset
  2647
	    pixelOrigin := self originFromRelativeOrigin.
claus
parents: 138
diff changeset
  2648
	    pixelOrigin isNil ifTrue:[
claus
parents: 138
diff changeset
  2649
		originChanged := true
claus
parents: 138
diff changeset
  2650
	    ]
claus
parents: 138
diff changeset
  2651
	] ifFalse:[
claus
parents: 138
diff changeset
  2652
	    pixelOrigin := o
claus
parents: 138
diff changeset
  2653
	]
claus
parents: 138
diff changeset
  2654
    ].
claus
parents: 138
diff changeset
  2655
    pixelOrigin notNil ifTrue:[
claus
parents: 138
diff changeset
  2656
	self pixelOrigin:pixelOrigin
claus
parents: 138
diff changeset
  2657
    ].
claus
parents: 138
diff changeset
  2658
!
claus
parents: 138
diff changeset
  2659
claus
parents: 138
diff changeset
  2660
top
claus
parents: 138
diff changeset
  2661
    "return the y position of the top border"
claus
parents: 138
diff changeset
  2662
claus
parents: 138
diff changeset
  2663
    ^ top
claus
parents: 138
diff changeset
  2664
!
claus
parents: 138
diff changeset
  2665
claus
parents: 138
diff changeset
  2666
origin
claus
parents: 138
diff changeset
  2667
    "return the origin (in pixels)"
claus
parents: 138
diff changeset
  2668
claus
parents: 138
diff changeset
  2669
    ^ left@top
claus
parents: 138
diff changeset
  2670
!
claus
parents: 138
diff changeset
  2671
claus
parents: 138
diff changeset
  2672
height:aNumber
claus
parents: 138
diff changeset
  2673
    "set the views height in pixels"
claus
parents: 138
diff changeset
  2674
claus
parents: 138
diff changeset
  2675
    self extent:(width @ aNumber)
claus
parents: 138
diff changeset
  2676
!
claus
parents: 138
diff changeset
  2677
claus
parents: 138
diff changeset
  2678
innerWidth
claus
parents: 138
diff changeset
  2679
    "return the width of the view minus any 3D-shadow-borders"
claus
parents: 138
diff changeset
  2680
claus
parents: 138
diff changeset
  2681
    (level == 0) ifTrue:[^ width].
claus
parents: 138
diff changeset
  2682
    ^ width - (2 * margin)
claus
parents: 138
diff changeset
  2683
!
claus
parents: 138
diff changeset
  2684
claus
parents: 138
diff changeset
  2685
corner:corner 
151
claus
parents: 145
diff changeset
  2686
    "set the views corner; 
claus
parents: 145
diff changeset
  2687
     the corner argument may be:
claus
parents: 145
diff changeset
  2688
	 a point 
claus
parents: 145
diff changeset
  2689
	    where integer fields mean 'pixel-values'
claus
parents: 145
diff changeset
  2690
	    and float values mean 'relative-to-superview'
claus
parents: 145
diff changeset
  2691
	    and nil means 'take current value';
claus
parents: 145
diff changeset
  2692
     or a block returning a point which is interpreted as above.
claus
parents: 145
diff changeset
  2693
     Please migrate to use layoutObjects, if possible."
140
claus
parents: 138
diff changeset
  2694
claus
parents: 138
diff changeset
  2695
    |x y pixelCorner c|
claus
parents: 138
diff changeset
  2696
claus
parents: 138
diff changeset
  2697
    corner isBlock ifTrue:[
claus
parents: 138
diff changeset
  2698
	cornerRule := corner.
claus
parents: 138
diff changeset
  2699
	drawableId notNil ifTrue:[    
claus
parents: 138
diff changeset
  2700
	    pixelCorner := corner value
claus
parents: 138
diff changeset
  2701
	] ifFalse:[
claus
parents: 138
diff changeset
  2702
	    extentChanged := true
claus
parents: 138
diff changeset
  2703
	]
claus
parents: 138
diff changeset
  2704
    ] ifFalse:[
claus
parents: 138
diff changeset
  2705
	x := corner x.
claus
parents: 138
diff changeset
  2706
	y := corner y.
claus
parents: 138
diff changeset
  2707
	x isNil ifTrue:[x := self corner x].
claus
parents: 138
diff changeset
  2708
	y isNil ifTrue:[y := self corner y].
claus
parents: 138
diff changeset
  2709
	c := x @ y.
claus
parents: 138
diff changeset
  2710
	((x isInteger not) or:[y isInteger not]) ifTrue:[
claus
parents: 138
diff changeset
  2711
	    relativeCorner := c.
claus
parents: 138
diff changeset
  2712
	    pixelCorner := self cornerFromRelativeCorner.
claus
parents: 138
diff changeset
  2713
	    pixelCorner isNil ifTrue:[
claus
parents: 138
diff changeset
  2714
		extentChanged := true
claus
parents: 138
diff changeset
  2715
	    ]
claus
parents: 138
diff changeset
  2716
	] ifFalse:[
claus
parents: 138
diff changeset
  2717
	    pixelCorner := c
claus
parents: 138
diff changeset
  2718
	]
claus
parents: 138
diff changeset
  2719
    ].
claus
parents: 138
diff changeset
  2720
claus
parents: 138
diff changeset
  2721
    pixelCorner notNil ifTrue:[
claus
parents: 138
diff changeset
  2722
	self pixelCorner:pixelCorner
claus
parents: 138
diff changeset
  2723
    ]
claus
parents: 138
diff changeset
  2724
!
claus
parents: 138
diff changeset
  2725
claus
parents: 138
diff changeset
  2726
origin:origin extent:extent
claus
parents: 138
diff changeset
  2727
    "set both origin and extent"
claus
parents: 138
diff changeset
  2728
claus
parents: 138
diff changeset
  2729
    |newLeft newTop newWidth newHeight|
claus
parents: 138
diff changeset
  2730
claus
parents: 138
diff changeset
  2731
    "do it as one operation if possible"
claus
parents: 138
diff changeset
  2732
claus
parents: 138
diff changeset
  2733
    origin isBlock ifFalse:[
claus
parents: 138
diff changeset
  2734
	extent isBlock ifFalse:[
claus
parents: 138
diff changeset
  2735
	    newLeft := origin x.
151
claus
parents: 145
diff changeset
  2736
	    newLeft isInteger ifTrue:[
140
claus
parents: 138
diff changeset
  2737
		newTop := origin y.
151
claus
parents: 145
diff changeset
  2738
		newTop isInteger ifTrue:[
140
claus
parents: 138
diff changeset
  2739
		    newWidth := extent x.
151
claus
parents: 145
diff changeset
  2740
		    newWidth isInteger ifTrue:[
140
claus
parents: 138
diff changeset
  2741
			newHeight := extent y.
151
claus
parents: 145
diff changeset
  2742
			newHeight isInteger ifTrue:[
140
claus
parents: 138
diff changeset
  2743
			    self pixelOrigin:origin extent:extent
claus
parents: 138
diff changeset
  2744
			]
claus
parents: 138
diff changeset
  2745
		    ]
claus
parents: 138
diff changeset
  2746
		]
claus
parents: 138
diff changeset
  2747
	    ]
claus
parents: 138
diff changeset
  2748
	]
claus
parents: 138
diff changeset
  2749
    ].
claus
parents: 138
diff changeset
  2750
    self extent:extent.
claus
parents: 138
diff changeset
  2751
    self origin:origin
claus
parents: 138
diff changeset
  2752
!
claus
parents: 138
diff changeset
  2753
claus
parents: 138
diff changeset
  2754
origin:origin corner:corner 
claus
parents: 138
diff changeset
  2755
    "set both origin and extent"
claus
parents: 138
diff changeset
  2756
claus
parents: 138
diff changeset
  2757
    |newLeft newTop newRight newBot|
claus
parents: 138
diff changeset
  2758
claus
parents: 138
diff changeset
  2759
    "do it as one operation if possible"
claus
parents: 138
diff changeset
  2760
claus
parents: 138
diff changeset
  2761
    origin isBlock ifFalse:[
claus
parents: 138
diff changeset
  2762
	corner isBlock ifFalse:[
claus
parents: 138
diff changeset
  2763
	    newLeft := origin x.
175
claus
parents: 173
diff changeset
  2764
	    newLeft isInteger ifTrue:[
140
claus
parents: 138
diff changeset
  2765
		newTop := origin y.
175
claus
parents: 173
diff changeset
  2766
		newTop isInteger ifTrue:[
140
claus
parents: 138
diff changeset
  2767
		    newRight := corner x.
175
claus
parents: 173
diff changeset
  2768
		    newRight isInteger ifTrue:[
140
claus
parents: 138
diff changeset
  2769
			newBot := corner y.
175
claus
parents: 173
diff changeset
  2770
			newBot isInteger ifTrue:[
140
claus
parents: 138
diff changeset
  2771
			    self pixelOrigin:origin corner:corner 
claus
parents: 138
diff changeset
  2772
			]
claus
parents: 138
diff changeset
  2773
		    ]
claus
parents: 138
diff changeset
  2774
		]
claus
parents: 138
diff changeset
  2775
	    ]
135
claus
parents:
diff changeset
  2776
	]
claus
parents:
diff changeset
  2777
    ].
140
claus
parents: 138
diff changeset
  2778
    self origin:origin.
claus
parents: 138
diff changeset
  2779
    self corner:corner 
claus
parents: 138
diff changeset
  2780
!
claus
parents: 138
diff changeset
  2781
claus
parents: 138
diff changeset
  2782
relativeCorner
claus
parents: 138
diff changeset
  2783
    "return the relative corner or nil"
claus
parents: 138
diff changeset
  2784
claus
parents: 138
diff changeset
  2785
    ^ relativeCorner
claus
parents: 138
diff changeset
  2786
!
claus
parents: 138
diff changeset
  2787
claus
parents: 138
diff changeset
  2788
makeFullyVisible
claus
parents: 138
diff changeset
  2789
    "make sure, that the view is fully visible by shifting it
claus
parents: 138
diff changeset
  2790
     into the visible screen area if nescessary.
claus
parents: 138
diff changeset
  2791
     This method will be moved to StandardSystemView ..."
claus
parents: 138
diff changeset
  2792
227
df0916a17ea2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 226
diff changeset
  2793
    |devBot devRight newTop newLeft|
226
a953669c1ffe makeFullyVisible (fixed ?)
Claus Gittinger <cg@exept.de>
parents: 222
diff changeset
  2794
a953669c1ffe makeFullyVisible (fixed ?)
Claus Gittinger <cg@exept.de>
parents: 222
diff changeset
  2795
    newTop := top.
a953669c1ffe makeFullyVisible (fixed ?)
Claus Gittinger <cg@exept.de>
parents: 222
diff changeset
  2796
    newLeft := left.
a953669c1ffe makeFullyVisible (fixed ?)
Claus Gittinger <cg@exept.de>
parents: 222
diff changeset
  2797
227
df0916a17ea2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 226
diff changeset
  2798
    ((top + height) > (devBot := device height)) ifTrue:[
226
a953669c1ffe makeFullyVisible (fixed ?)
Claus Gittinger <cg@exept.de>
parents: 222
diff changeset
  2799
	newTop := devBot - height
140
claus
parents: 138
diff changeset
  2800
    ].
227
df0916a17ea2 *** empty log message ***
Claus Gittinger <cg@exept.de>
parents: 226
diff changeset
  2801
    ((left + width) > (devRight := device width)) ifTrue:[
226
a953669c1ffe makeFullyVisible (fixed ?)
Claus Gittinger <cg@exept.de>
parents: 222
diff changeset
  2802
	newLeft := devRight - width
a953669c1ffe makeFullyVisible (fixed ?)
Claus Gittinger <cg@exept.de>
parents: 222
diff changeset
  2803
    ].
a953669c1ffe makeFullyVisible (fixed ?)
Claus Gittinger <cg@exept.de>
parents: 222
diff changeset
  2804
    (newTop < 0) ifTrue:[
a953669c1ffe makeFullyVisible (fixed ?)
Claus Gittinger <cg@exept.de>
parents: 222
diff changeset
  2805
	newTop := 0.
140
claus
parents: 138
diff changeset
  2806
    ].
226
a953669c1ffe makeFullyVisible (fixed ?)
Claus Gittinger <cg@exept.de>
parents: 222
diff changeset
  2807
    (newLeft < 0) ifTrue:[
a953669c1ffe makeFullyVisible (fixed ?)
Claus Gittinger <cg@exept.de>
parents: 222
diff changeset
  2808
	newLeft := 0
140
claus
parents: 138
diff changeset
  2809
    ].
226
a953669c1ffe makeFullyVisible (fixed ?)
Claus Gittinger <cg@exept.de>
parents: 222
diff changeset
  2810
    ((newTop ~~ top) or:[newLeft ~~ left]) ifTrue:[
a953669c1ffe makeFullyVisible (fixed ?)
Claus Gittinger <cg@exept.de>
parents: 222
diff changeset
  2811
	self origin:newLeft @ newTop
a953669c1ffe makeFullyVisible (fixed ?)
Claus Gittinger <cg@exept.de>
parents: 222
diff changeset
  2812
    ]
140
claus
parents: 138
diff changeset
  2813
!
claus
parents: 138
diff changeset
  2814
157
claus
parents: 154
diff changeset
  2815
width:aNumber
claus
parents: 154
diff changeset
  2816
    "set the views width in pixels"
claus
parents: 154
diff changeset
  2817
claus
parents: 154
diff changeset
  2818
    self extent:(aNumber @ height)
claus
parents: 154
diff changeset
  2819
!
claus
parents: 154
diff changeset
  2820
claus
parents: 154
diff changeset
  2821
inset:aNumber
claus
parents: 154
diff changeset
  2822
    "set all insets; positive makes the view smaller,
claus
parents: 154
diff changeset
  2823
     negative makes it larger."
claus
parents: 154
diff changeset
  2824
claus
parents: 154
diff changeset
  2825
    self allInset:aNumber
claus
parents: 154
diff changeset
  2826
!
claus
parents: 154
diff changeset
  2827
153
claus
parents: 151
diff changeset
  2828
allInset:aNumber
157
claus
parents: 154
diff changeset
  2829
    "set all insets; positive makes the view smaller,
claus
parents: 154
diff changeset
  2830
     negative makes it larger."
153
claus
parents: 151
diff changeset
  2831
claus
parents: 151
diff changeset
  2832
    insets isNil ifTrue:[
claus
parents: 151
diff changeset
  2833
	insets := Array new:4.
claus
parents: 151
diff changeset
  2834
    ].
claus
parents: 151
diff changeset
  2835
    insets atAllPut:aNumber.
claus
parents: 151
diff changeset
  2836
claus
parents: 151
diff changeset
  2837
    "force recomputation"
180
claus
parents: 176
diff changeset
  2838
"/    drawableId isNil ifTrue:[
claus
parents: 176
diff changeset
  2839
"/        originChanged := true
claus
parents: 176
diff changeset
  2840
"/    ] ifFalse:[
claus
parents: 176
diff changeset
  2841
	self superViewChangedSize.
claus
parents: 176
diff changeset
  2842
"/    ]
153
claus
parents: 151
diff changeset
  2843
!
claus
parents: 151
diff changeset
  2844
157
claus
parents: 154
diff changeset
  2845
horizontalInset:aNumber
claus
parents: 154
diff changeset
  2846
    "set the insets of the left/right edge; 
claus
parents: 154
diff changeset
  2847
     positive makes it smaller, negative makes it larger"
claus
parents: 154
diff changeset
  2848
claus
parents: 154
diff changeset
  2849
    insets isNil ifTrue:[
160
claus
parents: 157
diff changeset
  2850
	insets := Array with:0 with:0 with:0 with:0
157
claus
parents: 154
diff changeset
  2851
    ].
claus
parents: 154
diff changeset
  2852
    insets at:1 put:aNumber.
claus
parents: 154
diff changeset
  2853
    insets at:3 put:aNumber.
claus
parents: 154
diff changeset
  2854
claus
parents: 154
diff changeset
  2855
    "force recomputation"
180
claus
parents: 176
diff changeset
  2856
"/    drawableId isNil ifTrue:[
claus
parents: 176
diff changeset
  2857
"/        originChanged := true
claus
parents: 176
diff changeset
  2858
"/    ] ifFalse:[
claus
parents: 176
diff changeset
  2859
	self superViewChangedSize.
claus
parents: 176
diff changeset
  2860
"/    ]
157
claus
parents: 154
diff changeset
  2861
!
claus
parents: 154
diff changeset
  2862
claus
parents: 154
diff changeset
  2863
verticalInset:aNumber
claus
parents: 154
diff changeset
  2864
    "set the insets of the top/bottom edge; 
claus
parents: 154
diff changeset
  2865
     positive makes it smaller, negative makes it larger"
claus
parents: 154
diff changeset
  2866
claus
parents: 154
diff changeset
  2867
    insets isNil ifTrue:[
160
claus
parents: 157
diff changeset
  2868
	insets := Array with:0 with:0 with:0 with:0
157
claus
parents: 154
diff changeset
  2869
    ].
claus
parents: 154
diff changeset
  2870
    insets at:2 put:aNumber.
claus
parents: 154
diff changeset
  2871
    insets at:4 put:aNumber.
claus
parents: 154
diff changeset
  2872
claus
parents: 154
diff changeset
  2873
    "force recomputation"
180
claus
parents: 176
diff changeset
  2874
"/    drawableId isNil ifTrue:[
claus
parents: 176
diff changeset
  2875
"/        originChanged := true
claus
parents: 176
diff changeset
  2876
"/    ] ifFalse:[
claus
parents: 176
diff changeset
  2877
	self superViewChangedSize.
claus
parents: 176
diff changeset
  2878
"/    ]
157
claus
parents: 154
diff changeset
  2879
!
claus
parents: 154
diff changeset
  2880
claus
parents: 154
diff changeset
  2881
rightInset:aNumber
claus
parents: 154
diff changeset
  2882
    "set the inset of the right edge; 
claus
parents: 154
diff changeset
  2883
     positive is to the left (view becomes smaller), 
claus
parents: 154
diff changeset
  2884
     negative to the right (becomes larger)"
claus
parents: 154
diff changeset
  2885
claus
parents: 154
diff changeset
  2886
    insets isNil ifTrue:[
160
claus
parents: 157
diff changeset
  2887
	insets := Array with:0 with:0 with:0 with:0
157
claus
parents: 154
diff changeset
  2888
    ].
claus
parents: 154
diff changeset
  2889
    insets at:3 put:aNumber.
claus
parents: 154
diff changeset
  2890
claus
parents: 154
diff changeset
  2891
    "force recomputation"
180
claus
parents: 176
diff changeset
  2892
"/    drawableId isNil ifTrue:[
claus
parents: 176
diff changeset
  2893
"/        originChanged := true
claus
parents: 176
diff changeset
  2894
"/    ] ifFalse:[
claus
parents: 176
diff changeset
  2895
	self superViewChangedSize.
claus
parents: 176
diff changeset
  2896
"/    ]
157
claus
parents: 154
diff changeset
  2897
!
claus
parents: 154
diff changeset
  2898
140
claus
parents: 138
diff changeset
  2899
leftInset:aNumber
157
claus
parents: 154
diff changeset
  2900
    "set the inset of the left edge; 
claus
parents: 154
diff changeset
  2901
     positive is to the right (view becomes smaller),
claus
parents: 154
diff changeset
  2902
     negative to the left (becomes larger)"
140
claus
parents: 138
diff changeset
  2903
claus
parents: 138
diff changeset
  2904
    insets isNil ifTrue:[
160
claus
parents: 157
diff changeset
  2905
	insets := Array with:0 with:0 with:0 with:0
140
claus
parents: 138
diff changeset
  2906
    ].
claus
parents: 138
diff changeset
  2907
    insets at:1 put:aNumber.
claus
parents: 138
diff changeset
  2908
claus
parents: 138
diff changeset
  2909
    "force recomputation"
180
claus
parents: 176
diff changeset
  2910
"/    drawableId isNil ifTrue:[
claus
parents: 176
diff changeset
  2911
"/        originChanged := true
claus
parents: 176
diff changeset
  2912
"/    ] ifFalse:[
claus
parents: 176
diff changeset
  2913
	self superViewChangedSize.
claus
parents: 176
diff changeset
  2914
"/    ]
140
claus
parents: 138
diff changeset
  2915
!
claus
parents: 138
diff changeset
  2916
claus
parents: 138
diff changeset
  2917
topInset:aNumber
157
claus
parents: 154
diff changeset
  2918
    "set the inset of the top edge; 
claus
parents: 154
diff changeset
  2919
     positive is to the bottom (view becomes smaller),
claus
parents: 154
diff changeset
  2920
     negative to the top (becomes larger)"
140
claus
parents: 138
diff changeset
  2921
claus
parents: 138
diff changeset
  2922
    insets isNil ifTrue:[
160
claus
parents: 157
diff changeset
  2923
	insets := Array with:0 with:0 with:0 with:0
140
claus
parents: 138
diff changeset
  2924
    ].
claus
parents: 138
diff changeset
  2925
    insets at:2 put:aNumber.
claus
parents: 138
diff changeset
  2926
claus
parents: 138
diff changeset
  2927
    "force recomputation"
180
claus
parents: 176
diff changeset
  2928
"/    drawableId isNil ifTrue:[
claus
parents: 176
diff changeset
  2929
"/        originChanged := true
claus
parents: 176
diff changeset
  2930
"/    ] ifFalse:[
claus
parents: 176
diff changeset
  2931
	self superViewChangedSize.
claus
parents: 176
diff changeset
  2932
"/    ]
140
claus
parents: 138
diff changeset
  2933
!
claus
parents: 138
diff changeset
  2934
157
claus
parents: 154
diff changeset
  2935
bottomInset:aNumber
claus
parents: 154
diff changeset
  2936
    "set the inset of the bottom edge; 
claus
parents: 154
diff changeset
  2937
     positive is to the top (view becomes smaller),
claus
parents: 154
diff changeset
  2938
     negative to the bottom (becomes larger)"
claus
parents: 154
diff changeset
  2939
claus
parents: 154
diff changeset
  2940
    insets isNil ifTrue:[
160
claus
parents: 157
diff changeset
  2941
	insets := Array with:0 with:0 with:0 with:0
157
claus
parents: 154
diff changeset
  2942
    ].
claus
parents: 154
diff changeset
  2943
    insets at:4 put:aNumber.
claus
parents: 154
diff changeset
  2944
claus
parents: 154
diff changeset
  2945
    "force recomputation"
180
claus
parents: 176
diff changeset
  2946
"/    drawableId isNil ifTrue:[
claus
parents: 176
diff changeset
  2947
"/        originChanged := true
claus
parents: 176
diff changeset
  2948
"/    ] ifFalse:[
157
claus
parents: 154
diff changeset
  2949
	self superViewChangedSize
180
claus
parents: 176
diff changeset
  2950
"/    ]
157
claus
parents: 154
diff changeset
  2951
!
claus
parents: 154
diff changeset
  2952
140
claus
parents: 138
diff changeset
  2953
left:aNumber
claus
parents: 138
diff changeset
  2954
    "set the x position"
claus
parents: 138
diff changeset
  2955
claus
parents: 138
diff changeset
  2956
    self origin:(aNumber @ top)
claus
parents: 138
diff changeset
  2957
!
claus
parents: 138
diff changeset
  2958
claus
parents: 138
diff changeset
  2959
relativeOrigin
claus
parents: 138
diff changeset
  2960
    "return the relative origin or nil"
claus
parents: 138
diff changeset
  2961
claus
parents: 138
diff changeset
  2962
    ^ relativeOrigin
claus
parents: 138
diff changeset
  2963
!
claus
parents: 138
diff changeset
  2964
claus
parents: 138
diff changeset
  2965
innerHeight
claus
parents: 138
diff changeset
  2966
    "return the height of the view minus any 3D-shadow-borders"
claus
parents: 138
diff changeset
  2967
claus
parents: 138
diff changeset
  2968
    (margin == 0) ifTrue:[^ height].
claus
parents: 138
diff changeset
  2969
    ^ height - (2 * margin)
claus
parents: 138
diff changeset
  2970
!
claus
parents: 138
diff changeset
  2971
153
claus
parents: 151
diff changeset
  2972
heightIncludingBorder
claus
parents: 151
diff changeset
  2973
    "return my height including border 
claus
parents: 151
diff changeset
  2974
     (this is my height as seen from the outside view;
claus
parents: 151
diff changeset
  2975
      while #height returns the height as seen by myself)"
claus
parents: 151
diff changeset
  2976
claus
parents: 151
diff changeset
  2977
    ^ height + (2*borderWidth)
claus
parents: 151
diff changeset
  2978
!
claus
parents: 151
diff changeset
  2979
claus
parents: 151
diff changeset
  2980
widthIncludingBorder
claus
parents: 151
diff changeset
  2981
    "return my width including border
claus
parents: 151
diff changeset
  2982
     (this is my width as seen from the outside view;
claus
parents: 151
diff changeset
  2983
      while #width returns the width as seen by myself)"
claus
parents: 151
diff changeset
  2984
claus
parents: 151
diff changeset
  2985
    ^ width + (2*borderWidth)
claus
parents: 151
diff changeset
  2986
!
claus
parents: 151
diff changeset
  2987
140
claus
parents: 138
diff changeset
  2988
originRelativeTo:aView
claus
parents: 138
diff changeset
  2989
    "return the origin (in pixels) relative to a superView,
151
claus
parents: 145
diff changeset
  2990
     or relative to the rootView (if the aView argument is nil).
153
claus
parents: 151
diff changeset
  2991
     If the receiver is nonNil and not a subview of aView, return nil."
140
claus
parents: 138
diff changeset
  2992
claus
parents: 138
diff changeset
  2993
    |currentView
claus
parents: 138
diff changeset
  2994
     org  "{ Class: Point }"
claus
parents: 138
diff changeset
  2995
     sumX "{ Class: SmallInteger }"
claus
parents: 138
diff changeset
  2996
     sumY "{ Class: SmallInteger }" |
claus
parents: 138
diff changeset
  2997
claus
parents: 138
diff changeset
  2998
    currentView := self.
claus
parents: 138
diff changeset
  2999
    sumX := 0.
claus
parents: 138
diff changeset
  3000
    sumY := 0.
claus
parents: 138
diff changeset
  3001
    [currentView notNil] whileTrue:[
claus
parents: 138
diff changeset
  3002
	(currentView == aView) ifTrue:[
claus
parents: 138
diff changeset
  3003
	    ^ (sumX @ sumY)
claus
parents: 138
diff changeset
  3004
	].
claus
parents: 138
diff changeset
  3005
	org := currentView origin.
claus
parents: 138
diff changeset
  3006
	sumX := sumX + org x.
claus
parents: 138
diff changeset
  3007
	sumY := sumY + org y.
claus
parents: 138
diff changeset
  3008
	currentView := currentView superView
claus
parents: 138
diff changeset
  3009
    ].
claus
parents: 138
diff changeset
  3010
    (aView isNil or:[aView == RootView]) ifTrue:[
claus
parents: 138
diff changeset
  3011
	"return relative to screen ..."
claus
parents: 138
diff changeset
  3012
	^ (sumX @ sumY)
claus
parents: 138
diff changeset
  3013
    ].
claus
parents: 138
diff changeset
  3014
    ^ nil
153
claus
parents: 151
diff changeset
  3015
claus
parents: 151
diff changeset
  3016
    "
claus
parents: 151
diff changeset
  3017
     |top sub1 sub2|
claus
parents: 151
diff changeset
  3018
claus
parents: 151
diff changeset
  3019
     top := StandardSystemView new.
claus
parents: 151
diff changeset
  3020
     top extent:200@200.   
claus
parents: 151
diff changeset
  3021
     sub1 := View origin:0.2 @ 0.2 corner:0.8 @ 0.8 in:top.
claus
parents: 151
diff changeset
  3022
     sub2 := Button origin:0.3 @ 0.3 corner:0.7 @ 0.7 in:sub1.
claus
parents: 151
diff changeset
  3023
     top openAndWait.
claus
parents: 151
diff changeset
  3024
     Transcript show:'button in top:'; showCr:(sub2 originRelativeTo:top).
claus
parents: 151
diff changeset
  3025
     Transcript show:'button on screen:'; showCr:(sub2 originRelativeTo:nil).
claus
parents: 151
diff changeset
  3026
    "
140
claus
parents: 138
diff changeset
  3027
!
claus
parents: 138
diff changeset
  3028
claus
parents: 138
diff changeset
  3029
relativeCorner:aPoint
claus
parents: 138
diff changeset
  3030
    "set the relative corner"
claus
parents: 138
diff changeset
  3031
claus
parents: 138
diff changeset
  3032
    relativeCorner := aPoint
claus
parents: 138
diff changeset
  3033
!
claus
parents: 138
diff changeset
  3034
claus
parents: 138
diff changeset
  3035
relativeOrigin:aPoint
claus
parents: 138
diff changeset
  3036
    "set the relative origin"
claus
parents: 138
diff changeset
  3037
claus
parents: 138
diff changeset
  3038
    relativeOrigin := aPoint
claus
parents: 138
diff changeset
  3039
!
claus
parents: 138
diff changeset
  3040
claus
parents: 138
diff changeset
  3041
leftInset
claus
parents: 138
diff changeset
  3042
    "return the inset of the left edge; positive is to the right,
claus
parents: 138
diff changeset
  3043
     negative to the left"
claus
parents: 138
diff changeset
  3044
claus
parents: 138
diff changeset
  3045
    insets isNil ifTrue:[^ 0].
claus
parents: 138
diff changeset
  3046
    ^ insets at:1 
claus
parents: 138
diff changeset
  3047
!
claus
parents: 138
diff changeset
  3048
claus
parents: 138
diff changeset
  3049
sizeFixed:aBoolean
claus
parents: 138
diff changeset
  3050
    "set/clear the fix-size attribute, if supported by concrete subclasses.
claus
parents: 138
diff changeset
  3051
     Views which want to resize themselfes as appropriate to their contents
claus
parents: 138
diff changeset
  3052
     should cease to do so and take their current size if sizeFixed is set to
claus
parents: 138
diff changeset
  3053
     true. Currently, only supported by Labels.
144
claus
parents: 142
diff changeset
  3054
     This does NOT prevent the window manager from resizing the view, 
claus
parents: 142
diff changeset
  3055
     instead it tell the view to NOT resize ITSELF.
claus
parents: 142
diff changeset
  3056
     Added here to provide a common protocol for all views."
140
claus
parents: 138
diff changeset
  3057
claus
parents: 138
diff changeset
  3058
    ^ self
claus
parents: 138
diff changeset
  3059
!
claus
parents: 138
diff changeset
  3060
claus
parents: 138
diff changeset
  3061
top:aNumber
claus
parents: 138
diff changeset
  3062
    "set the y position"
claus
parents: 138
diff changeset
  3063
claus
parents: 138
diff changeset
  3064
    self origin:(left @ aNumber)
claus
parents: 138
diff changeset
  3065
!
claus
parents: 138
diff changeset
  3066
claus
parents: 138
diff changeset
  3067
rightInset
claus
parents: 138
diff changeset
  3068
    "return the inset of the right edge; positive is to the left,
claus
parents: 138
diff changeset
  3069
     negative to the right"
claus
parents: 138
diff changeset
  3070
claus
parents: 138
diff changeset
  3071
    insets isNil ifTrue:[^ 0].
claus
parents: 138
diff changeset
  3072
    ^ insets at:3 
claus
parents: 138
diff changeset
  3073
!
claus
parents: 138
diff changeset
  3074
claus
parents: 138
diff changeset
  3075
topInset
claus
parents: 138
diff changeset
  3076
    "return the inset of the top edge; positive is to the bottom,
claus
parents: 138
diff changeset
  3077
     negative to the top"
claus
parents: 138
diff changeset
  3078
claus
parents: 138
diff changeset
  3079
    insets isNil ifTrue:[^ 0].
claus
parents: 138
diff changeset
  3080
    ^ insets at:2 
claus
parents: 138
diff changeset
  3081
!
claus
parents: 138
diff changeset
  3082
claus
parents: 138
diff changeset
  3083
left
173
claus
parents: 162
diff changeset
  3084
    "return the x position of the left border (in pixels)"
140
claus
parents: 138
diff changeset
  3085
claus
parents: 138
diff changeset
  3086
    ^ left
claus
parents: 138
diff changeset
  3087
!
claus
parents: 138
diff changeset
  3088
claus
parents: 138
diff changeset
  3089
corner
173
claus
parents: 162
diff changeset
  3090
    "return the lower right corner-point (in pixels)"
claus
parents: 162
diff changeset
  3091
180
claus
parents: 176
diff changeset
  3092
"/    ^ (left + width "- 1") @ (top + height "- 1")
claus
parents: 176
diff changeset
  3093
    ^ (left + width - 1) @ (top + height - 1)
claus
parents: 176
diff changeset
  3094
claus
parents: 176
diff changeset
  3095
    "Modified: 31.8.1995 / 16:51:40 / claus"
140
claus
parents: 138
diff changeset
  3096
!
claus
parents: 138
diff changeset
  3097
claus
parents: 138
diff changeset
  3098
bottomInset
claus
parents: 138
diff changeset
  3099
    "return the inset of the bottom edge; positive is to the top,
claus
parents: 138
diff changeset
  3100
     negative to the bottom"
claus
parents: 138
diff changeset
  3101
claus
parents: 138
diff changeset
  3102
    insets isNil ifTrue:[^ 0].
claus
parents: 138
diff changeset
  3103
    ^ insets at:4
claus
parents: 138
diff changeset
  3104
!
claus
parents: 138
diff changeset
  3105
claus
parents: 138
diff changeset
  3106
right:aNumber
claus
parents: 138
diff changeset
  3107
    "set the corners x position"
claus
parents: 138
diff changeset
  3108
claus
parents: 138
diff changeset
  3109
    self corner:(aNumber @ self corner y)
claus
parents: 138
diff changeset
  3110
!
claus
parents: 138
diff changeset
  3111
claus
parents: 138
diff changeset
  3112
bottom:aNumber
claus
parents: 138
diff changeset
  3113
    "set the corners y position"
claus
parents: 138
diff changeset
  3114
claus
parents: 138
diff changeset
  3115
    self corner:(self corner x @ aNumber)
claus
parents: 138
diff changeset
  3116
!
claus
parents: 138
diff changeset
  3117
claus
parents: 138
diff changeset
  3118
right
173
claus
parents: 162
diff changeset
  3119
    "return the x position of the right edge  (in pixels)"
claus
parents: 162
diff changeset
  3120
180
claus
parents: 176
diff changeset
  3121
    ^ left + width - 1
claus
parents: 176
diff changeset
  3122
claus
parents: 176
diff changeset
  3123
    "Modified: 31.8.1995 / 19:31:10 / claus"
140
claus
parents: 138
diff changeset
  3124
!
claus
parents: 138
diff changeset
  3125
claus
parents: 138
diff changeset
  3126
bottom
173
claus
parents: 162
diff changeset
  3127
    "return the y position of the actual bottom edge (in pixels)"
claus
parents: 162
diff changeset
  3128
180
claus
parents: 176
diff changeset
  3129
    ^ top + height - 1
140
claus
parents: 138
diff changeset
  3130
!
claus
parents: 138
diff changeset
  3131
claus
parents: 138
diff changeset
  3132
relativeExtent
claus
parents: 138
diff changeset
  3133
    "return the relative extent or nil"
claus
parents: 138
diff changeset
  3134
claus
parents: 138
diff changeset
  3135
    ^ relativeExtent
claus
parents: 138
diff changeset
  3136
!
claus
parents: 138
diff changeset
  3137
claus
parents: 138
diff changeset
  3138
left:newLeft top:newTop width:newWidth height:newHeight
claus
parents: 138
diff changeset
  3139
    "another way of specifying origin and extent"
claus
parents: 138
diff changeset
  3140
claus
parents: 138
diff changeset
  3141
    self origin:(newLeft @ newTop) extent:(newWidth @ newHeight)
claus
parents: 138
diff changeset
  3142
!
claus
parents: 138
diff changeset
  3143
claus
parents: 138
diff changeset
  3144
relativeExtent:aPoint
claus
parents: 138
diff changeset
  3145
    "set the relative extent"
claus
parents: 138
diff changeset
  3146
claus
parents: 138
diff changeset
  3147
    relativeExtent := aPoint
claus
parents: 138
diff changeset
  3148
!
claus
parents: 138
diff changeset
  3149
claus
parents: 138
diff changeset
  3150
center:newCenter
claus
parents: 138
diff changeset
  3151
    "move the receiver so that newCenter, aPoint becomes the center point"
claus
parents: 138
diff changeset
  3152
claus
parents: 138
diff changeset
  3153
    self origin:(newCenter - ((width // 2) @ (height // 2)))
claus
parents: 138
diff changeset
  3154
!
claus
parents: 138
diff changeset
  3155
claus
parents: 138
diff changeset
  3156
center
151
claus
parents: 145
diff changeset
  3157
    "return the point at the center of the receiver (in pixels)"
140
claus
parents: 138
diff changeset
  3158
claus
parents: 138
diff changeset
  3159
    ^ (left + (width // 2)) @ (top + (height // 2))
claus
parents: 138
diff changeset
  3160
!
claus
parents: 138
diff changeset
  3161
claus
parents: 138
diff changeset
  3162
computeCorner
151
claus
parents: 145
diff changeset
  3163
    "compute my corner; if I have a layoutObject,
claus
parents: 145
diff changeset
  3164
     relative origins or blocks to evaluate, compute it now ..
claus
parents: 145
diff changeset
  3165
     Blocks may return relative values or nil; nil means: take current value.
claus
parents: 145
diff changeset
  3166
     Returns the corner point in device coordinates (pixels)."
140
claus
parents: 138
diff changeset
  3167
claus
parents: 138
diff changeset
  3168
    |org newCorner newExt x y|
claus
parents: 138
diff changeset
  3169
151
claus
parents: 145
diff changeset
  3170
    "
claus
parents: 145
diff changeset
  3171
     slowly migrating to use layoutObjects ...
claus
parents: 145
diff changeset
  3172
    "
claus
parents: 145
diff changeset
  3173
    layout notNil ifTrue:[
claus
parents: 145
diff changeset
  3174
	^ (layout rectangleRelativeTo:(superView viewRectangle)
claus
parents: 145
diff changeset
  3175
			    preferred:(self preferredBounds)) corner rounded
claus
parents: 145
diff changeset
  3176
    ].
claus
parents: 145
diff changeset
  3177
140
claus
parents: 138
diff changeset
  3178
    (cornerRule notNil) ifTrue:[
claus
parents: 138
diff changeset
  3179
	newCorner := cornerRule value.
claus
parents: 138
diff changeset
  3180
	"
claus
parents: 138
diff changeset
  3181
	 allow return of relative values ...
claus
parents: 138
diff changeset
  3182
	"
claus
parents: 138
diff changeset
  3183
	x := newCorner x.
claus
parents: 138
diff changeset
  3184
	y := newCorner y.
claus
parents: 138
diff changeset
  3185
	x isNil ifTrue:[x := self corner x].
claus
parents: 138
diff changeset
  3186
	y isNil ifTrue:[y := self corner y].
claus
parents: 138
diff changeset
  3187
	((x isInteger not) or:[y isInteger not]) ifTrue:[
claus
parents: 138
diff changeset
  3188
	    newCorner := self cornerFromRelativeCorner:x@y 
claus
parents: 138
diff changeset
  3189
	]
claus
parents: 138
diff changeset
  3190
    ] ifFalse:[
claus
parents: 138
diff changeset
  3191
	(relativeCorner notNil) ifTrue:[
claus
parents: 138
diff changeset
  3192
	    newCorner := self cornerFromRelativeCorner:relativeCorner
claus
parents: 138
diff changeset
  3193
	] ifFalse:[
claus
parents: 138
diff changeset
  3194
	    org := self computeOrigin.
claus
parents: 138
diff changeset
  3195
	    (extentRule notNil) ifTrue:[
claus
parents: 138
diff changeset
  3196
		newExt := extentRule value
claus
parents: 138
diff changeset
  3197
	    ] ifFalse:[
claus
parents: 138
diff changeset
  3198
		(relativeExtent notNil) ifTrue:[
claus
parents: 138
diff changeset
  3199
		    newExt := self extentFromRelativeExtent:relativeExtent 
claus
parents: 138
diff changeset
  3200
		]
claus
parents: 138
diff changeset
  3201
	    ].
claus
parents: 138
diff changeset
  3202
	    newCorner := org + newExt
claus
parents: 138
diff changeset
  3203
	]
claus
parents: 138
diff changeset
  3204
    ].
claus
parents: 138
diff changeset
  3205
    ^ newCorner
claus
parents: 138
diff changeset
  3206
! !
claus
parents: 138
diff changeset
  3207
claus
parents: 138
diff changeset
  3208
!SimpleView methodsFor:'realization'!
claus
parents: 138
diff changeset
  3209
151
claus
parents: 145
diff changeset
  3210
map
claus
parents: 145
diff changeset
  3211
    "make the view visible on the screen"
claus
parents: 145
diff changeset
  3212
claus
parents: 145
diff changeset
  3213
    realized ifFalse:[
claus
parents: 145
diff changeset
  3214
	"
claus
parents: 145
diff changeset
  3215
	 now, make the view visible
claus
parents: 145
diff changeset
  3216
	"
claus
parents: 145
diff changeset
  3217
	device mapWindow:drawableId.
claus
parents: 145
diff changeset
  3218
	realized := true.
claus
parents: 145
diff changeset
  3219
    ]
claus
parents: 145
diff changeset
  3220
!
claus
parents: 145
diff changeset
  3221
claus
parents: 145
diff changeset
  3222
unmap
claus
parents: 145
diff changeset
  3223
    "hide me - the view stays created, and can be mapped again later."
140
claus
parents: 138
diff changeset
  3224
claus
parents: 138
diff changeset
  3225
    realized ifTrue:[
135
claus
parents:
diff changeset
  3226
	drawableId notNil ifTrue:[
140
claus
parents: 138
diff changeset
  3227
	    device unmapWindow:drawableId
claus
parents: 138
diff changeset
  3228
	].
claus
parents: 138
diff changeset
  3229
	realized := shown := false.
151
claus
parents: 145
diff changeset
  3230
    ].
claus
parents: 145
diff changeset
  3231
claus
parents: 145
diff changeset
  3232
    "
claus
parents: 145
diff changeset
  3233
     |top sub|
claus
parents: 145
diff changeset
  3234
claus
parents: 145
diff changeset
  3235
     top := StandardSystemView new.
claus
parents: 145
diff changeset
  3236
     top extent:200@200.
claus
parents: 145
diff changeset
  3237
claus
parents: 145
diff changeset
  3238
     sub := View
claus
parents: 145
diff changeset
  3239
		origin:0.2@0.2
claus
parents: 145
diff changeset
  3240
		corner:0.8@0.8
claus
parents: 145
diff changeset
  3241
		in:top.
claus
parents: 145
diff changeset
  3242
claus
parents: 145
diff changeset
  3243
     sub viewBackground:Color red.
claus
parents: 145
diff changeset
  3244
     sub hiddenOnRealize:true.
claus
parents: 145
diff changeset
  3245
claus
parents: 145
diff changeset
  3246
     top open.
claus
parents: 145
diff changeset
  3247
     (Delay forSeconds:5) wait.
claus
parents: 145
diff changeset
  3248
     sub map.
claus
parents: 145
diff changeset
  3249
     (Delay forSeconds:3) wait.
claus
parents: 145
diff changeset
  3250
     sub unmap.
claus
parents: 145
diff changeset
  3251
     sub viewBackground:(Color green).
claus
parents: 145
diff changeset
  3252
     (Delay forSeconds:3) wait.
claus
parents: 145
diff changeset
  3253
     sub map.
claus
parents: 145
diff changeset
  3254
    "
claus
parents: 145
diff changeset
  3255
!
claus
parents: 145
diff changeset
  3256
claus
parents: 145
diff changeset
  3257
unrealize
claus
parents: 145
diff changeset
  3258
    "alias for unmap, for historic reasons"
claus
parents: 145
diff changeset
  3259
claus
parents: 145
diff changeset
  3260
    self unmap.
140
claus
parents: 138
diff changeset
  3261
!
claus
parents: 138
diff changeset
  3262
claus
parents: 138
diff changeset
  3263
physicalCreate
151
claus
parents: 145
diff changeset
  3264
    "common code for create & recreate: 
claus
parents: 145
diff changeset
  3265
     physically create (but do not map) the view on the device."
140
claus
parents: 138
diff changeset
  3266
claus
parents: 138
diff changeset
  3267
    "associate colors to device"
claus
parents: 138
diff changeset
  3268
claus
parents: 138
diff changeset
  3269
    drawableId := device 
claus
parents: 138
diff changeset
  3270
		      createWindowFor:self 
claus
parents: 138
diff changeset
  3271
			  origin:(left @ top)
claus
parents: 138
diff changeset
  3272
			  extent:(width @ height)
claus
parents: 138
diff changeset
  3273
			  minExtent:nil
claus
parents: 138
diff changeset
  3274
			  maxExtent:nil
claus
parents: 138
diff changeset
  3275
			  borderWidth:borderWidth
claus
parents: 138
diff changeset
  3276
			  subViewOf:superView
157
claus
parents: 154
diff changeset
  3277
			  onTop:(self isPopUpView)
140
claus
parents: 138
diff changeset
  3278
			  inputOnly:(self inputOnly)
claus
parents: 138
diff changeset
  3279
			  label:nil
claus
parents: 138
diff changeset
  3280
			  cursor:cursor
claus
parents: 138
diff changeset
  3281
			  icon:nil
claus
parents: 138
diff changeset
  3282
			  iconView:nil.
claus
parents: 138
diff changeset
  3283
162
claus
parents: 160
diff changeset
  3284
    Lobby registerChange:self.
140
claus
parents: 138
diff changeset
  3285
    extentChanged := false.
claus
parents: 138
diff changeset
  3286
    originChanged := false.
claus
parents: 138
diff changeset
  3287
claus
parents: 138
diff changeset
  3288
    (borderColor notNil and:[borderColor ~~ Black]) ifTrue:[
claus
parents: 138
diff changeset
  3289
"/        borderColor := borderColor on:device.
claus
parents: 138
diff changeset
  3290
	self setBorderColor
claus
parents: 138
diff changeset
  3291
    ].
claus
parents: 138
diff changeset
  3292
    (viewGravity notNil "and:[viewGravity ~~ #NorthWest]") ifTrue:[
claus
parents: 138
diff changeset
  3293
	device setWindowGravity:viewGravity in:drawableId
claus
parents: 138
diff changeset
  3294
    ].
claus
parents: 138
diff changeset
  3295
    (bitGravity notNil "and:[bitGravity ~~ #NorthWest]") ifTrue:[
claus
parents: 138
diff changeset
  3296
	device setBitGravity:bitGravity in:drawableId
claus
parents: 138
diff changeset
  3297
    ].
claus
parents: 138
diff changeset
  3298
    borderShape notNil ifTrue:[
claus
parents: 138
diff changeset
  3299
	device setWindowBorderShape:(borderShape id) in:drawableId
claus
parents: 138
diff changeset
  3300
    ].
claus
parents: 138
diff changeset
  3301
    viewShape notNil ifTrue:[
claus
parents: 138
diff changeset
  3302
	device setWindowShape:(viewShape id) in:drawableId
claus
parents: 138
diff changeset
  3303
    ].
claus
parents: 138
diff changeset
  3304
    (backed notNil and:[backed ~~ false]) ifTrue:[
claus
parents: 138
diff changeset
  3305
	device setBackingStore:backed in:drawableId
claus
parents: 138
diff changeset
  3306
    ].
claus
parents: 138
diff changeset
  3307
    saveUnder ifTrue:[
claus
parents: 138
diff changeset
  3308
	device setSaveUnder:true in:drawableId
claus
parents: 138
diff changeset
  3309
    ].
claus
parents: 138
diff changeset
  3310
!
claus
parents: 138
diff changeset
  3311
claus
parents: 138
diff changeset
  3312
fixSize
claus
parents: 138
diff changeset
  3313
    "This is called right before the view is made visible.
claus
parents: 138
diff changeset
  3314
     Adjust the size of the view according to either relative/abs or
claus
parents: 138
diff changeset
  3315
     block extent; also set origin. Also, subclasses may redefine this
claus
parents: 138
diff changeset
  3316
     method to adjust the size based on some extent (for example, PopUpMenus
claus
parents: 138
diff changeset
  3317
     do so to take care of changed number of menu entries)."
claus
parents: 138
diff changeset
  3318
151
claus
parents: 145
diff changeset
  3319
    |org ext r|
claus
parents: 145
diff changeset
  3320
claus
parents: 145
diff changeset
  3321
    "please: no longer use window/viewport - they will vanish"
140
claus
parents: 138
diff changeset
  3322
    window notNil ifTrue:[
claus
parents: 138
diff changeset
  3323
	^ self superViewChangedSize
claus
parents: 138
diff changeset
  3324
    ].
claus
parents: 138
diff changeset
  3325
151
claus
parents: 145
diff changeset
  3326
    "
claus
parents: 145
diff changeset
  3327
     slowly migrating to use layoutObjects ...
claus
parents: 145
diff changeset
  3328
    "
claus
parents: 145
diff changeset
  3329
    layout notNil ifTrue:[
claus
parents: 145
diff changeset
  3330
	(originChanged or:[extentChanged or:[cornerChanged]]) ifTrue:[
claus
parents: 145
diff changeset
  3331
	    r := (layout rectangleRelativeTo:(superView viewRectangle)
claus
parents: 145
diff changeset
  3332
				   preferred:(self preferredBounds)).
claus
parents: 145
diff changeset
  3333
	    org := r origin rounded.
claus
parents: 145
diff changeset
  3334
	    ext := r extent rounded.
claus
parents: 145
diff changeset
  3335
	    self pixelOrigin:org extent:ext.
claus
parents: 145
diff changeset
  3336
	].
claus
parents: 145
diff changeset
  3337
	^ self.
claus
parents: 145
diff changeset
  3338
    ].
claus
parents: 145
diff changeset
  3339
140
claus
parents: 138
diff changeset
  3340
    "if the extent is not the one we created the window with ..."
claus
parents: 138
diff changeset
  3341
    extentChanged ifTrue:[
claus
parents: 138
diff changeset
  3342
	self sizeChanged:nil.
claus
parents: 138
diff changeset
  3343
	extentChanged := false
claus
parents: 138
diff changeset
  3344
    ].
claus
parents: 138
diff changeset
  3345
claus
parents: 138
diff changeset
  3346
    originChanged ifTrue:[
claus
parents: 138
diff changeset
  3347
"/        org := self computeOrigin.
claus
parents: 138
diff changeset
  3348
"/        self pixelOrigin:org.    
claus
parents: 138
diff changeset
  3349
	originRule notNil ifTrue:[
claus
parents: 138
diff changeset
  3350
	    self pixelOrigin:self computeOrigin
claus
parents: 138
diff changeset
  3351
	] ifFalse:[
claus
parents: 138
diff changeset
  3352
	    relativeOrigin notNil ifTrue:[
claus
parents: 138
diff changeset
  3353
		self originFromRelativeOrigin:relativeOrigin
claus
parents: 138
diff changeset
  3354
	    ] ifFalse:[
151
claus
parents: 145
diff changeset
  3355
		shown ifTrue:[
claus
parents: 145
diff changeset
  3356
		    device moveWindow:drawableId x:left y:top.
claus
parents: 145
diff changeset
  3357
		] ifFalse:[
claus
parents: 145
diff changeset
  3358
		    self pixelOrigin:left@top
claus
parents: 145
diff changeset
  3359
		].
140
claus
parents: 138
diff changeset
  3360
	    ].
claus
parents: 138
diff changeset
  3361
	].
claus
parents: 138
diff changeset
  3362
	originChanged := false
claus
parents: 138
diff changeset
  3363
    ]
claus
parents: 138
diff changeset
  3364
!
claus
parents: 138
diff changeset
  3365
claus
parents: 138
diff changeset
  3366
create
151
claus
parents: 145
diff changeset
  3367
    "create (i.e. tell my device about me) if not already created.
claus
parents: 145
diff changeset
  3368
     This does not make the view visible (needs a #map for that)"
140
claus
parents: 138
diff changeset
  3369
claus
parents: 138
diff changeset
  3370
    drawableId isNil ifTrue:[
claus
parents: 138
diff changeset
  3371
	"
claus
parents: 138
diff changeset
  3372
	 make certain that superview is created also
claus
parents: 138
diff changeset
  3373
	"
claus
parents: 138
diff changeset
  3374
	superView notNil ifTrue:[
claus
parents: 138
diff changeset
  3375
"/            superView id isNil ifTrue:[
claus
parents: 138
diff changeset
  3376
		superView create.
claus
parents: 138
diff changeset
  3377
"/            ].
claus
parents: 138
diff changeset
  3378
claus
parents: 138
diff changeset
  3379
"/            "and put my controller into the superviews controller list"
claus
parents: 138
diff changeset
  3380
"/            controller notNil ifTrue:[
claus
parents: 138
diff changeset
  3381
"/                superView controller notNil ifTrue:[
claus
parents: 138
diff changeset
  3382
"/                    controller manager:(superView controller manager)
claus
parents: 138
diff changeset
  3383
"/                ]
claus
parents: 138
diff changeset
  3384
"/            ]
claus
parents: 138
diff changeset
  3385
	].
claus
parents: 138
diff changeset
  3386
claus
parents: 138
diff changeset
  3387
	cursor := cursor on:device.
claus
parents: 138
diff changeset
  3388
claus
parents: 138
diff changeset
  3389
	self physicalCreate.
claus
parents: 138
diff changeset
  3390
claus
parents: 138
diff changeset
  3391
	viewBackground notNil ifTrue:[
claus
parents: 138
diff changeset
  3392
	   self setViewBackground
claus
parents: 138
diff changeset
  3393
	].
claus
parents: 138
diff changeset
  3394
claus
parents: 138
diff changeset
  3395
	self initializeMiddleButtonMenu.
claus
parents: 138
diff changeset
  3396
	self initEvents.
claus
parents: 138
diff changeset
  3397
claus
parents: 138
diff changeset
  3398
	"
claus
parents: 138
diff changeset
  3399
	 this is the first create,
claus
parents: 138
diff changeset
  3400
	 force sizechange messages to be sent to the view
claus
parents: 138
diff changeset
  3401
	"
claus
parents: 138
diff changeset
  3402
	extentChanged := true.
claus
parents: 138
diff changeset
  3403
	originChanged := true
claus
parents: 138
diff changeset
  3404
    ]
claus
parents: 138
diff changeset
  3405
!
claus
parents: 138
diff changeset
  3406
claus
parents: 138
diff changeset
  3407
realizeLeavingGroup:leaveGroupAsIs 
151
claus
parents: 145
diff changeset
  3408
    "common helper for realize and realizeInGroup.
claus
parents: 145
diff changeset
  3409
     Create the view, if the argument is not true, assign my windowGroup,
claus
parents: 145
diff changeset
  3410
     if hiddenOnRealize is not true, map it."
140
claus
parents: 138
diff changeset
  3411
claus
parents: 138
diff changeset
  3412
    |superGroup groupChange|
claus
parents: 138
diff changeset
  3413
claus
parents: 138
diff changeset
  3414
    drawableId isNil ifTrue:[
claus
parents: 138
diff changeset
  3415
	self create.
claus
parents: 138
diff changeset
  3416
    ].
claus
parents: 138
diff changeset
  3417
claus
parents: 138
diff changeset
  3418
    leaveGroupAsIs ifFalse:[
claus
parents: 138
diff changeset
  3419
	"
claus
parents: 138
diff changeset
  3420
	 put myself into superviews windowgroup if there is a superview
claus
parents: 138
diff changeset
  3421
	"
claus
parents: 138
diff changeset
  3422
	groupChange := false.
claus
parents: 138
diff changeset
  3423
	superView notNil ifTrue:[
claus
parents: 138
diff changeset
  3424
	    superGroup := superView windowGroup.
claus
parents: 138
diff changeset
  3425
	    (windowGroup notNil and:[superGroup ~~ windowGroup]) ifTrue:[
claus
parents: 138
diff changeset
  3426
		"
claus
parents: 138
diff changeset
  3427
		 mhmh - seems that the windowgroup has changed ....
claus
parents: 138
diff changeset
  3428
		"
145
claus
parents: 144
diff changeset
  3429
"/                'oops - wgroup change on realize' printNL.
140
claus
parents: 138
diff changeset
  3430
		windowGroup removeView:self.
claus
parents: 138
diff changeset
  3431
		windowGroup := nil
claus
parents: 138
diff changeset
  3432
	    ].
claus
parents: 138
diff changeset
  3433
	    superGroup ~~ windowGroup ifTrue:[
claus
parents: 138
diff changeset
  3434
		groupChange := true.
claus
parents: 138
diff changeset
  3435
		windowGroup := superGroup.
claus
parents: 138
diff changeset
  3436
		windowGroup notNil ifTrue:[
claus
parents: 138
diff changeset
  3437
		    windowGroup addView:self.
claus
parents: 138
diff changeset
  3438
		]
claus
parents: 138
diff changeset
  3439
	    ]
claus
parents: 138
diff changeset
  3440
	].
claus
parents: 138
diff changeset
  3441
    ].
claus
parents: 138
diff changeset
  3442
151
claus
parents: 145
diff changeset
  3443
    hiddenOnRealize ifFalse:[
175
claus
parents: 173
diff changeset
  3444
	(originChanged or:[extentChanged]) ifTrue:[
claus
parents: 173
diff changeset
  3445
	    self fixSize.
claus
parents: 173
diff changeset
  3446
	    self sizeChanged:nil.   "/ new 29-aug-1995
claus
parents: 173
diff changeset
  3447
	].
140
claus
parents: 138
diff changeset
  3448
claus
parents: 138
diff changeset
  3449
	(realized not or:[groupChange]) ifTrue:[
claus
parents: 138
diff changeset
  3450
	    subViews notNil ifTrue:[
180
claus
parents: 176
diff changeset
  3451
		self realizeAllSubViews.
140
claus
parents: 138
diff changeset
  3452
	    ].
claus
parents: 138
diff changeset
  3453
	].
claus
parents: 138
diff changeset
  3454
	self setInnerClip.
claus
parents: 138
diff changeset
  3455
claus
parents: 138
diff changeset
  3456
	realized ifFalse:[
claus
parents: 138
diff changeset
  3457
	    "
claus
parents: 138
diff changeset
  3458
	     now, make the view visible
claus
parents: 138
diff changeset
  3459
	    "
151
claus
parents: 145
diff changeset
  3460
	    self map
140
claus
parents: 138
diff changeset
  3461
	]
claus
parents: 138
diff changeset
  3462
    ].
claus
parents: 138
diff changeset
  3463
claus
parents: 138
diff changeset
  3464
    controller notNil ifTrue:[
claus
parents: 138
diff changeset
  3465
	controller startUp
claus
parents: 138
diff changeset
  3466
    ]
claus
parents: 138
diff changeset
  3467
!
claus
parents: 138
diff changeset
  3468
claus
parents: 138
diff changeset
  3469
realize
claus
parents: 138
diff changeset
  3470
    "realize - make visible;
claus
parents: 138
diff changeset
  3471
     realizing is done very late (after layout is fixed) to avoid
claus
parents: 138
diff changeset
  3472
     visible rearranging of windows on the screen"
claus
parents: 138
diff changeset
  3473
claus
parents: 138
diff changeset
  3474
    self realizeLeavingGroup:false
claus
parents: 138
diff changeset
  3475
!
claus
parents: 138
diff changeset
  3476
claus
parents: 138
diff changeset
  3477
destroy
claus
parents: 138
diff changeset
  3478
    "unrealize & destroy - make me invisible, destroy subviews then
claus
parents: 138
diff changeset
  3479
     make me unknown to the device"
claus
parents: 138
diff changeset
  3480
claus
parents: 138
diff changeset
  3481
    |subs|
claus
parents: 138
diff changeset
  3482
claus
parents: 138
diff changeset
  3483
    realized ifTrue:[
claus
parents: 138
diff changeset
  3484
	self unrealize.            
claus
parents: 138
diff changeset
  3485
	"make it go away immediately
claus
parents: 138
diff changeset
  3486
	 - also, this hides the subview killing"
claus
parents: 138
diff changeset
  3487
"
claus
parents: 138
diff changeset
  3488
	device synchronizeOutput. 
claus
parents: 138
diff changeset
  3489
"
claus
parents: 138
diff changeset
  3490
    ].
claus
parents: 138
diff changeset
  3491
157
claus
parents: 154
diff changeset
  3492
"/    controller notNil ifTrue:[
160
claus
parents: 157
diff changeset
  3493
"/      controller release.
claus
parents: 157
diff changeset
  3494
"/      controller := nil.
157
claus
parents: 154
diff changeset
  3495
"/    ].
140
claus
parents: 138
diff changeset
  3496
claus
parents: 138
diff changeset
  3497
    subs := subViews.
claus
parents: 138
diff changeset
  3498
    subs notNil ifTrue:[
claus
parents: 138
diff changeset
  3499
	"stupid: destroy removes itself from the subview list
claus
parents: 138
diff changeset
  3500
	 - therefore we have to loop over a copy here"
claus
parents: 138
diff changeset
  3501
claus
parents: 138
diff changeset
  3502
	subViews := nil.
claus
parents: 138
diff changeset
  3503
	subs do:[:aView |
claus
parents: 138
diff changeset
  3504
	    aView notNil ifTrue:[aView destroy]             
claus
parents: 138
diff changeset
  3505
	]
claus
parents: 138
diff changeset
  3506
    ].
135
claus
parents:
diff changeset
  3507
    superView notNil ifTrue:[
140
claus
parents: 138
diff changeset
  3508
	superView removeSubView:self.
claus
parents: 138
diff changeset
  3509
	superView := nil
claus
parents: 138
diff changeset
  3510
    ].
claus
parents: 138
diff changeset
  3511
    super destroy.
claus
parents: 138
diff changeset
  3512
157
claus
parents: 154
diff changeset
  3513
    controller notNil ifTrue:[
claus
parents: 154
diff changeset
  3514
	controller release.
claus
parents: 154
diff changeset
  3515
	controller := nil.
claus
parents: 154
diff changeset
  3516
    ].
claus
parents: 154
diff changeset
  3517
140
claus
parents: 138
diff changeset
  3518
    windowGroup notNil ifTrue:[
claus
parents: 138
diff changeset
  3519
	windowGroup removeView:self.
claus
parents: 138
diff changeset
  3520
	windowGroup := nil
135
claus
parents:
diff changeset
  3521
    ].
140
claus
parents: 138
diff changeset
  3522
!
claus
parents: 138
diff changeset
  3523
157
claus
parents: 154
diff changeset
  3524
rerealizeInGroup:aWindowGroup
claus
parents: 154
diff changeset
  3525
    "rerealize at old position in (a possibly different) windowGroup."
claus
parents: 154
diff changeset
  3526
claus
parents: 154
diff changeset
  3527
    drawableId isNil ifTrue:[
claus
parents: 154
diff changeset
  3528
	self create
claus
parents: 154
diff changeset
  3529
    ].
claus
parents: 154
diff changeset
  3530
    drawableId notNil ifTrue:[
claus
parents: 154
diff changeset
  3531
	aWindowGroup ~~ windowGroup ifTrue:[
claus
parents: 154
diff changeset
  3532
	    windowGroup notNil ifTrue:[
claus
parents: 154
diff changeset
  3533
		windowGroup removeView:self
claus
parents: 154
diff changeset
  3534
	    ].
claus
parents: 154
diff changeset
  3535
	    windowGroup := aWindowGroup.
claus
parents: 154
diff changeset
  3536
	    aWindowGroup addTopView:self.
claus
parents: 154
diff changeset
  3537
	].
claus
parents: 154
diff changeset
  3538
	self rerealize.
claus
parents: 154
diff changeset
  3539
    ]
claus
parents: 154
diff changeset
  3540
!
claus
parents: 154
diff changeset
  3541
140
claus
parents: 138
diff changeset
  3542
rerealize
claus
parents: 138
diff changeset
  3543
    "rerealize at old position"
claus
parents: 138
diff changeset
  3544
claus
parents: 138
diff changeset
  3545
    drawableId notNil ifTrue:[
claus
parents: 138
diff changeset
  3546
	realized := true.
claus
parents: 138
diff changeset
  3547
	device mapView:self id:drawableId iconified:false
claus
parents: 138
diff changeset
  3548
		   atX:left y:top width:width height:height
claus
parents: 138
diff changeset
  3549
    ]
claus
parents: 138
diff changeset
  3550
!
claus
parents: 138
diff changeset
  3551
claus
parents: 138
diff changeset
  3552
resize
claus
parents: 138
diff changeset
  3553
    "resize myself to make everything fit into me.
claus
parents: 138
diff changeset
  3554
     Nothing special done here, but redefined in some subclasses"
claus
parents: 138
diff changeset
  3555
151
claus
parents: 145
diff changeset
  3556
    self extent:(self preferredExtent)
140
claus
parents: 138
diff changeset
  3557
!
claus
parents: 138
diff changeset
  3558
claus
parents: 138
diff changeset
  3559
recreate
claus
parents: 138
diff changeset
  3560
    "recreate (i.e. tell X about me) after a snapin"
claus
parents: 138
diff changeset
  3561
claus
parents: 138
diff changeset
  3562
    drawableId isNil ifTrue:[
claus
parents: 138
diff changeset
  3563
	super recreate.
claus
parents: 138
diff changeset
  3564
	self physicalCreate.
claus
parents: 138
diff changeset
  3565
claus
parents: 138
diff changeset
  3566
	viewBackground notNil ifTrue:[
claus
parents: 138
diff changeset
  3567
	    self setViewBackground 
claus
parents: 138
diff changeset
  3568
	].
claus
parents: 138
diff changeset
  3569
claus
parents: 138
diff changeset
  3570
	"
claus
parents: 138
diff changeset
  3571
	 XXX has to be changed: eventmasks are device specific -
claus
parents: 138
diff changeset
  3572
	 XXX will not allow restart on another Workstation-type.
claus
parents: 138
diff changeset
  3573
	 XXX event masks must become symbolic
claus
parents: 138
diff changeset
  3574
	"
claus
parents: 138
diff changeset
  3575
	device setEventMask:eventMask in:drawableId
claus
parents: 138
diff changeset
  3576
    ]
claus
parents: 138
diff changeset
  3577
!
claus
parents: 138
diff changeset
  3578
claus
parents: 138
diff changeset
  3579
createWithAllSubViews
claus
parents: 138
diff changeset
  3580
    "create, then create all subviews"
claus
parents: 138
diff changeset
  3581
claus
parents: 138
diff changeset
  3582
    drawableId isNil ifTrue:[self create].
claus
parents: 138
diff changeset
  3583
    subViews notNil ifTrue:[
claus
parents: 138
diff changeset
  3584
	subViews do:[:subView | subView createWithAllSubViews]
claus
parents: 138
diff changeset
  3585
    ]
claus
parents: 138
diff changeset
  3586
!
claus
parents: 138
diff changeset
  3587
claus
parents: 138
diff changeset
  3588
realizeInGroup
claus
parents: 138
diff changeset
  3589
    "special realize - leave windowgroup as is; 
claus
parents: 138
diff changeset
  3590
     This allows a view to be realized in any windowgroup; 
claus
parents: 138
diff changeset
  3591
     for special applications, like the kill button in the Filebrowser which has
claus
parents: 138
diff changeset
  3592
     another windowGroup as its superview and is handled as a separate process."
claus
parents: 138
diff changeset
  3593
claus
parents: 138
diff changeset
  3594
    self realizeLeavingGroup:true
claus
parents: 138
diff changeset
  3595
!
claus
parents: 138
diff changeset
  3596
claus
parents: 138
diff changeset
  3597
rerealizeWithAllSubViews
claus
parents: 138
diff changeset
  3598
    "rerealize myself with all subviews"
claus
parents: 138
diff changeset
  3599
claus
parents: 138
diff changeset
  3600
    drawableId notNil ifTrue:[
claus
parents: 138
diff changeset
  3601
	realized := true.
claus
parents: 138
diff changeset
  3602
	subViews notNil ifTrue:[
180
claus
parents: 176
diff changeset
  3603
	    self realizeAllSubViews.
140
claus
parents: 138
diff changeset
  3604
	].
claus
parents: 138
diff changeset
  3605
	device mapView:self id:drawableId iconified:false
claus
parents: 138
diff changeset
  3606
		   atX:left y:top width:width height:height
claus
parents: 138
diff changeset
  3607
    ]
180
claus
parents: 176
diff changeset
  3608
!
claus
parents: 176
diff changeset
  3609
claus
parents: 176
diff changeset
  3610
realizeAllSubViews
claus
parents: 176
diff changeset
  3611
    "realize all my subviews"
claus
parents: 176
diff changeset
  3612
claus
parents: 176
diff changeset
  3613
    subViews notNil ifTrue:[
claus
parents: 176
diff changeset
  3614
	subViews do:[:subView |
claus
parents: 176
diff changeset
  3615
	    subView realize
claus
parents: 176
diff changeset
  3616
	]
claus
parents: 176
diff changeset
  3617
    ].
claus
parents: 176
diff changeset
  3618
claus
parents: 176
diff changeset
  3619
    "Modified: 5.9.1995 / 23:30:47 / claus"
151
claus
parents: 145
diff changeset
  3620
! !
claus
parents: 145
diff changeset
  3621
claus
parents: 145
diff changeset
  3622
!SimpleView methodsFor:'startup'!
claus
parents: 145
diff changeset
  3623
claus
parents: 145
diff changeset
  3624
open
claus
parents: 145
diff changeset
  3625
    "open up the view - for normal views, this is a modeless open
claus
parents: 145
diff changeset
  3626
     (i.e. the new view comes up as independent process).
claus
parents: 145
diff changeset
  3627
     Although #open is only to be sent to topviews (i.e. it could have been
claus
parents: 145
diff changeset
  3628
     implemented in TopView), it is implemented here - therefore, every view
claus
parents: 145
diff changeset
  3629
     can be opened as a topView.
claus
parents: 145
diff changeset
  3630
     This is redefined in ModalBox, which comes up modal (i.e. 
claus
parents: 145
diff changeset
  3631
     control is under the current process, so that interaction with the
claus
parents: 145
diff changeset
  3632
     current group is blocked while the modalBox is active)."
claus
parents: 145
diff changeset
  3633
claus
parents: 145
diff changeset
  3634
    ^ self openModeless
claus
parents: 145
diff changeset
  3635
claus
parents: 145
diff changeset
  3636
    "
claus
parents: 145
diff changeset
  3637
     View new open
claus
parents: 145
diff changeset
  3638
claus
parents: 145
diff changeset
  3639
     (Button label:'hello') open
claus
parents: 145
diff changeset
  3640
claus
parents: 145
diff changeset
  3641
     |top|
claus
parents: 145
diff changeset
  3642
     top := StandardSystemView new.
claus
parents: 145
diff changeset
  3643
     top extent:200@200.
claus
parents: 145
diff changeset
  3644
     Button label:'hello' in:top.
claus
parents: 145
diff changeset
  3645
     top open
claus
parents: 145
diff changeset
  3646
claus
parents: 145
diff changeset
  3647
     YesNoBox new open
claus
parents: 145
diff changeset
  3648
    "
claus
parents: 145
diff changeset
  3649
!
claus
parents: 145
diff changeset
  3650
190
claus
parents: 189
diff changeset
  3651
openAt:aPoint
claus
parents: 189
diff changeset
  3652
    "open up the view modeless - positions the view"
claus
parents: 189
diff changeset
  3653
claus
parents: 189
diff changeset
  3654
    ^self openModelessAt:aPoint
claus
parents: 189
diff changeset
  3655
claus
parents: 189
diff changeset
  3656
    "Created: 18.9.1995 / 23:30:43 / claus"
claus
parents: 189
diff changeset
  3657
!
claus
parents: 189
diff changeset
  3658
claus
parents: 189
diff changeset
  3659
openAtCenter
claus
parents: 189
diff changeset
  3660
    "open up the view modeless - positions the view"
claus
parents: 189
diff changeset
  3661
claus
parents: 189
diff changeset
  3662
    ^self openModelessAtCenter
claus
parents: 189
diff changeset
  3663
claus
parents: 189
diff changeset
  3664
    "Created: 18.9.1995 / 23:30:56 / claus"
claus
parents: 189
diff changeset
  3665
!
claus
parents: 189
diff changeset
  3666
151
claus
parents: 145
diff changeset
  3667
openModeless
claus
parents: 145
diff changeset
  3668
    "create and schedule a new windowgroup for me and open the view.
claus
parents: 145
diff changeset
  3669
     The view will be handled by its own process, effectively running in
claus
parents: 145
diff changeset
  3670
     parallel (i.e. control is returned to the sender immediately)."
claus
parents: 145
diff changeset
  3671
claus
parents: 145
diff changeset
  3672
    ProcessorScheduler isPureEventDriven ifFalse:[
claus
parents: 145
diff changeset
  3673
	windowGroup isNil ifTrue:[
claus
parents: 145
diff changeset
  3674
	    windowGroup := WindowGroup new.
claus
parents: 145
diff changeset
  3675
	    windowGroup addTopView:self.
157
claus
parents: 154
diff changeset
  3676
	    windowGroup startup:false.
claus
parents: 154
diff changeset
  3677
	] ifFalse:[
claus
parents: 154
diff changeset
  3678
	    windowGroup startup:false.
claus
parents: 154
diff changeset
  3679
	    self realizeInGroup.
151
claus
parents: 145
diff changeset
  3680
	].
claus
parents: 145
diff changeset
  3681
    ] ifTrue:[
claus
parents: 145
diff changeset
  3682
	self realize
claus
parents: 145
diff changeset
  3683
    ]
claus
parents: 145
diff changeset
  3684
claus
parents: 145
diff changeset
  3685
    "
claus
parents: 145
diff changeset
  3686
     the same:
claus
parents: 145
diff changeset
  3687
	 (Button label:'hello') open
claus
parents: 145
diff changeset
  3688
claus
parents: 145
diff changeset
  3689
	 (Button label:'hello') openModeless
claus
parents: 145
diff changeset
  3690
claus
parents: 145
diff changeset
  3691
     different:
claus
parents: 145
diff changeset
  3692
	 YesNoBox new open
claus
parents: 145
diff changeset
  3693
claus
parents: 145
diff changeset
  3694
	 YesNoBox new openModeless
claus
parents: 145
diff changeset
  3695
    "
190
claus
parents: 189
diff changeset
  3696
    "
claus
parents: 189
diff changeset
  3697
     (almost) the same:
claus
parents: 189
diff changeset
  3698
	 YesNoBox new open
claus
parents: 189
diff changeset
  3699
claus
parents: 189
diff changeset
  3700
	 YesNoBox new openModal
claus
parents: 189
diff changeset
  3701
claus
parents: 189
diff changeset
  3702
     different:
claus
parents: 189
diff changeset
  3703
	 (Button label:'hello') open
claus
parents: 189
diff changeset
  3704
claus
parents: 189
diff changeset
  3705
	 (Button label:'hello') openModal
claus
parents: 189
diff changeset
  3706
    "
claus
parents: 189
diff changeset
  3707
!
claus
parents: 189
diff changeset
  3708
claus
parents: 189
diff changeset
  3709
openModelessAt:aPoint
claus
parents: 189
diff changeset
  3710
    "open up the view modeless - positions the view
claus
parents: 189
diff changeset
  3711
     (i.e. circumvents window managers positioning)"
claus
parents: 189
diff changeset
  3712
claus
parents: 189
diff changeset
  3713
    self origin:aPoint.
claus
parents: 189
diff changeset
  3714
    self create.
claus
parents: 189
diff changeset
  3715
    device setTransient:drawableId for:0.
claus
parents: 189
diff changeset
  3716
    ^ self openModeless
claus
parents: 189
diff changeset
  3717
claus
parents: 189
diff changeset
  3718
    "
claus
parents: 189
diff changeset
  3719
     View new openModeless
claus
parents: 189
diff changeset
  3720
claus
parents: 189
diff changeset
  3721
     View new openModelessAt:100@100
claus
parents: 189
diff changeset
  3722
    "
claus
parents: 189
diff changeset
  3723
claus
parents: 189
diff changeset
  3724
    "Created: 18.9.1995 / 23:21:42 / claus"
claus
parents: 189
diff changeset
  3725
!
claus
parents: 189
diff changeset
  3726
claus
parents: 189
diff changeset
  3727
openModelessAtCenter
claus
parents: 189
diff changeset
  3728
    "open up the view modeless - positions the view
claus
parents: 189
diff changeset
  3729
     (i.e. circumvents window managers positioning)"
claus
parents: 189
diff changeset
  3730
claus
parents: 189
diff changeset
  3731
    ^ self openModelessAt:(device center - (self extent//2)).
claus
parents: 189
diff changeset
  3732
claus
parents: 189
diff changeset
  3733
    "
claus
parents: 189
diff changeset
  3734
     View new openModeless
claus
parents: 189
diff changeset
  3735
claus
parents: 189
diff changeset
  3736
     View new openModelessAtCenter
claus
parents: 189
diff changeset
  3737
    "
claus
parents: 189
diff changeset
  3738
claus
parents: 189
diff changeset
  3739
    "Created: 18.9.1995 / 23:21:42 / claus"
151
claus
parents: 145
diff changeset
  3740
!
claus
parents: 145
diff changeset
  3741
claus
parents: 145
diff changeset
  3742
openModal
claus
parents: 145
diff changeset
  3743
    "create a new windowgroup, but start processing in the current process
claus
parents: 145
diff changeset
  3744
     actually suspending event processing for the currently active group.
claus
parents: 145
diff changeset
  3745
     Stay in modalLoop while view is visible.
claus
parents: 145
diff changeset
  3746
     (i.e. control is returned to the sender when the receiver is closed)"
claus
parents: 145
diff changeset
  3747
claus
parents: 145
diff changeset
  3748
    self openModal:[true]
claus
parents: 145
diff changeset
  3749
claus
parents: 145
diff changeset
  3750
    "
claus
parents: 145
diff changeset
  3751
     the same:
claus
parents: 145
diff changeset
  3752
	 YesNoBox new open
claus
parents: 145
diff changeset
  3753
claus
parents: 145
diff changeset
  3754
	 YesNoBox new openModal
claus
parents: 145
diff changeset
  3755
claus
parents: 145
diff changeset
  3756
     different:
claus
parents: 145
diff changeset
  3757
	 (Button label:'hello') open
claus
parents: 145
diff changeset
  3758
claus
parents: 145
diff changeset
  3759
	 (Button label:'hello') openModal
claus
parents: 145
diff changeset
  3760
    "
claus
parents: 145
diff changeset
  3761
!
claus
parents: 145
diff changeset
  3762
190
claus
parents: 189
diff changeset
  3763
openModalAt:aPoint
claus
parents: 189
diff changeset
  3764
    "open up the view modeless - positions the view
claus
parents: 189
diff changeset
  3765
     (i.e. circumvents window managers positioning)"
claus
parents: 189
diff changeset
  3766
claus
parents: 189
diff changeset
  3767
    self origin:aPoint.
claus
parents: 189
diff changeset
  3768
    self create.
claus
parents: 189
diff changeset
  3769
    device setTransient:drawableId for:0.
claus
parents: 189
diff changeset
  3770
    ^ self openModal
claus
parents: 189
diff changeset
  3771
claus
parents: 189
diff changeset
  3772
    "
claus
parents: 189
diff changeset
  3773
     View new openModal
claus
parents: 189
diff changeset
  3774
claus
parents: 189
diff changeset
  3775
     View new openModalAt:100@100
claus
parents: 189
diff changeset
  3776
    "
claus
parents: 189
diff changeset
  3777
claus
parents: 189
diff changeset
  3778
    "Created: 18.9.1995 / 23:21:42 / claus"
claus
parents: 189
diff changeset
  3779
    "Modified: 18.9.1995 / 23:32:26 / claus"
claus
parents: 189
diff changeset
  3780
!
claus
parents: 189
diff changeset
  3781
claus
parents: 189
diff changeset
  3782
openModalAtCenter
claus
parents: 189
diff changeset
  3783
    "open up the view modeless - positions the view
claus
parents: 189
diff changeset
  3784
     (i.e. circumvents window managers positioning)"
claus
parents: 189
diff changeset
  3785
claus
parents: 189
diff changeset
  3786
    ^ self openModalAt:(device center - (self extent//2)).
claus
parents: 189
diff changeset
  3787
claus
parents: 189
diff changeset
  3788
    "Created: 18.9.1995 / 23:31:47 / claus"
claus
parents: 189
diff changeset
  3789
!
claus
parents: 189
diff changeset
  3790
151
claus
parents: 145
diff changeset
  3791
openModal:aBlock
claus
parents: 145
diff changeset
  3792
    "create a new windowgroup, but start processing in the current process -
claus
parents: 145
diff changeset
  3793
     actually suspending event processing for the currently active group.
claus
parents: 145
diff changeset
  3794
     Stay in this modal loop while aBlock evaluates to true AND the receiver is
claus
parents: 145
diff changeset
  3795
     visible.
claus
parents: 145
diff changeset
  3796
     (i.e. control is returned to the sender when the receiver is closed)
claus
parents: 145
diff changeset
  3797
     This makes any interaction with the current window impossible - 
claus
parents: 145
diff changeset
  3798
     however, other views (in other windowgroups) still work."
claus
parents: 145
diff changeset
  3799
claus
parents: 145
diff changeset
  3800
    |activeGroup tops|
claus
parents: 145
diff changeset
  3801
claus
parents: 145
diff changeset
  3802
    Processor activeProcessIsSystemProcess ifTrue:[
claus
parents: 145
diff changeset
  3803
	self realize
claus
parents: 145
diff changeset
  3804
    ] ifFalse:[
claus
parents: 145
diff changeset
  3805
	activeGroup := WindowGroup activeGroup.
claus
parents: 145
diff changeset
  3806
claus
parents: 145
diff changeset
  3807
	"
claus
parents: 145
diff changeset
  3808
	 create a new window group and put myself into it
claus
parents: 145
diff changeset
  3809
	"
claus
parents: 145
diff changeset
  3810
	windowGroup := WindowGroup new.
claus
parents: 145
diff changeset
  3811
	windowGroup addTopView:self.
claus
parents: 145
diff changeset
  3812
	"
claus
parents: 145
diff changeset
  3813
	 go dispatch events in this new group
claus
parents: 145
diff changeset
  3814
	 (thus current windowgroup is blocked from interaction)
claus
parents: 145
diff changeset
  3815
	"
claus
parents: 145
diff changeset
  3816
	Object abortSignal handle:[:ex |
claus
parents: 145
diff changeset
  3817
	    self hide.
claus
parents: 145
diff changeset
  3818
	    ex return.
claus
parents: 145
diff changeset
  3819
	] do:[
claus
parents: 145
diff changeset
  3820
	    [
claus
parents: 145
diff changeset
  3821
		windowGroup startupModal:[realized and:aBlock]
claus
parents: 145
diff changeset
  3822
	    ] valueOnUnwindDo:[
claus
parents: 145
diff changeset
  3823
		self hide.
claus
parents: 145
diff changeset
  3824
	    ]
claus
parents: 145
diff changeset
  3825
	].
claus
parents: 145
diff changeset
  3826
	"
claus
parents: 145
diff changeset
  3827
	 return input focus to previously active groups top.
claus
parents: 145
diff changeset
  3828
	 This helps with windowmanagers which need an explicit click
claus
parents: 145
diff changeset
  3829
	 on the view for the focus.
claus
parents: 145
diff changeset
  3830
	"
claus
parents: 145
diff changeset
  3831
	activeGroup notNil ifTrue:[
claus
parents: 145
diff changeset
  3832
	    tops := activeGroup topViews.
claus
parents: 145
diff changeset
  3833
	    (tops notNil and:[tops notEmpty]) ifTrue:[
claus
parents: 145
diff changeset
  3834
		tops first getKeyboardFocus
claus
parents: 145
diff changeset
  3835
	    ]
claus
parents: 145
diff changeset
  3836
	]
claus
parents: 145
diff changeset
  3837
    ]
140
claus
parents: 138
diff changeset
  3838
!
claus
parents: 138
diff changeset
  3839
claus
parents: 138
diff changeset
  3840
openAutonomous
claus
parents: 138
diff changeset
  3841
    "create and schedule a new windowgroup for me and open the view.
claus
parents: 138
diff changeset
  3842
     The view will be handled by its own process, effectively running in
claus
parents: 138
diff changeset
  3843
     parallel. This entry is for non-topviews, which want to be served
claus
parents: 138
diff changeset
  3844
     autonomous from the topview. (see the fileBrowsers kill-button
claus
parents: 138
diff changeset
  3845
     when executing unix commands as an example)"
claus
parents: 138
diff changeset
  3846
claus
parents: 138
diff changeset
  3847
    |wg|
claus
parents: 138
diff changeset
  3848
claus
parents: 138
diff changeset
  3849
    ProcessorScheduler isPureEventDriven ifFalse:[
claus
parents: 138
diff changeset
  3850
	wg := WindowGroup new.
claus
parents: 138
diff changeset
  3851
	self windowGroup:wg.
claus
parents: 138
diff changeset
  3852
	wg addView:self.
claus
parents: 138
diff changeset
  3853
	wg startup:false.
claus
parents: 138
diff changeset
  3854
	self realizeInGroup.
claus
parents: 138
diff changeset
  3855
    ] ifTrue:[
claus
parents: 138
diff changeset
  3856
	self realize
claus
parents: 138
diff changeset
  3857
    ]
151
claus
parents: 145
diff changeset
  3858
!
claus
parents: 145
diff changeset
  3859
157
claus
parents: 154
diff changeset
  3860
waitUntilVisible
claus
parents: 154
diff changeset
  3861
    "wait until the receiver visible.
claus
parents: 154
diff changeset
  3862
     In normal applications, you do not need to wait till a view is
claus
parents: 154
diff changeset
  3863
     open - it should do all of its drawing itself when it gets the
claus
parents: 154
diff changeset
  3864
     first expose event.
claus
parents: 154
diff changeset
  3865
     However, if you want to 'manually' draw into the view (for example,
claus
parents: 154
diff changeset
  3866
     in doIt expressions), or subsequent views depend on some state of
claus
parents: 154
diff changeset
  3867
     another view (which is only available once visible), 
claus
parents: 154
diff changeset
  3868
     use this to suspend the current process until the receiver is shown."
claus
parents: 154
diff changeset
  3869
220
0baa613accc6 waitUntilVisible was blocking, if a low prio process hogs cpu
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  3870
    [self shown] whileFalse:[
0baa613accc6 waitUntilVisible was blocking, if a low prio process hogs cpu
Claus Gittinger <cg@exept.de>
parents: 219
diff changeset
  3871
	(Delay forSeconds:0.05) wait.
157
claus
parents: 154
diff changeset
  3872
    ].
claus
parents: 154
diff changeset
  3873
claus
parents: 154
diff changeset
  3874
    "does not work:
claus
parents: 154
diff changeset
  3875
claus
parents: 154
diff changeset
  3876
	|v|
claus
parents: 154
diff changeset
  3877
claus
parents: 154
diff changeset
  3878
	v := View new open.
claus
parents: 154
diff changeset
  3879
	v displayLineFrom:0@0 to:50@50
claus
parents: 154
diff changeset
  3880
claus
parents: 154
diff changeset
  3881
     does work:
claus
parents: 154
diff changeset
  3882
claus
parents: 154
diff changeset
  3883
	|v|
claus
parents: 154
diff changeset
  3884
claus
parents: 154
diff changeset
  3885
	v := View new open.
claus
parents: 154
diff changeset
  3886
	v waitUntilVisible.
claus
parents: 154
diff changeset
  3887
	v displayLineFrom:0@0 to:50@50
claus
parents: 154
diff changeset
  3888
    "
claus
parents: 154
diff changeset
  3889
!
claus
parents: 154
diff changeset
  3890
151
claus
parents: 145
diff changeset
  3891
openAndWait
claus
parents: 145
diff changeset
  3892
    "open up the view - wait until it is visible.
claus
parents: 145
diff changeset
  3893
     In normal applications, you do not need to wait till the view is
claus
parents: 145
diff changeset
  3894
     open - it should do all of its drawing itself when it gets the
claus
parents: 145
diff changeset
  3895
     first expose event.
claus
parents: 145
diff changeset
  3896
     However, if you want to 'manually' draw into the view (for example,
claus
parents: 145
diff changeset
  3897
     in doIt expressions) the view must be visible (realized) before doing so.
claus
parents: 145
diff changeset
  3898
     Use this open in those situations."
claus
parents: 145
diff changeset
  3899
claus
parents: 145
diff changeset
  3900
    self open.
157
claus
parents: 154
diff changeset
  3901
    self waitUntilVisible.
151
claus
parents: 145
diff changeset
  3902
claus
parents: 145
diff changeset
  3903
    "does not work:
claus
parents: 145
diff changeset
  3904
claus
parents: 145
diff changeset
  3905
	|v|
claus
parents: 145
diff changeset
  3906
claus
parents: 145
diff changeset
  3907
	v := View new open.
claus
parents: 145
diff changeset
  3908
	v displayLineFrom:0@0 to:50@50
claus
parents: 145
diff changeset
  3909
claus
parents: 145
diff changeset
  3910
     does work:
claus
parents: 145
diff changeset
  3911
claus
parents: 145
diff changeset
  3912
	|v|
claus
parents: 145
diff changeset
  3913
claus
parents: 145
diff changeset
  3914
	v := View new openAndWait.
claus
parents: 145
diff changeset
  3915
	v displayLineFrom:0@0 to:50@50
claus
parents: 145
diff changeset
  3916
    "
135
claus
parents:
diff changeset
  3917
! !
claus
parents:
diff changeset
  3918
151
claus
parents: 145
diff changeset
  3919
!SimpleView methodsFor:'edge drawing'!
135
claus
parents:
diff changeset
  3920
140
claus
parents: 138
diff changeset
  3921
drawBottomEdge
claus
parents: 138
diff changeset
  3922
    "draw bottom 3D edge into window frame"
claus
parents: 138
diff changeset
  3923
claus
parents: 138
diff changeset
  3924
    self drawBottomEdgeLevel:level
claus
parents: 138
diff changeset
  3925
		      shadow:shadowColor 
claus
parents: 138
diff changeset
  3926
		      light:lightColor
claus
parents: 138
diff changeset
  3927
		      halfShadow:nil 
claus
parents: 138
diff changeset
  3928
		      halfLight:nil
claus
parents: 138
diff changeset
  3929
		      style:nil.
claus
parents: 138
diff changeset
  3930
!
claus
parents: 138
diff changeset
  3931
claus
parents: 138
diff changeset
  3932
drawLeftEdge
claus
parents: 138
diff changeset
  3933
    "draw left 3D edge into window frame"
claus
parents: 138
diff changeset
  3934
claus
parents: 138
diff changeset
  3935
    self drawLeftEdgeLevel:level
claus
parents: 138
diff changeset
  3936
		    shadow:shadowColor 
claus
parents: 138
diff changeset
  3937
		     light:lightColor
claus
parents: 138
diff changeset
  3938
		     halfShadow:nil 
claus
parents: 138
diff changeset
  3939
		     halfLight:nil
claus
parents: 138
diff changeset
  3940
		     style:nil.
claus
parents: 138
diff changeset
  3941
!
claus
parents: 138
diff changeset
  3942
claus
parents: 138
diff changeset
  3943
drawRightEdge
claus
parents: 138
diff changeset
  3944
    "draw right 3D edge into window frame"
claus
parents: 138
diff changeset
  3945
claus
parents: 138
diff changeset
  3946
    self drawRightEdgeLevel:level
claus
parents: 138
diff changeset
  3947
		     shadow:shadowColor 
claus
parents: 138
diff changeset
  3948
		      light:lightColor
claus
parents: 138
diff changeset
  3949
		      halfShadow:nil 
claus
parents: 138
diff changeset
  3950
		      halfLight:nil
claus
parents: 138
diff changeset
  3951
		      style:nil.
claus
parents: 138
diff changeset
  3952
!
claus
parents: 138
diff changeset
  3953
claus
parents: 138
diff changeset
  3954
drawTopEdge
claus
parents: 138
diff changeset
  3955
    "draw top 3D edge into window frame"
claus
parents: 138
diff changeset
  3956
claus
parents: 138
diff changeset
  3957
    self drawTopEdgeLevel:level
claus
parents: 138
diff changeset
  3958
		   shadow:shadowColor 
claus
parents: 138
diff changeset
  3959
		    light:lightColor
claus
parents: 138
diff changeset
  3960
		    halfShadow:nil 
claus
parents: 138
diff changeset
  3961
		    halfLight:nil
claus
parents: 138
diff changeset
  3962
		    style:nil.
claus
parents: 138
diff changeset
  3963
!
claus
parents: 138
diff changeset
  3964
claus
parents: 138
diff changeset
  3965
drawEdges
claus
parents: 138
diff changeset
  3966
    "draw all of my 3D edges"
claus
parents: 138
diff changeset
  3967
claus
parents: 138
diff changeset
  3968
    self drawEdgesForX:0 y:0 width:width height:height level:level
claus
parents: 138
diff changeset
  3969
		shadow:shadowColor 
claus
parents: 138
diff changeset
  3970
		light:lightColor
claus
parents: 138
diff changeset
  3971
		halfShadow:nil 
claus
parents: 138
diff changeset
  3972
		halfLight:nil 
claus
parents: 138
diff changeset
  3973
		style:nil 
claus
parents: 138
diff changeset
  3974
!
claus
parents: 138
diff changeset
  3975
135
claus
parents:
diff changeset
  3976
drawEdgesForX:x y:y width:w height:h level:l 
claus
parents:
diff changeset
  3977
		shadow:shadowColor light:lightColor
claus
parents:
diff changeset
  3978
		halfShadow:halfShadowColor halfLight:halfLightColor
claus
parents:
diff changeset
  3979
		style:edgeStyle
claus
parents:
diff changeset
  3980
claus
parents:
diff changeset
  3981
    "draw 3D edges into a rectangle"
claus
parents:
diff changeset
  3982
claus
parents:
diff changeset
  3983
    |topLeftFg botRightFg topLeftHalfFg botRightHalfFg
claus
parents:
diff changeset
  3984
     count "{ Class: SmallInteger }"
claus
parents:
diff changeset
  3985
     r     "{ Class: SmallInteger }"
claus
parents:
diff changeset
  3986
     b     "{ Class: SmallInteger }"
claus
parents:
diff changeset
  3987
     xi    "{ Class: SmallInteger }"
claus
parents:
diff changeset
  3988
     yi    "{ Class: SmallInteger }"
claus
parents:
diff changeset
  3989
     run paint|
claus
parents:
diff changeset
  3990
claus
parents:
diff changeset
  3991
    count := l.
claus
parents:
diff changeset
  3992
    (count < 0) ifTrue:[
claus
parents:
diff changeset
  3993
	topLeftFg := shadowColor.
claus
parents:
diff changeset
  3994
	botRightFg := lightColor.
claus
parents:
diff changeset
  3995
	topLeftHalfFg := halfShadowColor.
claus
parents:
diff changeset
  3996
	botRightHalfFg := halfLightColor.
claus
parents:
diff changeset
  3997
	count := count negated
claus
parents:
diff changeset
  3998
    ] ifFalse:[
claus
parents:
diff changeset
  3999
	topLeftFg := lightColor.
claus
parents:
diff changeset
  4000
	botRightFg := shadowColor.
claus
parents:
diff changeset
  4001
	topLeftHalfFg := halfLightColor.
claus
parents:
diff changeset
  4002
	botRightHalfFg := halfShadowColor.
claus
parents:
diff changeset
  4003
    ].
claus
parents:
diff changeset
  4004
    topLeftHalfFg isNil ifTrue:[
claus
parents:
diff changeset
  4005
	topLeftHalfFg := topLeftFg
claus
parents:
diff changeset
  4006
    ].
claus
parents:
diff changeset
  4007
    botRightHalfFg isNil ifTrue:[
claus
parents:
diff changeset
  4008
	botRightHalfFg := botRightFg
claus
parents:
diff changeset
  4009
    ].
claus
parents:
diff changeset
  4010
claus
parents:
diff changeset
  4011
    r := x + w - 1. "right"
claus
parents:
diff changeset
  4012
    b := y + h - 1. "bottom"
claus
parents:
diff changeset
  4013
claus
parents:
diff changeset
  4014
    super lineWidth:0.
claus
parents:
diff changeset
  4015
claus
parents:
diff changeset
  4016
    "top and left edges"
151
claus
parents: 145
diff changeset
  4017
    ((edgeStyle == #soft) and:["l" count > 0]) ifTrue:[
135
claus
parents:
diff changeset
  4018
	paint := topLeftHalfFg
claus
parents:
diff changeset
  4019
    ] ifFalse:[
claus
parents:
diff changeset
  4020
	paint := topLeftFg
claus
parents:
diff changeset
  4021
    ].
claus
parents:
diff changeset
  4022
    super paint:paint.
claus
parents:
diff changeset
  4023
claus
parents:
diff changeset
  4024
    0 to:(count - 1) do:[:i |
claus
parents:
diff changeset
  4025
	run := y + i.
claus
parents:
diff changeset
  4026
	super displayDeviceLineFromX:x y:run toX:r y:run. "top"
claus
parents:
diff changeset
  4027
	run := x + i.
claus
parents:
diff changeset
  4028
	super displayDeviceLineFromX:run y:y toX:run y:b  "left"
claus
parents:
diff changeset
  4029
    ].
claus
parents:
diff changeset
  4030
    (edgeStyle == #soft) ifTrue:[
claus
parents:
diff changeset
  4031
"
claus
parents:
diff changeset
  4032
	super paint:topLeftFg.
claus
parents:
diff changeset
  4033
	super displayDeviceLineFromX:x y:y toX:r y:y. 
claus
parents:
diff changeset
  4034
	super displayDeviceLineFromX:x y:y toX:x y:b        
claus
parents:
diff changeset
  4035
"
claus
parents:
diff changeset
  4036
	(l > 2) ifTrue:[
claus
parents:
diff changeset
  4037
	    super paint:Black.
claus
parents:
diff changeset
  4038
	    super displayDeviceLineFromX:x y:y toX:r y:y. 
claus
parents:
diff changeset
  4039
	    super displayDeviceLineFromX:x y:y toX:x y:b. 
claus
parents:
diff changeset
  4040
	]
claus
parents:
diff changeset
  4041
    ].
claus
parents:
diff changeset
  4042
claus
parents:
diff changeset
  4043
    xi := x + 1.
claus
parents:
diff changeset
  4044
    yi := y + 1.
claus
parents:
diff changeset
  4045
claus
parents:
diff changeset
  4046
"/ does not look good
claus
parents:
diff changeset
  4047
"/ style == #st80 iftrue:[
claus
parents:
diff changeset
  4048
"/  yi := yi + 1
claus
parents:
diff changeset
  4049
"/ ].
claus
parents:
diff changeset
  4050
claus
parents:
diff changeset
  4051
    "bottom and right edges"
151
claus
parents: 145
diff changeset
  4052
    (edgeStyle == #soft "new:" and:[count > 1]) ifTrue:[
135
claus
parents:
diff changeset
  4053
	paint := botRightHalfFg
claus
parents:
diff changeset
  4054
    ] ifFalse:[
claus
parents:
diff changeset
  4055
	paint := botRightFg
claus
parents:
diff changeset
  4056
    ].
claus
parents:
diff changeset
  4057
claus
parents:
diff changeset
  4058
    super paint:paint.
claus
parents:
diff changeset
  4059
    0 to:(count - 1) do:[:i |
claus
parents:
diff changeset
  4060
	run := b - i.
claus
parents:
diff changeset
  4061
	super displayDeviceLineFromX:xi-1 y:run toX:r y:run. "bottom"
claus
parents:
diff changeset
  4062
	run := r - i.
claus
parents:
diff changeset
  4063
	super displayDeviceLineFromX:run y:yi-1 toX:run y:b.  "right"
claus
parents:
diff changeset
  4064
	xi := xi + 1.
claus
parents:
diff changeset
  4065
	yi := yi + 1
claus
parents:
diff changeset
  4066
    ].
claus
parents:
diff changeset
  4067
    ((edgeStyle == #soft) and:[l > 1]) ifTrue:[
claus
parents:
diff changeset
  4068
	super paint:Black "shadowColor".
154
claus
parents: 153
diff changeset
  4069
	super displayDeviceLineFromX:(x + (1 - 1)) y:b toX:r y:b. 
claus
parents: 153
diff changeset
  4070
	super displayDeviceLineFromX:r y:(y + (1 - 1)) toX:r y:b        
135
claus
parents:
diff changeset
  4071
    ]
claus
parents:
diff changeset
  4072
!
claus
parents:
diff changeset
  4073
claus
parents:
diff changeset
  4074
drawTopEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle 
claus
parents:
diff changeset
  4075
    |topFg topHalfFg paint r
claus
parents:
diff changeset
  4076
     count "{ Class: SmallInteger }" |
claus
parents:
diff changeset
  4077
claus
parents:
diff changeset
  4078
    count := level.
claus
parents:
diff changeset
  4079
    count == 0 ifTrue:[^ self].
claus
parents:
diff changeset
  4080
claus
parents:
diff changeset
  4081
    (count < 0) ifTrue:[
claus
parents:
diff changeset
  4082
	topFg := shadowColor.
claus
parents:
diff changeset
  4083
	topHalfFg := halfShadowColor.
claus
parents:
diff changeset
  4084
	count := count negated
claus
parents:
diff changeset
  4085
    ] ifFalse:[
claus
parents:
diff changeset
  4086
	topFg := lightColor.
claus
parents:
diff changeset
  4087
	topHalfFg := halfLightColor.
claus
parents:
diff changeset
  4088
    ].
claus
parents:
diff changeset
  4089
    topHalfFg isNil ifTrue:[
claus
parents:
diff changeset
  4090
	topHalfFg := topFg
claus
parents:
diff changeset
  4091
    ].
claus
parents:
diff changeset
  4092
claus
parents:
diff changeset
  4093
    ((edgeStyle == #soft) and:[level > 0]) ifTrue:[
claus
parents:
diff changeset
  4094
	paint := topHalfFg
claus
parents:
diff changeset
  4095
    ] ifFalse:[
claus
parents:
diff changeset
  4096
	paint := topFg
claus
parents:
diff changeset
  4097
    ].
claus
parents:
diff changeset
  4098
    super paint:paint.
claus
parents:
diff changeset
  4099
    super lineWidth:0.
claus
parents:
diff changeset
  4100
claus
parents:
diff changeset
  4101
    r := width - 1.
claus
parents:
diff changeset
  4102
    0 to:(count - 1) do:[:i |
claus
parents:
diff changeset
  4103
	super displayDeviceLineFromX:i y:i toX:(r - i) y:i
claus
parents:
diff changeset
  4104
    ].
claus
parents:
diff changeset
  4105
    ((edgeStyle == #soft) and:[level > 2]) ifTrue:[
claus
parents:
diff changeset
  4106
	super paint:Black.
claus
parents:
diff changeset
  4107
	super displayDeviceLineFromX:0 y:0 toX:r y:0. 
claus
parents:
diff changeset
  4108
    ]
claus
parents:
diff changeset
  4109
!
claus
parents:
diff changeset
  4110
claus
parents:
diff changeset
  4111
drawBottomEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle
claus
parents:
diff changeset
  4112
    |botFg
claus
parents:
diff changeset
  4113
     count "{ Class: SmallInteger }" 
claus
parents:
diff changeset
  4114
     b r|
claus
parents:
diff changeset
  4115
claus
parents:
diff changeset
  4116
    count := level.
claus
parents:
diff changeset
  4117
    count == 0 ifTrue:[^ self].
claus
parents:
diff changeset
  4118
claus
parents:
diff changeset
  4119
    (count < 0) ifTrue:[
claus
parents:
diff changeset
  4120
	botFg := lightColor.
claus
parents:
diff changeset
  4121
	count := count negated
claus
parents:
diff changeset
  4122
    ] ifFalse:[
claus
parents:
diff changeset
  4123
	((edgeStyle == #soft) and:[level > 1]) ifTrue:[
claus
parents:
diff changeset
  4124
	    botFg := halfShadowColor
claus
parents:
diff changeset
  4125
	] ifFalse:[
claus
parents:
diff changeset
  4126
	    botFg := shadowColor
claus
parents:
diff changeset
  4127
	].
claus
parents:
diff changeset
  4128
    ].
claus
parents:
diff changeset
  4129
    super paint:botFg.
claus
parents:
diff changeset
  4130
    super lineWidth:0.
claus
parents:
diff changeset
  4131
claus
parents:
diff changeset
  4132
    r := width - 1.
claus
parents:
diff changeset
  4133
    0 to:(count - 1) do:[:i |
claus
parents:
diff changeset
  4134
	b := height - 1 - i.
claus
parents:
diff changeset
  4135
	super displayDeviceLineFromX:i y:b toX:(r - i) y:b
claus
parents:
diff changeset
  4136
    ].
claus
parents:
diff changeset
  4137
claus
parents:
diff changeset
  4138
    ((edgeStyle == #soft) and:[level > 1]) ifTrue:[
claus
parents:
diff changeset
  4139
	b := height - 1.
claus
parents:
diff changeset
  4140
	super paint:shadowColor.
claus
parents:
diff changeset
  4141
	super displayDeviceLineFromX:1 y:b toX:r y:b. 
claus
parents:
diff changeset
  4142
    ]
claus
parents:
diff changeset
  4143
!
claus
parents:
diff changeset
  4144
claus
parents:
diff changeset
  4145
drawLeftEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle 
claus
parents:
diff changeset
  4146
    |leftFg leftHalfFg paint b
claus
parents:
diff changeset
  4147
     count "{ Class: SmallInteger }" |
claus
parents:
diff changeset
  4148
claus
parents:
diff changeset
  4149
    count := level.
claus
parents:
diff changeset
  4150
    count == 0 ifTrue:[^ self].
claus
parents:
diff changeset
  4151
    
claus
parents:
diff changeset
  4152
    (count < 0) ifTrue:[
claus
parents:
diff changeset
  4153
	leftFg := shadowColor.
claus
parents:
diff changeset
  4154
	leftHalfFg := halfShadowColor.
claus
parents:
diff changeset
  4155
	count := count negated.
claus
parents:
diff changeset
  4156
    ] ifFalse:[
claus
parents:
diff changeset
  4157
	leftFg := lightColor.
claus
parents:
diff changeset
  4158
	leftHalfFg := halfLightColor.
claus
parents:
diff changeset
  4159
    ].
claus
parents:
diff changeset
  4160
    leftHalfFg isNil ifTrue:[
claus
parents:
diff changeset
  4161
	leftHalfFg := leftFg
claus
parents:
diff changeset
  4162
    ].
claus
parents:
diff changeset
  4163
claus
parents:
diff changeset
  4164
    ((edgeStyle == #soft) and:[level > 0]) ifTrue:[
claus
parents:
diff changeset
  4165
	paint := leftHalfFg
claus
parents:
diff changeset
  4166
    ] ifFalse:[
claus
parents:
diff changeset
  4167
	paint := leftFg
claus
parents:
diff changeset
  4168
    ].
claus
parents:
diff changeset
  4169
    super paint:paint.
claus
parents:
diff changeset
  4170
    super lineWidth:0.
claus
parents:
diff changeset
  4171
claus
parents:
diff changeset
  4172
    b := height - 1.
claus
parents:
diff changeset
  4173
    0 to:(count - 1) do:[:i |
claus
parents:
diff changeset
  4174
	super displayDeviceLineFromX:i y:i toX:i y:(b - i)
claus
parents:
diff changeset
  4175
    ].
claus
parents:
diff changeset
  4176
claus
parents:
diff changeset
  4177
    ((edgeStyle == #soft) and:[level > 2]) ifTrue:[
claus
parents:
diff changeset
  4178
	super paint:Black.
claus
parents:
diff changeset
  4179
	super displayDeviceLineFromX:0 y:0 toX:0 y:b. 
claus
parents:
diff changeset
  4180
    ]
claus
parents:
diff changeset
  4181
!
claus
parents:
diff changeset
  4182
140
claus
parents: 138
diff changeset
  4183
drawRightEdgeLevel:level shadow:shadowColor light:lightColor halfShadow:halfShadowColor halfLight:halfLightColor style:edgeStyle 
claus
parents: 138
diff changeset
  4184
    |rightFg
claus
parents: 138
diff changeset
  4185
     count "{ Class: SmallInteger }" 
claus
parents: 138
diff changeset
  4186
     r b|
claus
parents: 138
diff changeset
  4187
claus
parents: 138
diff changeset
  4188
    count := level.
claus
parents: 138
diff changeset
  4189
    count == 0 ifTrue:[^ self].
claus
parents: 138
diff changeset
  4190
claus
parents: 138
diff changeset
  4191
    (count < 0) ifTrue:[
claus
parents: 138
diff changeset
  4192
	rightFg := lightColor.
claus
parents: 138
diff changeset
  4193
	count := count negated
claus
parents: 138
diff changeset
  4194
    ] ifFalse:[
claus
parents: 138
diff changeset
  4195
	((edgeStyle == #soft) and:[level > 1]) ifTrue:[
claus
parents: 138
diff changeset
  4196
	    rightFg := halfShadowColor
claus
parents: 138
diff changeset
  4197
	] ifFalse:[
claus
parents: 138
diff changeset
  4198
	    rightFg := shadowColor
claus
parents: 138
diff changeset
  4199
	].
claus
parents: 138
diff changeset
  4200
    ].
claus
parents: 138
diff changeset
  4201
    super paint:rightFg.
claus
parents: 138
diff changeset
  4202
    super lineWidth:0.
claus
parents: 138
diff changeset
  4203
claus
parents: 138
diff changeset
  4204
    b := height - 1.
claus
parents: 138
diff changeset
  4205
    0 to:(count - 1) do:[:i |
claus
parents: 138
diff changeset
  4206
	r := width - 1 - i.
claus
parents: 138
diff changeset
  4207
	super displayDeviceLineFromX:r y:i toX:r y:(b - i)
claus
parents: 138
diff changeset
  4208
    ].
claus
parents: 138
diff changeset
  4209
    ((edgeStyle == #soft) and:[level > 1]) ifTrue:[
claus
parents: 138
diff changeset
  4210
	r := width - 1.
claus
parents: 138
diff changeset
  4211
	super paint:shadowColor.
claus
parents: 138
diff changeset
  4212
	super displayDeviceLineFromX:r y:1 toX:r y:b. 
claus
parents: 138
diff changeset
  4213
    ]
claus
parents: 138
diff changeset
  4214
!
claus
parents: 138
diff changeset
  4215
135
claus
parents:
diff changeset
  4216
drawEdgesForX:x y:y width:w height:h level:l
claus
parents:
diff changeset
  4217
    "draw 3D edges into a rectangle"
claus
parents:
diff changeset
  4218
claus
parents:
diff changeset
  4219
    self drawEdgesForX:x y:y width:w height:h level:l 
claus
parents:
diff changeset
  4220
		shadow:shadowColor 
claus
parents:
diff changeset
  4221
		light:lightColor
claus
parents:
diff changeset
  4222
		halfShadow:nil 
claus
parents:
diff changeset
  4223
		halfLight:nil 
claus
parents:
diff changeset
  4224
		style:nil 
claus
parents:
diff changeset
  4225
!
claus
parents:
diff changeset
  4226
151
claus
parents: 145
diff changeset
  4227
redrawEdges
claus
parents: 145
diff changeset
  4228
    "redraw my edges (if any)"
claus
parents: 145
diff changeset
  4229
claus
parents: 145
diff changeset
  4230
    (level ~~ 0) ifTrue:[
claus
parents: 145
diff changeset
  4231
	shown ifTrue:[
claus
parents: 145
diff changeset
  4232
	    self clipRect:nil.
claus
parents: 145
diff changeset
  4233
	    self drawEdges.
claus
parents: 145
diff changeset
  4234
	    self clipRect:innerClipRect
claus
parents: 145
diff changeset
  4235
	]                  
claus
parents: 145
diff changeset
  4236
    ]                  
claus
parents: 145
diff changeset
  4237
! !
claus
parents: 145
diff changeset
  4238
claus
parents: 145
diff changeset
  4239
!SimpleView methodsFor:'redrawing'!
claus
parents: 145
diff changeset
  4240
claus
parents: 145
diff changeset
  4241
redrawX:x y:y width:w height:h
claus
parents: 145
diff changeset
  4242
    "have to redraw part of myself, given logical coordinates (if trans is nonNil)
claus
parents: 145
diff changeset
  4243
     default is to redraw everything - subclasses should add intelligence"
claus
parents: 145
diff changeset
  4244
claus
parents: 145
diff changeset
  4245
    |area|
claus
parents: 145
diff changeset
  4246
claus
parents: 145
diff changeset
  4247
    shown ifFalse:[^ self].
claus
parents: 145
diff changeset
  4248
claus
parents: 145
diff changeset
  4249
    area := Rectangle left:x top:y width:w height:h.      
claus
parents: 145
diff changeset
  4250
    self clippedTo:area do:[
claus
parents: 145
diff changeset
  4251
"/        controller notNil ifTrue:[
claus
parents: 145
diff changeset
  4252
"/            "ST-80 updating"
claus
parents: 145
diff changeset
  4253
"/            self update:#rectangle with:area
claus
parents: 145
diff changeset
  4254
"/        ] ifFalse:[
claus
parents: 145
diff changeset
  4255
	    components notNil ifTrue:[
claus
parents: 145
diff changeset
  4256
		components do:[:aComponent |
claus
parents: 145
diff changeset
  4257
		    |thisFrame is|
claus
parents: 145
diff changeset
  4258
claus
parents: 145
diff changeset
  4259
		    thisFrame := aComponent frame.
claus
parents: 145
diff changeset
  4260
		    (thisFrame intersects:area) ifTrue:[
claus
parents: 145
diff changeset
  4261
			is := thisFrame intersect:(x@y extent:w@h).
claus
parents: 145
diff changeset
  4262
			is = thisFrame ifTrue:[
claus
parents: 145
diff changeset
  4263
			    aComponent redraw
claus
parents: 145
diff changeset
  4264
			] ifFalse:[
claus
parents: 145
diff changeset
  4265
			    aComponent redrawX:is left
claus
parents: 145
diff changeset
  4266
					     y:is top
claus
parents: 145
diff changeset
  4267
					 width:is width
claus
parents: 145
diff changeset
  4268
					height:is height.
claus
parents: 145
diff changeset
  4269
			].        
claus
parents: 145
diff changeset
  4270
			"/ aComponent drawIn:self offset:0@0
claus
parents: 145
diff changeset
  4271
		    ]
claus
parents: 145
diff changeset
  4272
		]
claus
parents: 145
diff changeset
  4273
	    ] ifFalse:[
claus
parents: 145
diff changeset
  4274
		self redraw
claus
parents: 145
diff changeset
  4275
	    ]
claus
parents: 145
diff changeset
  4276
"/        ]
claus
parents: 145
diff changeset
  4277
    ]                                                              
claus
parents: 145
diff changeset
  4278
!
claus
parents: 145
diff changeset
  4279
claus
parents: 145
diff changeset
  4280
redraw
claus
parents: 145
diff changeset
  4281
    "redraw myself
claus
parents: 145
diff changeset
  4282
     cannot do much here - has to be redefined in subclasses"
claus
parents: 145
diff changeset
  4283
claus
parents: 145
diff changeset
  4284
!
claus
parents: 145
diff changeset
  4285
135
claus
parents:
diff changeset
  4286
redrawDeviceX:x y:y width:w height:h
claus
parents:
diff changeset
  4287
    "have to redraw part of the view.
claus
parents:
diff changeset
  4288
     The coordinates are in device space - if there is a transformation,
claus
parents:
diff changeset
  4289
     must inverse-transform back to logical coordinates. (since the view thinks
claus
parents:
diff changeset
  4290
     in its coordinate space)"
claus
parents:
diff changeset
  4291
claus
parents:
diff changeset
  4292
    |lx ly lw lh|
claus
parents:
diff changeset
  4293
claus
parents:
diff changeset
  4294
    lx := x.
claus
parents:
diff changeset
  4295
    ly := y.
claus
parents:
diff changeset
  4296
    lw := w.
claus
parents:
diff changeset
  4297
    lh := h.
claus
parents:
diff changeset
  4298
claus
parents:
diff changeset
  4299
    transformation notNil ifTrue:[
claus
parents:
diff changeset
  4300
	lx := transformation applyInverseToX:lx.
claus
parents:
diff changeset
  4301
	ly := transformation applyInverseToY:ly.
claus
parents:
diff changeset
  4302
	lw := transformation applyInverseScaleX:lw.
claus
parents:
diff changeset
  4303
	lh := transformation applyInverseScaleY:lh.
claus
parents:
diff changeset
  4304
    ].
claus
parents:
diff changeset
  4305
    self redrawX:lx y:ly width:lw height:lh
claus
parents:
diff changeset
  4306
!
claus
parents:
diff changeset
  4307
claus
parents:
diff changeset
  4308
showFocus
claus
parents:
diff changeset
  4309
    "highlight myself somehow to tell user that I have the focus"
claus
parents:
diff changeset
  4310
claus
parents:
diff changeset
  4311
    |delta|
claus
parents:
diff changeset
  4312
claus
parents:
diff changeset
  4313
    drawableId notNil ifTrue:[
claus
parents:
diff changeset
  4314
	delta := DefaultFocusBorderWidth - borderWidth.
claus
parents:
diff changeset
  4315
	delta ~~ 0 ifTrue:[
claus
parents:
diff changeset
  4316
	    device moveWindow:drawableId x:left-delta y:top-delta
claus
parents:
diff changeset
  4317
	].
claus
parents:
diff changeset
  4318
	device setWindowBorderWidth:DefaultFocusBorderWidth in:drawableId.
claus
parents:
diff changeset
  4319
	device setWindowBorderColor:(DefaultFocusColor on:device) colorId in:drawableId.
claus
parents:
diff changeset
  4320
    ]
claus
parents:
diff changeset
  4321
!
claus
parents:
diff changeset
  4322
claus
parents:
diff changeset
  4323
showNoFocus
claus
parents:
diff changeset
  4324
    "undo the effect of showFocus"
claus
parents:
diff changeset
  4325
claus
parents:
diff changeset
  4326
    |delta|
claus
parents:
diff changeset
  4327
claus
parents:
diff changeset
  4328
    drawableId notNil ifTrue:[
claus
parents:
diff changeset
  4329
	delta := DefaultFocusBorderWidth - borderWidth.
claus
parents:
diff changeset
  4330
	delta ~~ 0 ifTrue:[
claus
parents:
diff changeset
  4331
	    device moveWindow:drawableId x:left+delta y:top+delta
claus
parents:
diff changeset
  4332
	].
claus
parents:
diff changeset
  4333
	device setWindowBorderWidth:borderWidth in:drawableId.
claus
parents:
diff changeset
  4334
	self setBorderColor.
claus
parents:
diff changeset
  4335
    ]
claus
parents:
diff changeset
  4336
!
claus
parents:
diff changeset
  4337
claus
parents:
diff changeset
  4338
showActive
claus
parents:
diff changeset
  4339
    "redraw myself as active (i.e. busy).
151
claus
parents: 145
diff changeset
  4340
     Nothing done here, but redefined in some classes."
135
claus
parents:
diff changeset
  4341
claus
parents:
diff changeset
  4342
    ^ self
claus
parents:
diff changeset
  4343
!
claus
parents:
diff changeset
  4344
claus
parents:
diff changeset
  4345
showPassive
claus
parents:
diff changeset
  4346
    "redraw myself as inactive (i.e. nonbusy).
151
claus
parents: 145
diff changeset
  4347
     Nothing done here, but redefined in some classes."
135
claus
parents:
diff changeset
  4348
claus
parents:
diff changeset
  4349
    ^ self
claus
parents:
diff changeset
  4350
! !
claus
parents:
diff changeset
  4351
140
claus
parents: 138
diff changeset
  4352
!SimpleView methodsFor:'accessing-hierarchy'!
claus
parents: 138
diff changeset
  4353
claus
parents: 138
diff changeset
  4354
superView:aView
claus
parents: 138
diff changeset
  4355
    "set my superView to be aView"
claus
parents: 138
diff changeset
  4356
claus
parents: 138
diff changeset
  4357
    superView := aView
claus
parents: 138
diff changeset
  4358
!
claus
parents: 138
diff changeset
  4359
claus
parents: 138
diff changeset
  4360
superView
claus
parents: 138
diff changeset
  4361
    "return my superView"
claus
parents: 138
diff changeset
  4362
claus
parents: 138
diff changeset
  4363
    ^ superView
claus
parents: 138
diff changeset
  4364
!
claus
parents: 138
diff changeset
  4365
claus
parents: 138
diff changeset
  4366
subViews
claus
parents: 138
diff changeset
  4367
    "return the collection of subviews"
claus
parents: 138
diff changeset
  4368
claus
parents: 138
diff changeset
  4369
    ^ subViews
claus
parents: 138
diff changeset
  4370
!
claus
parents: 138
diff changeset
  4371
claus
parents: 138
diff changeset
  4372
topView
claus
parents: 138
diff changeset
  4373
    "return the topView - thats the one with no superview"
claus
parents: 138
diff changeset
  4374
claus
parents: 138
diff changeset
  4375
    |v|
claus
parents: 138
diff changeset
  4376
claus
parents: 138
diff changeset
  4377
    v := self.
claus
parents: 138
diff changeset
  4378
    [v notNil] whileTrue:[
claus
parents: 138
diff changeset
  4379
	v superView isNil ifTrue:[^ v].
claus
parents: 138
diff changeset
  4380
	v := v superView
claus
parents: 138
diff changeset
  4381
    ].
claus
parents: 138
diff changeset
  4382
claus
parents: 138
diff changeset
  4383
    ^ nil
claus
parents: 138
diff changeset
  4384
!
claus
parents: 138
diff changeset
  4385
claus
parents: 138
diff changeset
  4386
subViews:aListOfViews
claus
parents: 138
diff changeset
  4387
    "set the collection of subviews"
claus
parents: 138
diff changeset
  4388
claus
parents: 138
diff changeset
  4389
    subViews := aListOfViews.
claus
parents: 138
diff changeset
  4390
    subViews notNil ifTrue:[
claus
parents: 138
diff changeset
  4391
	subViews do:[:view |
claus
parents: 138
diff changeset
  4392
	    view superView:self
claus
parents: 138
diff changeset
  4393
	]
claus
parents: 138
diff changeset
  4394
    ]
153
claus
parents: 151
diff changeset
  4395
!
claus
parents: 151
diff changeset
  4396
claus
parents: 151
diff changeset
  4397
raise
claus
parents: 151
diff changeset
  4398
    "bring to front"
claus
parents: 151
diff changeset
  4399
claus
parents: 151
diff changeset
  4400
    drawableId isNil ifTrue:[self create].
claus
parents: 151
diff changeset
  4401
    device raiseWindow:drawableId
claus
parents: 151
diff changeset
  4402
claus
parents: 151
diff changeset
  4403
    "
claus
parents: 151
diff changeset
  4404
     Transcript topView raise
claus
parents: 151
diff changeset
  4405
    "
claus
parents: 151
diff changeset
  4406
!
claus
parents: 151
diff changeset
  4407
claus
parents: 151
diff changeset
  4408
lower
claus
parents: 151
diff changeset
  4409
    "bring to back"
claus
parents: 151
diff changeset
  4410
claus
parents: 151
diff changeset
  4411
    drawableId isNil ifTrue:[self create].
claus
parents: 151
diff changeset
  4412
    device lowerWindow:drawableId
claus
parents: 151
diff changeset
  4413
claus
parents: 151
diff changeset
  4414
    "
claus
parents: 151
diff changeset
  4415
     Transcript topView lower
claus
parents: 151
diff changeset
  4416
    "
140
claus
parents: 138
diff changeset
  4417
! !
claus
parents: 138
diff changeset
  4418
claus
parents: 138
diff changeset
  4419
!SimpleView methodsFor:'initialization'!
claus
parents: 138
diff changeset
  4420
claus
parents: 138
diff changeset
  4421
initEvents
claus
parents: 138
diff changeset
  4422
    "will be sent by create - can be redefined by subclasses to enable
claus
parents: 138
diff changeset
  4423
     view events"
135
claus
parents:
diff changeset
  4424
claus
parents:
diff changeset
  4425
    ^ self
claus
parents:
diff changeset
  4426
!
claus
parents:
diff changeset
  4427
140
claus
parents: 138
diff changeset
  4428
defaultControllerClass
claus
parents: 138
diff changeset
  4429
    ^ nil "/ Controller
claus
parents: 138
diff changeset
  4430
!
claus
parents: 138
diff changeset
  4431
173
claus
parents: 162
diff changeset
  4432
initStyleSheet
claus
parents: 162
diff changeset
  4433
    "this method gets the styleSheet"
140
claus
parents: 138
diff changeset
  4434
claus
parents: 138
diff changeset
  4435
    "
claus
parents: 138
diff changeset
  4436
     when coming here the first time, we read the styleSheet
claus
parents: 138
diff changeset
  4437
     and keep the values in fast class variables
claus
parents: 138
diff changeset
  4438
    "
claus
parents: 138
diff changeset
  4439
    StyleSheet isNil ifTrue:[
claus
parents: 138
diff changeset
  4440
	self class updateStyleCache
135
claus
parents:
diff changeset
  4441
    ].
claus
parents:
diff changeset
  4442
151
claus
parents: 145
diff changeset
  4443
    styleSheet := StyleSheet.
173
claus
parents: 162
diff changeset
  4444
!
claus
parents: 162
diff changeset
  4445
claus
parents: 162
diff changeset
  4446
initStyle
claus
parents: 162
diff changeset
  4447
    "this method sets up all style dependent things"
claus
parents: 162
diff changeset
  4448
claus
parents: 162
diff changeset
  4449
    self initStyleSheet.
140
claus
parents: 138
diff changeset
  4450
claus
parents: 138
diff changeset
  4451
    borderWidth := DefaultBorderWidth.
claus
parents: 138
diff changeset
  4452
    borderWidth isNil ifTrue:[borderWidth := 1].
claus
parents: 138
diff changeset
  4453
151
claus
parents: 145
diff changeset
  4454
    viewBackground := DefaultViewBackgroundColor.
140
claus
parents: 138
diff changeset
  4455
claus
parents: 138
diff changeset
  4456
    DefaultLightColor notNil ifTrue:[
claus
parents: 138
diff changeset
  4457
	lightColor := DefaultLightColor.
claus
parents: 138
diff changeset
  4458
    ] ifFalse:[
claus
parents: 138
diff changeset
  4459
	device hasGreyscales ifTrue:[
claus
parents: 138
diff changeset
  4460
	    DefaultLightColor := lightColor := viewBackground lightened.
claus
parents: 138
diff changeset
  4461
	] ifFalse:[
135
claus
parents:
diff changeset
  4462
	    "
151
claus
parents: 145
diff changeset
  4463
	     this seems strange: on B&W screens, we create the light color 
claus
parents: 145
diff changeset
  4464
	     darker than normal viewBackground (White) -
claus
parents: 145
diff changeset
  4465
	     to make the boundary of the view visible
135
claus
parents:
diff changeset
  4466
	    "
140
claus
parents: 138
diff changeset
  4467
	    lightColor := Color grey:50
135
claus
parents:
diff changeset
  4468
	]
claus
parents:
diff changeset
  4469
    ].
140
claus
parents: 138
diff changeset
  4470
    DefaultShadowColor notNil ifTrue:[
claus
parents: 138
diff changeset
  4471
	shadowColor := DefaultShadowColor.
claus
parents: 138
diff changeset
  4472
    ] ifFalse:[
claus
parents: 138
diff changeset
  4473
	shadowColor := Black
135
claus
parents:
diff changeset
  4474
    ].
140
claus
parents: 138
diff changeset
  4475
151
claus
parents: 145
diff changeset
  4476
    lightColor := lightColor.
claus
parents: 145
diff changeset
  4477
    shadowColor := shadowColor.
claus
parents: 145
diff changeset
  4478
    borderColor := DefaultBorderColor.
claus
parents: 145
diff changeset
  4479
    font := DefaultFont.
140
claus
parents: 138
diff changeset
  4480
!
claus
parents: 138
diff changeset
  4481
claus
parents: 138
diff changeset
  4482
initialize
claus
parents: 138
diff changeset
  4483
    "initialize all state of the view - usually redefined in subclasses,
claus
parents: 138
diff changeset
  4484
     but always doing a 'super initialize'. Each class should setup its
claus
parents: 138
diff changeset
  4485
     locals - and not forget the others.
claus
parents: 138
diff changeset
  4486
     View setup is separated into two parts, the general setup done here
claus
parents: 138
diff changeset
  4487
     and the style specific setup in initStyle. Each view should be prepared
claus
parents: 138
diff changeset
  4488
     for a stylechange by being sent another initStyle with a new style value.
claus
parents: 138
diff changeset
  4489
     (in this case, it should set all of its style-dependent things, but
claus
parents: 138
diff changeset
  4490
      leave the state and contents as-is)"
claus
parents: 138
diff changeset
  4491
144
claus
parents: 142
diff changeset
  4492
    |ext myClass controllerClass|
140
claus
parents: 138
diff changeset
  4493
claus
parents: 138
diff changeset
  4494
    super initialize.
claus
parents: 138
diff changeset
  4495
claus
parents: 138
diff changeset
  4496
    font := DefaultFont.
claus
parents: 138
diff changeset
  4497
151
claus
parents: 145
diff changeset
  4498
    shown := hiddenOnRealize := realized := false.
140
claus
parents: 138
diff changeset
  4499
claus
parents: 138
diff changeset
  4500
    "fill in some defaults - some of them are usually redefined in subclasses
claus
parents: 138
diff changeset
  4501
     initialize methods"
claus
parents: 138
diff changeset
  4502
144
claus
parents: 142
diff changeset
  4503
    myClass := self class.
claus
parents: 142
diff changeset
  4504
    name := myClass name "asString" asLowercaseFirst.
claus
parents: 142
diff changeset
  4505
    ext := myClass defaultExtent.
claus
parents: 142
diff changeset
  4506
    resources := myClass classResources.
claus
parents: 142
diff changeset
  4507
claus
parents: 142
diff changeset
  4508
    level := margin := 0.
140
claus
parents: 138
diff changeset
  4509
    margin := 0.
claus
parents: 138
diff changeset
  4510
claus
parents: 138
diff changeset
  4511
    self initStyle.
claus
parents: 138
diff changeset
  4512
144
claus
parents: 142
diff changeset
  4513
    left := top := 0.
140
claus
parents: 138
diff changeset
  4514
    width := ext x.
claus
parents: 138
diff changeset
  4515
    height := ext y.
claus
parents: 138
diff changeset
  4516
claus
parents: 138
diff changeset
  4517
    originChanged := extentChanged := false.
claus
parents: 138
diff changeset
  4518
    bitGravity := nil.
claus
parents: 138
diff changeset
  4519
    viewGravity := nil.
claus
parents: 138
diff changeset
  4520
claus
parents: 138
diff changeset
  4521
    controllerClass := self defaultControllerClass.
claus
parents: 138
diff changeset
  4522
    controllerClass notNil ifTrue:[
claus
parents: 138
diff changeset
  4523
	controller := controllerClass new.
claus
parents: 138
diff changeset
  4524
	controller view:self.
135
claus
parents:
diff changeset
  4525
    ].
140
claus
parents: 138
diff changeset
  4526
!
claus
parents: 138
diff changeset
  4527
claus
parents: 138
diff changeset
  4528
prepareForReinit
claus
parents: 138
diff changeset
  4529
    super prepareForReinit.
claus
parents: 138
diff changeset
  4530
    windowGroup notNil ifTrue:[
claus
parents: 138
diff changeset
  4531
	windowGroup reinitialize
135
claus
parents:
diff changeset
  4532
    ]
claus
parents:
diff changeset
  4533
!
claus
parents:
diff changeset
  4534
140
claus
parents: 138
diff changeset
  4535
reinitialize
claus
parents: 138
diff changeset
  4536
    "this is called right snapIn"
claus
parents: 138
diff changeset
  4537
claus
parents: 138
diff changeset
  4538
    |myController|
claus
parents: 138
diff changeset
  4539
claus
parents: 138
diff changeset
  4540
    "if I have already been reinited - return"
claus
parents: 138
diff changeset
  4541
    drawableId notNil ifTrue:[
claus
parents: 138
diff changeset
  4542
	^ self
135
claus
parents:
diff changeset
  4543
    ].
claus
parents:
diff changeset
  4544
140
claus
parents: 138
diff changeset
  4545
    "
claus
parents: 138
diff changeset
  4546
     superView must be there, first
claus
parents: 138
diff changeset
  4547
    "
claus
parents: 138
diff changeset
  4548
    superView notNil ifTrue:[
claus
parents: 138
diff changeset
  4549
	superView id isNil ifTrue:[
claus
parents: 138
diff changeset
  4550
	    superView reinitialize
135
claus
parents:
diff changeset
  4551
	]
claus
parents:
diff changeset
  4552
    ].
140
claus
parents: 138
diff changeset
  4553
claus
parents: 138
diff changeset
  4554
    myController := controller.
claus
parents: 138
diff changeset
  4555
    controller := nil.
claus
parents: 138
diff changeset
  4556
    self recreate.
claus
parents: 138
diff changeset
  4557
claus
parents: 138
diff changeset
  4558
    "if I was mapped, do it again"
claus
parents: 138
diff changeset
  4559
    realized ifTrue:[
claus
parents: 138
diff changeset
  4560
	"only remap if I have a superview - otherwise, I might be
claus
parents: 138
diff changeset
  4561
	 a hidden iconView or menu ..."
claus
parents: 138
diff changeset
  4562
	superView notNil ifTrue:[
claus
parents: 138
diff changeset
  4563
"/            shown ifTrue:[
claus
parents: 138
diff changeset
  4564
		device mapView:self id:drawableId iconified:false
claus
parents: 138
diff changeset
  4565
			   atX:left y:top width:width height:height
claus
parents: 138
diff changeset
  4566
"/            ].
claus
parents: 138
diff changeset
  4567
	].
135
claus
parents:
diff changeset
  4568
    ].
140
claus
parents: 138
diff changeset
  4569
claus
parents: 138
diff changeset
  4570
    "restore controller"
claus
parents: 138
diff changeset
  4571
    controller := myController
claus
parents: 138
diff changeset
  4572
!
claus
parents: 138
diff changeset
  4573
claus
parents: 138
diff changeset
  4574
reinitStyle
claus
parents: 138
diff changeset
  4575
    "this method is called for a style change"
claus
parents: 138
diff changeset
  4576
claus
parents: 138
diff changeset
  4577
    |t|
claus
parents: 138
diff changeset
  4578
claus
parents: 138
diff changeset
  4579
    self initStyle.
claus
parents: 138
diff changeset
  4580
    drawableId notNil ifTrue:[
claus
parents: 138
diff changeset
  4581
	"force a change"
claus
parents: 138
diff changeset
  4582
	t := borderWidth. borderWidth := nil. self borderWidth:t.
claus
parents: 138
diff changeset
  4583
	t := viewBackground. viewBackground := nil. self viewBackground:t.
claus
parents: 138
diff changeset
  4584
	self clear.
claus
parents: 138
diff changeset
  4585
	self redraw
135
claus
parents:
diff changeset
  4586
    ].
151
claus
parents: 145
diff changeset
  4587
!
claus
parents: 145
diff changeset
  4588
claus
parents: 145
diff changeset
  4589
initializeMiddleButtonMenu
claus
parents: 145
diff changeset
  4590
    "a place to initialize menu - this one is sent once when the view is
claus
parents: 145
diff changeset
  4591
     first created; usually redefined in subclasses; default here is no menu.
claus
parents: 145
diff changeset
  4592
     Notice, that static middleButtonmenus are a historic thing in ST/X;
claus
parents: 145
diff changeset
  4593
     you may prefer to create the menu dynamically (i.e. the ST-80 way)."
claus
parents: 145
diff changeset
  4594
claus
parents: 145
diff changeset
  4595
    ^ self
140
claus
parents: 138
diff changeset
  4596
! !
claus
parents: 138
diff changeset
  4597
claus
parents: 138
diff changeset
  4598
!SimpleView methodsFor:'accessing-bg & border'!
claus
parents: 138
diff changeset
  4599
claus
parents: 138
diff changeset
  4600
borderWidth
claus
parents: 138
diff changeset
  4601
    "return my borderWidth"
claus
parents: 138
diff changeset
  4602
claus
parents: 138
diff changeset
  4603
    ^ borderWidth
claus
parents: 138
diff changeset
  4604
!
claus
parents: 138
diff changeset
  4605
claus
parents: 138
diff changeset
  4606
level:aNumber
claus
parents: 138
diff changeset
  4607
    "set my level relative to superView (3D)"
claus
parents: 138
diff changeset
  4608
claus
parents: 138
diff changeset
  4609
    |oldMargin how|
claus
parents: 138
diff changeset
  4610
claus
parents: 138
diff changeset
  4611
    (aNumber ~~ level and:[aNumber notNil]) ifTrue:[
claus
parents: 138
diff changeset
  4612
	self is3D ifTrue:[
claus
parents: 138
diff changeset
  4613
	    level := aNumber.
claus
parents: 138
diff changeset
  4614
	    oldMargin := margin.
claus
parents: 138
diff changeset
  4615
	    margin := level abs.
claus
parents: 138
diff changeset
  4616
claus
parents: 138
diff changeset
  4617
	    realized ifTrue:[
claus
parents: 138
diff changeset
  4618
		margin ~~ oldMargin ifTrue:[
claus
parents: 138
diff changeset
  4619
		    (margin > oldMargin) ifTrue:[
claus
parents: 138
diff changeset
  4620
			how := #smaller
claus
parents: 138
diff changeset
  4621
		    ] ifFalse:[
claus
parents: 138
diff changeset
  4622
			how := #larger
claus
parents: 138
diff changeset
  4623
		    ].
claus
parents: 138
diff changeset
  4624
		    self sizeChanged:how.
claus
parents: 138
diff changeset
  4625
		    self setInnerClip.
claus
parents: 138
diff changeset
  4626
		].
claus
parents: 138
diff changeset
  4627
		shown ifTrue:[
claus
parents: 138
diff changeset
  4628
		    self redrawEdges
claus
parents: 138
diff changeset
  4629
		]
135
claus
parents:
diff changeset
  4630
	    ]
claus
parents:
diff changeset
  4631
	]
claus
parents:
diff changeset
  4632
    ]
claus
parents:
diff changeset
  4633
!
claus
parents:
diff changeset
  4634
140
claus
parents: 138
diff changeset
  4635
borderWidth:aNumber
claus
parents: 138
diff changeset
  4636
    "set my borderWidth"
claus
parents: 138
diff changeset
  4637
claus
parents: 138
diff changeset
  4638
    (aNumber ~~ borderWidth) ifTrue:[
claus
parents: 138
diff changeset
  4639
	borderWidth := aNumber.
claus
parents: 138
diff changeset
  4640
	drawableId notNil ifTrue:[
claus
parents: 138
diff changeset
  4641
	    device setWindowBorderWidth:aNumber in:drawableId
claus
parents: 138
diff changeset
  4642
	]
135
claus
parents:
diff changeset
  4643
    ]
claus
parents:
diff changeset
  4644
!
claus
parents:
diff changeset
  4645
140
claus
parents: 138
diff changeset
  4646
viewBackground:something
claus
parents: 138
diff changeset
  4647
    "set the viewBackground to something, a color, image or form.
claus
parents: 138
diff changeset
  4648
     If its a color and we run on a color display, also set shadow and light
claus
parents: 138
diff changeset
  4649
     colors - this means, that a red view will get light-red and dark-red
claus
parents: 138
diff changeset
  4650
     edges."
claus
parents: 138
diff changeset
  4651
claus
parents: 138
diff changeset
  4652
    something isColor ifTrue:[
claus
parents: 138
diff changeset
  4653
	device hasGreyscales ifTrue:[
claus
parents: 138
diff changeset
  4654
	    shadowColor := something darkened.
claus
parents: 138
diff changeset
  4655
	    lightColor := something lightened
claus
parents: 138
diff changeset
  4656
	]
claus
parents: 138
diff changeset
  4657
    ].
claus
parents: 138
diff changeset
  4658
    super viewBackground:something
claus
parents: 138
diff changeset
  4659
!
claus
parents: 138
diff changeset
  4660
claus
parents: 138
diff changeset
  4661
margin
claus
parents: 138
diff changeset
  4662
    "return my margin - this is usually the level,
claus
parents: 138
diff changeset
  4663
     but can be more for some views"
claus
parents: 138
diff changeset
  4664
claus
parents: 138
diff changeset
  4665
    ^ margin
claus
parents: 138
diff changeset
  4666
!
claus
parents: 138
diff changeset
  4667
claus
parents: 138
diff changeset
  4668
borderColor
claus
parents: 138
diff changeset
  4669
    "return my borderColor"
claus
parents: 138
diff changeset
  4670
claus
parents: 138
diff changeset
  4671
    ^ borderColor
claus
parents: 138
diff changeset
  4672
!
claus
parents: 138
diff changeset
  4673
claus
parents: 138
diff changeset
  4674
borderColor:aColor
claus
parents: 138
diff changeset
  4675
    "set my borderColor"
claus
parents: 138
diff changeset
  4676
claus
parents: 138
diff changeset
  4677
    (aColor ~~ borderColor) ifTrue:[
claus
parents: 138
diff changeset
  4678
	borderColor := aColor.
claus
parents: 138
diff changeset
  4679
	drawableId notNil ifTrue:[
claus
parents: 138
diff changeset
  4680
	    self setBorderColor
claus
parents: 138
diff changeset
  4681
	]
claus
parents: 138
diff changeset
  4682
    ]
claus
parents: 138
diff changeset
  4683
!
claus
parents: 138
diff changeset
  4684
claus
parents: 138
diff changeset
  4685
borderShape:aForm
claus
parents: 138
diff changeset
  4686
    "set the borderShape to aForm"
claus
parents: 138
diff changeset
  4687
claus
parents: 138
diff changeset
  4688
    borderShape := aForm.
135
claus
parents:
diff changeset
  4689
    drawableId notNil ifTrue:[
140
claus
parents: 138
diff changeset
  4690
	device setWindowBorderShape:(aForm id) in:drawableId
claus
parents: 138
diff changeset
  4691
    ]
claus
parents: 138
diff changeset
  4692
!
claus
parents: 138
diff changeset
  4693
claus
parents: 138
diff changeset
  4694
viewShape:aForm
claus
parents: 138
diff changeset
  4695
    "set the viewShape to aForm"
claus
parents: 138
diff changeset
  4696
claus
parents: 138
diff changeset
  4697
    viewShape := aForm.
claus
parents: 138
diff changeset
  4698
    drawableId notNil ifTrue:[
claus
parents: 138
diff changeset
  4699
	device setWindowShape:(aForm id) in:drawableId
135
claus
parents:
diff changeset
  4700
    ]
claus
parents:
diff changeset
  4701
!
claus
parents:
diff changeset
  4702
140
claus
parents: 138
diff changeset
  4703
level
claus
parents: 138
diff changeset
  4704
    "return my level relative to superView (3D)"
claus
parents: 138
diff changeset
  4705
claus
parents: 138
diff changeset
  4706
    ^ level
claus
parents: 138
diff changeset
  4707
!
claus
parents: 138
diff changeset
  4708
claus
parents: 138
diff changeset
  4709
lightColor:aColorOrImage
claus
parents: 138
diff changeset
  4710
    "set the color to be used for lighted edges (3D only)"
claus
parents: 138
diff changeset
  4711
claus
parents: 138
diff changeset
  4712
    lightColor := aColorOrImage
claus
parents: 138
diff changeset
  4713
!
claus
parents: 138
diff changeset
  4714
claus
parents: 138
diff changeset
  4715
shadowColor:aColorOrImage
claus
parents: 138
diff changeset
  4716
    "set the color to be used for shadowed edges (3D only)"
claus
parents: 138
diff changeset
  4717
claus
parents: 138
diff changeset
  4718
    shadowColor := aColorOrImage
claus
parents: 138
diff changeset
  4719
! !
claus
parents: 138
diff changeset
  4720
claus
parents: 138
diff changeset
  4721
!SimpleView methodsFor:'informing others of changes'!
claus
parents: 138
diff changeset
  4722
claus
parents: 138
diff changeset
  4723
contentsChanged
claus
parents: 138
diff changeset
  4724
    "this one is sent, whenever contents changes size -
claus
parents: 138
diff changeset
  4725
     tell dependents about the change (i.e. scrollers)."
claus
parents: 138
diff changeset
  4726
claus
parents: 138
diff changeset
  4727
    self changed:#sizeOfContents
claus
parents: 138
diff changeset
  4728
!
claus
parents: 138
diff changeset
  4729
claus
parents: 138
diff changeset
  4730
originChanged:delta
claus
parents: 138
diff changeset
  4731
    "this one is sent, after the origin of my contents has changed -
claus
parents: 138
diff changeset
  4732
     tell dependents (i.e. scrollers) about this"
claus
parents: 138
diff changeset
  4733
claus
parents: 138
diff changeset
  4734
    self changed:#originOfContents with:delta.
claus
parents: 138
diff changeset
  4735
"/   subViews notNil ifTrue:[
claus
parents: 138
diff changeset
  4736
"/        subViews do:[:aSubView |
claus
parents: 138
diff changeset
  4737
"/            aSubView pixelOrigin:((aSubView left @ aSubView top) - delta)
claus
parents: 138
diff changeset
  4738
"/        ]
claus
parents: 138
diff changeset
  4739
"/    ]
claus
parents: 138
diff changeset
  4740
!
claus
parents: 138
diff changeset
  4741
claus
parents: 138
diff changeset
  4742
originWillChange
claus
parents: 138
diff changeset
  4743
    "this one is sent, just before viewOrigin changes -
claus
parents: 138
diff changeset
  4744
     gives subclasses a chance to catch scrolls easily
claus
parents: 138
diff changeset
  4745
     (for example to hide cursor before scroll)"
claus
parents: 138
diff changeset
  4746
claus
parents: 138
diff changeset
  4747
    ^ self
135
claus
parents:
diff changeset
  4748
! !
claus
parents:
diff changeset
  4749
claus
parents:
diff changeset
  4750
!SimpleView methodsFor:'adding & removing components'!
claus
parents:
diff changeset
  4751
140
claus
parents: 138
diff changeset
  4752
addSubView:newView
claus
parents: 138
diff changeset
  4753
    "add a view to the collection of subviews"
claus
parents: 138
diff changeset
  4754
claus
parents: 138
diff changeset
  4755
    subViews isNil ifTrue:[
claus
parents: 138
diff changeset
  4756
	subViews := OrderedCollection with:newView
claus
parents: 138
diff changeset
  4757
    ] ifFalse:[
claus
parents: 138
diff changeset
  4758
	subViews add:newView.
claus
parents: 138
diff changeset
  4759
    ].
claus
parents: 138
diff changeset
  4760
    self setParentViewIn:newView.
claus
parents: 138
diff changeset
  4761
!
claus
parents: 138
diff changeset
  4762
135
claus
parents:
diff changeset
  4763
setParentViewIn:aView
claus
parents:
diff changeset
  4764
    "common code for addSubView* methods"
claus
parents:
diff changeset
  4765
claus
parents:
diff changeset
  4766
    aView superView:self.
claus
parents:
diff changeset
  4767
    (aView device ~~ device) ifTrue:[
145
claus
parents: 144
diff changeset
  4768
	'VIEW: warning subview (' errorPrint. aView class name errorPrint.
135
claus
parents:
diff changeset
  4769
	') has different device than me (' errorPrint.
145
claus
parents: 144
diff changeset
  4770
	self class name errorPrint. ').' errorPrintNL.
135
claus
parents:
diff changeset
  4771
	aView device:device
claus
parents:
diff changeset
  4772
    ]
claus
parents:
diff changeset
  4773
!
claus
parents:
diff changeset
  4774
claus
parents:
diff changeset
  4775
removeSubView:aView
claus
parents:
diff changeset
  4776
    "remove a view from the collection of subviews"
claus
parents:
diff changeset
  4777
claus
parents:
diff changeset
  4778
    subViews notNil ifTrue:[
claus
parents:
diff changeset
  4779
	subViews remove:aView ifAbsent:[nil].
claus
parents:
diff changeset
  4780
	(subViews size == 0) ifTrue:[
claus
parents:
diff changeset
  4781
	    subViews := nil
claus
parents:
diff changeset
  4782
	]
claus
parents:
diff changeset
  4783
    ]
claus
parents:
diff changeset
  4784
!
claus
parents:
diff changeset
  4785
140
claus
parents: 138
diff changeset
  4786
add:aComponent
claus
parents: 138
diff changeset
  4787
    "add a component (either a view or gadget) to the collection of
claus
parents: 138
diff changeset
  4788
     subComponents."
claus
parents: 138
diff changeset
  4789
claus
parents: 138
diff changeset
  4790
    self addComponent:aComponent
claus
parents: 138
diff changeset
  4791
!
claus
parents: 138
diff changeset
  4792
claus
parents: 138
diff changeset
  4793
addSubView:newView after:aView
claus
parents: 138
diff changeset
  4794
    "add a view to the collection of subviews after another view.
claus
parents: 138
diff changeset
  4795
     This makes sense, in Panels and other layout views, to enter a new
claus
parents: 138
diff changeset
  4796
     element at some defined place."
claus
parents: 138
diff changeset
  4797
claus
parents: 138
diff changeset
  4798
    subViews isNil ifTrue:[
claus
parents: 138
diff changeset
  4799
	subViews := OrderedCollection with:newView
claus
parents: 138
diff changeset
  4800
    ] ifFalse:[
claus
parents: 138
diff changeset
  4801
	aView isNil ifTrue:[
claus
parents: 138
diff changeset
  4802
	    subViews add:newView
claus
parents: 138
diff changeset
  4803
	] ifFalse:[
claus
parents: 138
diff changeset
  4804
	    subViews add:newView after:aView.
claus
parents: 138
diff changeset
  4805
	]
claus
parents: 138
diff changeset
  4806
    ].
claus
parents: 138
diff changeset
  4807
    self setParentViewIn:newView.
claus
parents: 138
diff changeset
  4808
!
claus
parents: 138
diff changeset
  4809
135
claus
parents:
diff changeset
  4810
addComponent:aComponent
claus
parents:
diff changeset
  4811
    "components (i.e. gadgets or lightweight views) are being prepared. 
claus
parents:
diff changeset
  4812
     Dont use this right now for non-views"
claus
parents:
diff changeset
  4813
claus
parents:
diff changeset
  4814
    aComponent isView ifTrue:[
claus
parents:
diff changeset
  4815
	self addSubView:aComponent
claus
parents:
diff changeset
  4816
    ] ifFalse:[
claus
parents:
diff changeset
  4817
	components isNil ifTrue:[
claus
parents:
diff changeset
  4818
	    components := OrderedCollection new
claus
parents:
diff changeset
  4819
	].
claus
parents:
diff changeset
  4820
	components add:aComponent.
claus
parents:
diff changeset
  4821
	aComponent setParentViewIn:self
claus
parents:
diff changeset
  4822
    ]
claus
parents:
diff changeset
  4823
!
claus
parents:
diff changeset
  4824
140
claus
parents: 138
diff changeset
  4825
add:aComponent in:aRectangleOrLayoutFrame 
claus
parents: 138
diff changeset
  4826
    "for ST-80 compatibility.
claus
parents: 138
diff changeset
  4827
     add a component in some frame; the argument may be either a rectangle
claus
parents: 138
diff changeset
  4828
     with relative coordinates, or an instance of LayoutFrame, specifying
claus
parents: 138
diff changeset
  4829
     both relative coordinates and the insets."
claus
parents: 138
diff changeset
  4830
151
claus
parents: 145
diff changeset
  4831
"/ old code:
154
claus
parents: 153
diff changeset
  4832
"/    |origin corner l|
claus
parents: 153
diff changeset
  4833
"/
151
claus
parents: 145
diff changeset
  4834
"/    origin := aRectangleOrLayoutFrame origin.
claus
parents: 145
diff changeset
  4835
"/    origin := origin x asFloat @ origin y asFloat.
claus
parents: 145
diff changeset
  4836
"/    corner := aRectangleOrLayoutFrame corner.
claus
parents: 145
diff changeset
  4837
"/    corner := corner x asFloat @ corner y asFloat.
claus
parents: 145
diff changeset
  4838
"/    aComponent origin:origin corner:corner.
claus
parents: 145
diff changeset
  4839
"/
claus
parents: 145
diff changeset
  4840
"/    (aRectangleOrLayoutFrame isMemberOf:Rectangle) ifFalse:[
claus
parents: 145
diff changeset
  4841
"/        aComponent leftInset:aRectangleOrLayoutFrame leftOffset.
claus
parents: 145
diff changeset
  4842
"/        aComponent rightInset:aRectangleOrLayoutFrame rightOffset negated.
claus
parents: 145
diff changeset
  4843
"/        aComponent topInset:aRectangleOrLayoutFrame topOffset.
claus
parents: 145
diff changeset
  4844
"/        aComponent bottomInset:aRectangleOrLayoutFrame bottomOffset negated.
claus
parents: 145
diff changeset
  4845
"/    ].
claus
parents: 145
diff changeset
  4846
claus
parents: 145
diff changeset
  4847
"/ new (being validated):
154
claus
parents: 153
diff changeset
  4848
claus
parents: 153
diff changeset
  4849
    |l|
claus
parents: 153
diff changeset
  4850
151
claus
parents: 145
diff changeset
  4851
    (aRectangleOrLayoutFrame isMemberOf:Rectangle) ifTrue:[
claus
parents: 145
diff changeset
  4852
	l := aRectangleOrLayoutFrame asLayout.
claus
parents: 145
diff changeset
  4853
    ] ifFalse:[
claus
parents: 145
diff changeset
  4854
	l := aRectangleOrLayoutFrame
140
claus
parents: 138
diff changeset
  4855
    ].
153
claus
parents: 151
diff changeset
  4856
claus
parents: 151
diff changeset
  4857
"/  will soon be replaced by:
claus
parents: 151
diff changeset
  4858
"/    aComponent layout:l.
154
claus
parents: 153
diff changeset
  4859
    aComponent geometryLayout:l.
claus
parents: 153
diff changeset
  4860
140
claus
parents: 138
diff changeset
  4861
    self addComponent:aComponent
claus
parents: 138
diff changeset
  4862
!
claus
parents: 138
diff changeset
  4863
claus
parents: 138
diff changeset
  4864
addSubView:newView before:aView
claus
parents: 138
diff changeset
  4865
    "add a view to the collection of subviews before another view.
claus
parents: 138
diff changeset
  4866
     This makes sense, in Panels and other layout views, to enter a new
claus
parents: 138
diff changeset
  4867
     element at some defined place."
claus
parents: 138
diff changeset
  4868
claus
parents: 138
diff changeset
  4869
    subViews isNil ifTrue:[
claus
parents: 138
diff changeset
  4870
	subViews := OrderedCollection with:newView
claus
parents: 138
diff changeset
  4871
    ] ifFalse:[
claus
parents: 138
diff changeset
  4872
	aView isNil ifTrue:[
claus
parents: 138
diff changeset
  4873
	    subViews addFirst:newView
claus
parents: 138
diff changeset
  4874
	] ifFalse:[
claus
parents: 138
diff changeset
  4875
	    subViews add:newView before:aView.
claus
parents: 138
diff changeset
  4876
	]
claus
parents: 138
diff changeset
  4877
    ].
claus
parents: 138
diff changeset
  4878
    self setParentViewIn:newView.
claus
parents: 138
diff changeset
  4879
!
claus
parents: 138
diff changeset
  4880
135
claus
parents:
diff changeset
  4881
component:aComponent
claus
parents:
diff changeset
  4882
    "components (i.e. gadgets or lightweight views) are being prepared. 
claus
parents:
diff changeset
  4883
     Dont use this right now for non-views"
claus
parents:
diff changeset
  4884
claus
parents:
diff changeset
  4885
    aComponent origin:0.0@0.0 corner:1.0@1.0.
claus
parents:
diff changeset
  4886
    aComponent isView ifTrue:[
claus
parents:
diff changeset
  4887
	self addSubView:aComponent
claus
parents:
diff changeset
  4888
    ] ifFalse:[
claus
parents:
diff changeset
  4889
	components := OrderedCollection with:aComponent.
claus
parents:
diff changeset
  4890
	aComponent setParentViewIn:self
claus
parents:
diff changeset
  4891
    ]
claus
parents:
diff changeset
  4892
!
claus
parents:
diff changeset
  4893
claus
parents:
diff changeset
  4894
removeComponent:aComponent
claus
parents:
diff changeset
  4895
    "components (i.e. gadgets or lightweight views) are being prepared. 
claus
parents:
diff changeset
  4896
     Dont use this right now for non-views"
claus
parents:
diff changeset
  4897
claus
parents:
diff changeset
  4898
    aComponent isView ifTrue:[
claus
parents:
diff changeset
  4899
	self removeSubView:aComponent
claus
parents:
diff changeset
  4900
    ] ifFalse:[
claus
parents:
diff changeset
  4901
	components isNil ifTrue:[^self].
claus
parents:
diff changeset
  4902
	components remove:aComponent ifAbsent:[].
claus
parents:
diff changeset
  4903
	aComponent parent:nil 
claus
parents:
diff changeset
  4904
    ]
claus
parents:
diff changeset
  4905
!
claus
parents:
diff changeset
  4906
claus
parents:
diff changeset
  4907
addSubView:aView in:bounds borderWidth:bw
claus
parents:
diff changeset
  4908
    "for ST-80 V2.x compatibility"
claus
parents:
diff changeset
  4909
claus
parents:
diff changeset
  4910
    aView borderWidth:bw.
claus
parents:
diff changeset
  4911
    self add:aView in:bounds.
claus
parents:
diff changeset
  4912
!
claus
parents:
diff changeset
  4913
claus
parents:
diff changeset
  4914
addSubView:aView viewport:aRectangle
claus
parents:
diff changeset
  4915
    "ST-80 V2.x compatibility:
claus
parents:
diff changeset
  4916
     Adds aView to the views list of subviews and uses the
claus
parents:
diff changeset
  4917
     existing subviews window and the new viewport to position it.
claus
parents:
diff changeset
  4918
     This method may be removed in future versions."
claus
parents:
diff changeset
  4919
claus
parents:
diff changeset
  4920
    self addSubView:aView.
claus
parents:
diff changeset
  4921
    aView viewport:aRectangle
claus
parents:
diff changeset
  4922
!
claus
parents:
diff changeset
  4923
claus
parents:
diff changeset
  4924
addSubView:aView window:aWindowRectangle viewport:aViewportRectangle
claus
parents:
diff changeset
  4925
    "ST-80 V2.x compatibility:
claus
parents:
diff changeset
  4926
     Adds aView to the views list of subviews and uses 
claus
parents:
diff changeset
  4927
     aWindowRectangle and aViewportRectangle to position it.
claus
parents:
diff changeset
  4928
     This method may be removed in future versions."
claus
parents:
diff changeset
  4929
claus
parents:
diff changeset
  4930
    self addSubView:aView.
claus
parents:
diff changeset
  4931
    aView window:aWindowRectangle viewport:aViewportRectangle
180
claus
parents: 176
diff changeset
  4932
!
claus
parents: 176
diff changeset
  4933
claus
parents: 176
diff changeset
  4934
destroySubViews
claus
parents: 176
diff changeset
  4935
    "remove all subviews"
claus
parents: 176
diff changeset
  4936
claus
parents: 176
diff changeset
  4937
    subViews notNil ifTrue:[
claus
parents: 176
diff changeset
  4938
	subViews copy do:[:aSubView |
claus
parents: 176
diff changeset
  4939
	    aSubView destroy.
claus
parents: 176
diff changeset
  4940
	]
claus
parents: 176
diff changeset
  4941
    ]
claus
parents: 176
diff changeset
  4942
claus
parents: 176
diff changeset
  4943
    "Modified: 5.9.1995 / 22:35:36 / claus"
135
claus
parents:
diff changeset
  4944
! !
claus
parents:
diff changeset
  4945
claus
parents:
diff changeset
  4946
!SimpleView methodsFor:'queries'!
claus
parents:
diff changeset
  4947
151
claus
parents: 145
diff changeset
  4948
preferredExtent
140
claus
parents: 138
diff changeset
  4949
    "return my preferred extent - this is the minimum size I would like to have.
claus
parents: 138
diff changeset
  4950
     The default here is the actual extent, the receiver currently has."
claus
parents: 138
diff changeset
  4951
claus
parents: 138
diff changeset
  4952
    "mhmh - if I have components, collect their
151
claus
parents: 145
diff changeset
  4953
     preferred bounds ..."
140
claus
parents: 138
diff changeset
  4954
claus
parents: 138
diff changeset
  4955
    |maxX maxY|
claus
parents: 138
diff changeset
  4956
claus
parents: 138
diff changeset
  4957
    subViews isNil ifTrue:[^ self extent].
claus
parents: 138
diff changeset
  4958
"/    ^ self extent.
claus
parents: 138
diff changeset
  4959
claus
parents: 138
diff changeset
  4960
    maxX := maxY := 0.
claus
parents: 138
diff changeset
  4961
    subViews notNil ifTrue:[
142
claus
parents: 140
diff changeset
  4962
	subViews do:[:aSubView |
claus
parents: 140
diff changeset
  4963
	    |org corn|
claus
parents: 140
diff changeset
  4964
claus
parents: 140
diff changeset
  4965
	    org := aSubView computeOrigin.
151
claus
parents: 145
diff changeset
  4966
	    corn := org + aSubView preferredExtent.
142
claus
parents: 140
diff changeset
  4967
	    maxX := maxX max:corn x.
claus
parents: 140
diff changeset
  4968
	    maxY := maxY max:corn y.
claus
parents: 140
diff changeset
  4969
	]
140
claus
parents: 138
diff changeset
  4970
    ].
claus
parents: 138
diff changeset
  4971
    ^ maxX @ maxY.
claus
parents: 138
diff changeset
  4972
!
claus
parents: 138
diff changeset
  4973
claus
parents: 138
diff changeset
  4974
buttonMotionEventPending
claus
parents: 138
diff changeset
  4975
    "return true, if a button motion event is pending.
claus
parents: 138
diff changeset
  4976
     Normally, you dont want to use this, since no polling is needed
claus
parents: 138
diff changeset
  4977
     (not even for mouse-tracking).
claus
parents: 138
diff changeset
  4978
     Dont use it, since it does not honor the windowGroup, but
claus
parents: 138
diff changeset
  4979
     goes directly to the device instead.
claus
parents: 138
diff changeset
  4980
     Actually, its a historical leftover"
claus
parents: 138
diff changeset
  4981
claus
parents: 138
diff changeset
  4982
    windowGroup notNil ifTrue:[
claus
parents: 138
diff changeset
  4983
	^ windowGroup sensor hasButtonMotionEventsFor:self
claus
parents: 138
diff changeset
  4984
    ].
claus
parents: 138
diff changeset
  4985
    ^ super buttonMotionEventPending
claus
parents: 138
diff changeset
  4986
!
claus
parents: 138
diff changeset
  4987
135
claus
parents:
diff changeset
  4988
isView
claus
parents:
diff changeset
  4989
    "return true, if the receiver is some kind of view;
claus
parents:
diff changeset
  4990
     true is returned here."
claus
parents:
diff changeset
  4991
claus
parents:
diff changeset
  4992
    ^ true
claus
parents:
diff changeset
  4993
!
claus
parents:
diff changeset
  4994
140
claus
parents: 138
diff changeset
  4995
hasFocus
142
claus
parents: 140
diff changeset
  4996
    "return true, if the receiver has the keyboard focus
claus
parents: 140
diff changeset
  4997
     (either via the focusView mechanism in the windowGroup,
claus
parents: 140
diff changeset
  4998
      or via delegation)"
claus
parents: 140
diff changeset
  4999
153
claus
parents: 151
diff changeset
  5000
    |focusView delegate|
claus
parents: 151
diff changeset
  5001
claus
parents: 151
diff changeset
  5002
    windowGroup isNil ifTrue:[^ false].
claus
parents: 151
diff changeset
  5003
claus
parents: 151
diff changeset
  5004
    (focusView := windowGroup focusView) == self ifTrue:[^ true].
142
claus
parents: 140
diff changeset
  5005
    focusView notNil ifTrue:[
claus
parents: 140
diff changeset
  5006
	"mhmh - is there a delegation to me ?"
153
claus
parents: 151
diff changeset
  5007
	(delegate := focusView delegate) notNil ifTrue:[
claus
parents: 151
diff changeset
  5008
	    delegate == self ifTrue:[^ true].
claus
parents: 151
diff changeset
  5009
	    ^ delegate delegatesTo:self
142
claus
parents: 140
diff changeset
  5010
	]
claus
parents: 140
diff changeset
  5011
    ].
claus
parents: 140
diff changeset
  5012
    ^ false
claus
parents: 140
diff changeset
  5013
!
claus
parents: 140
diff changeset
  5014
claus
parents: 140
diff changeset
  5015
delegatesTo:someone
claus
parents: 140
diff changeset
  5016
    "return true, if I delegate events to someone"
claus
parents: 140
diff changeset
  5017
claus
parents: 140
diff changeset
  5018
    delegate isNil ifTrue:[^ false].
claus
parents: 140
diff changeset
  5019
    ^ delegate delegatesTo:someone
140
claus
parents: 138
diff changeset
  5020
!
claus
parents: 138
diff changeset
  5021
claus
parents: 138
diff changeset
  5022
isSubViewOf:aView
claus
parents: 138
diff changeset
  5023
    "return true, if I am a subview of aView"
claus
parents: 138
diff changeset
  5024
claus
parents: 138
diff changeset
  5025
    aView == self isNil ifTrue:[^ true].
claus
parents: 138
diff changeset
  5026
    superView isNil ifTrue:[^ false].
claus
parents: 138
diff changeset
  5027
    superView == aView ifTrue:[^ true].
176
claus
parents: 175
diff changeset
  5028
    ^ superView isSubViewOf:aView
140
claus
parents: 138
diff changeset
  5029
!
claus
parents: 138
diff changeset
  5030
137
claus
parents: 136
diff changeset
  5031
canHandle:aKey from:aView
claus
parents: 136
diff changeset
  5032
    "return true, if I like to handle the key (from a keyPress event)
claus
parents: 136
diff changeset
  5033
     in aView.
claus
parents: 136
diff changeset
  5034
     OBSOLETE: do not use & depend on this method, it is a historic
claus
parents: 136
diff changeset
  5035
     leftOver and will be removed. Use the delegation mechanism for this."
claus
parents: 136
diff changeset
  5036
claus
parents: 136
diff changeset
  5037
    ^ self canHandle:aKey
claus
parents: 136
diff changeset
  5038
!
claus
parents: 136
diff changeset
  5039
135
claus
parents:
diff changeset
  5040
canHandle:aKey
137
claus
parents: 136
diff changeset
  5041
    "return true, if I like to handle the key (from a keyPress event).
claus
parents: 136
diff changeset
  5042
     OBSOLETE: do not use & depend on this method, it is a historic
claus
parents: 136
diff changeset
  5043
     leftOver and will be removed. Use the delegation mechanism for this."
claus
parents: 136
diff changeset
  5044
claus
parents: 136
diff changeset
  5045
    ^ false
135
claus
parents:
diff changeset
  5046
!
claus
parents:
diff changeset
  5047
claus
parents:
diff changeset
  5048
preferredBounds
claus
parents:
diff changeset
  5049
    "ST-80 compatibility."
claus
parents:
diff changeset
  5050
151
claus
parents: 145
diff changeset
  5051
    ^ 0@0 corner:self preferredExtent
189
claus
parents: 182
diff changeset
  5052
!
claus
parents: 182
diff changeset
  5053
claus
parents: 182
diff changeset
  5054
sizeFixed
claus
parents: 182
diff changeset
  5055
    "return true, if this vew wants its size to remain unchanged.
claus
parents: 182
diff changeset
  5056
     Used by panels, to check if their components want to keep their size."
claus
parents: 182
diff changeset
  5057
claus
parents: 182
diff changeset
  5058
    ^ false
claus
parents: 182
diff changeset
  5059
claus
parents: 182
diff changeset
  5060
    "Created: 17.9.1995 / 20:29:20 / claus"
140
claus
parents: 138
diff changeset
  5061
! !
claus
parents: 138
diff changeset
  5062
claus
parents: 138
diff changeset
  5063
!SimpleView methodsFor:'accessing-menus'!
claus
parents: 138
diff changeset
  5064
claus
parents: 138
diff changeset
  5065
yellowButtonMenu
claus
parents: 138
diff changeset
  5066
    "actually, this should be called 'middleButtonMenu'.
claus
parents: 138
diff changeset
  5067
     But for ST-80 compatibility ....
claus
parents: 138
diff changeset
  5068
     This method will vanish, once all views have controllers
222
f46120c95d87 static yellowButtonMenu changed for Stefan
Claus Gittinger <cg@exept.de>
parents: 220
diff changeset
  5069
     associated with them; for now, duplicate some code also found in
140
claus
parents: 138
diff changeset
  5070
     controller."
claus
parents: 138
diff changeset
  5071
claus
parents: 138
diff changeset
  5072
    |sym menuHolder|
claus
parents: 138
diff changeset
  5073
claus
parents: 138
diff changeset
  5074
"/    middleButtonMenu notNil ifTrue:[
claus
parents: 138
diff changeset
  5075
"/        "/
claus
parents: 138
diff changeset
  5076
"/        "/ has been assigned a static middleButtonMenu
claus
parents: 138
diff changeset
  5077
"/        "/ (or a cached menu)
claus
parents: 138
diff changeset
  5078
"/        "/
claus
parents: 138
diff changeset
  5079
"/        ^ middleButtonMenu
claus
parents: 138
diff changeset
  5080
"/    ].
claus
parents: 138
diff changeset
  5081
claus
parents: 138
diff changeset
  5082
    menuHolder := self menuHolder.
claus
parents: 138
diff changeset
  5083
142
claus
parents: 140
diff changeset
  5084
    menuHolder notNil ifTrue:[
claus
parents: 140
diff changeset
  5085
	sym := self menuMessage.
claus
parents: 140
diff changeset
  5086
	sym notNil ifTrue:[
claus
parents: 140
diff changeset
  5087
	    "
claus
parents: 140
diff changeset
  5088
	     mhmh - for backward compatibility, try to ask
claus
parents: 140
diff changeset
  5089
	     the model first, then use the views menu.
claus
parents: 140
diff changeset
  5090
	    "
claus
parents: 140
diff changeset
  5091
	    (menuHolder respondsTo:sym) ifFalse:[
claus
parents: 140
diff changeset
  5092
		(self respondsTo:sym) ifTrue:[
claus
parents: 140
diff changeset
  5093
		    menuHolder := self
claus
parents: 140
diff changeset
  5094
		]
claus
parents: 140
diff changeset
  5095
	    ].
claus
parents: 140
diff changeset
  5096
	    "
claus
parents: 140
diff changeset
  5097
	     ask the menuHolder for the menu
claus
parents: 140
diff changeset
  5098
	    "
claus
parents: 140
diff changeset
  5099
	    ^ menuHolder perform:sym.
claus
parents: 140
diff changeset
  5100
	].
140
claus
parents: 138
diff changeset
  5101
    ].
142
claus
parents: 140
diff changeset
  5102
140
claus
parents: 138
diff changeset
  5103
    ^ nil
claus
parents: 138
diff changeset
  5104
!
claus
parents: 138
diff changeset
  5105
claus
parents: 138
diff changeset
  5106
menuHolder
claus
parents: 138
diff changeset
  5107
    "who has the menu ? 
claus
parents: 138
diff changeset
  5108
     By default, I have it."
claus
parents: 138
diff changeset
  5109
claus
parents: 138
diff changeset
  5110
    ^ self
claus
parents: 138
diff changeset
  5111
!
claus
parents: 138
diff changeset
  5112
claus
parents: 138
diff changeset
  5113
menuPerformer
claus
parents: 138
diff changeset
  5114
    "who should perform the menu actions ? 
claus
parents: 138
diff changeset
  5115
     By default, I do it."
claus
parents: 138
diff changeset
  5116
claus
parents: 138
diff changeset
  5117
    ^ self
claus
parents: 138
diff changeset
  5118
!
claus
parents: 138
diff changeset
  5119
claus
parents: 138
diff changeset
  5120
menuMessage
claus
parents: 138
diff changeset
  5121
    "Return the symbol sent to myself to aquire the menu"
claus
parents: 138
diff changeset
  5122
claus
parents: 138
diff changeset
  5123
    ^ #middleButtonMenu
claus
parents: 138
diff changeset
  5124
! !
claus
parents: 138
diff changeset
  5125
claus
parents: 138
diff changeset
  5126
!SimpleView methodsFor:'change & update'!
claus
parents: 138
diff changeset
  5127
claus
parents: 138
diff changeset
  5128
update:aspect with:aParameter from:changedObject
claus
parents: 138
diff changeset
  5129
    "an update request"
claus
parents: 138
diff changeset
  5130
claus
parents: 138
diff changeset
  5131
    aspect == #sizeOfView ifTrue:[
claus
parents: 138
diff changeset
  5132
	"one of the views we depend on changed its size"
claus
parents: 138
diff changeset
  5133
	^ self superViewChangedSize.
claus
parents: 138
diff changeset
  5134
    ].
claus
parents: 138
diff changeset
  5135
    ^super update:aspect with:aParameter from:changedObject
135
claus
parents:
diff changeset
  5136
! !
claus
parents:
diff changeset
  5137
claus
parents:
diff changeset
  5138
!SimpleView methodsFor:'enumerating subviews'!
claus
parents:
diff changeset
  5139
claus
parents:
diff changeset
  5140
allSubViewsDo:aBlock
claus
parents:
diff changeset
  5141
    "evaluate aBlock for all subviews (recursively)"
claus
parents:
diff changeset
  5142
claus
parents:
diff changeset
  5143
    (subViews isNil or:[subViews isEmpty]) ifFalse:[
claus
parents:
diff changeset
  5144
	subViews do:[:aSubview |
claus
parents:
diff changeset
  5145
	    aSubview withAllSubViewsDo:aBlock
claus
parents:
diff changeset
  5146
	]
claus
parents:
diff changeset
  5147
    ]
claus
parents:
diff changeset
  5148
!
claus
parents:
diff changeset
  5149
claus
parents:
diff changeset
  5150
withAllSubViewsDo:aBlock
claus
parents:
diff changeset
  5151
    "evaluate aBlock for the receiver and all subviews (recursively)"
claus
parents:
diff changeset
  5152
claus
parents:
diff changeset
  5153
    aBlock value:self.
claus
parents:
diff changeset
  5154
    self allSubViewsDo:aBlock
claus
parents:
diff changeset
  5155
! !
claus
parents:
diff changeset
  5156
claus
parents:
diff changeset
  5157
!SimpleView methodsFor:'scrolling-basic'!
claus
parents:
diff changeset
  5158
151
claus
parents: 145
diff changeset
  5159
scrollTo:newOrigin 
claus
parents: 145
diff changeset
  5160
    "change origin to have newOrigin be visible at the top-left.
claus
parents: 145
diff changeset
  5161
     The argument defines the integer device coordinates of the new top-left 
claus
parents: 145
diff changeset
  5162
     point."
claus
parents: 145
diff changeset
  5163
claus
parents: 145
diff changeset
  5164
    "due to historic reasons, the work is actually done by scrollUp/Down
claus
parents: 145
diff changeset
  5165
     scrollLeft/Right (those where implemented first).
claus
parents: 145
diff changeset
  5166
     This will be changed to do all work here, and call it from
claus
parents: 145
diff changeset
  5167
     the other scrolling methods."
claus
parents: 145
diff changeset
  5168
claus
parents: 145
diff changeset
  5169
    |dX   "{ Class:SmallInteger }"
claus
parents: 145
diff changeset
  5170
     dY   "{ Class:SmallInteger }"
claus
parents: 145
diff changeset
  5171
     m2   "{ Class:SmallInteger }"
claus
parents: 145
diff changeset
  5172
     orgX "{ Class:SmallInteger }"
claus
parents: 145
diff changeset
  5173
     orgY "{ Class:SmallInteger }" |
claus
parents: 145
diff changeset
  5174
claus
parents: 145
diff changeset
  5175
    transformation isNil ifTrue:[
claus
parents: 145
diff changeset
  5176
	orgY := orgX := 0
claus
parents: 145
diff changeset
  5177
    ] ifFalse:[
claus
parents: 145
diff changeset
  5178
	orgY := transformation translation y negated.
claus
parents: 145
diff changeset
  5179
	orgX := transformation translation x negated
claus
parents: 145
diff changeset
  5180
    ].
claus
parents: 145
diff changeset
  5181
    dX := newOrigin x - orgX.
claus
parents: 145
diff changeset
  5182
    dY := newOrigin y - orgY.
claus
parents: 145
diff changeset
  5183
    dX = 0 ifTrue:[
claus
parents: 145
diff changeset
  5184
	dY < 0 ifTrue:[
claus
parents: 145
diff changeset
  5185
	    ^ self scrollUp:(dY negated).
claus
parents: 145
diff changeset
  5186
	].
claus
parents: 145
diff changeset
  5187
	dY > 0 ifTrue:[
claus
parents: 145
diff changeset
  5188
	    ^ self scrollDown:dY.
claus
parents: 145
diff changeset
  5189
	].
claus
parents: 145
diff changeset
  5190
	^ self
claus
parents: 145
diff changeset
  5191
    ].
claus
parents: 145
diff changeset
  5192
    dY = 0 ifTrue:[
claus
parents: 145
diff changeset
  5193
	dX < 0 ifTrue:[
claus
parents: 145
diff changeset
  5194
	    ^ self scrollLeft:dX negated
claus
parents: 145
diff changeset
  5195
	].
claus
parents: 145
diff changeset
  5196
	dX > 0 ifTrue:[
claus
parents: 145
diff changeset
  5197
	    ^ self scrollRight:dX
claus
parents: 145
diff changeset
  5198
	].
claus
parents: 145
diff changeset
  5199
    ].
claus
parents: 145
diff changeset
  5200
claus
parents: 145
diff changeset
  5201
    self originWillChange.
claus
parents: 145
diff changeset
  5202
    self setViewOrigin:newOrigin.
claus
parents: 145
diff changeset
  5203
    shown ifTrue:[
claus
parents: 145
diff changeset
  5204
	m2 := margin * 2. "top & bottom margins"
claus
parents: 145
diff changeset
  5205
	self redrawDeviceX:margin y:margin
claus
parents: 145
diff changeset
  5206
		     width:(width - m2)
claus
parents: 145
diff changeset
  5207
		    height:(height - m2).
claus
parents: 145
diff changeset
  5208
    ].
claus
parents: 145
diff changeset
  5209
    self originChanged:(dX @ dY).
claus
parents: 145
diff changeset
  5210
!
claus
parents: 145
diff changeset
  5211
135
claus
parents:
diff changeset
  5212
scrollUp:nPixels
claus
parents:
diff changeset
  5213
    "change origin to scroll up (towards the origin) by some pixels"
claus
parents:
diff changeset
  5214
claus
parents:
diff changeset
  5215
    |count "{ Class:SmallInteger }"
claus
parents:
diff changeset
  5216
     m2    "{ Class:SmallInteger }"
claus
parents:
diff changeset
  5217
     w     "{ Class:SmallInteger }"
claus
parents:
diff changeset
  5218
     h     "{ Class:SmallInteger }"
claus
parents:
diff changeset
  5219
     orgX
claus
parents:
diff changeset
  5220
     orgY  "{ Class:SmallInteger }"
claus
parents:
diff changeset
  5221
     newOrigin|
claus
parents:
diff changeset
  5222
claus
parents:
diff changeset
  5223
    transformation isNil ifTrue:[
claus
parents:
diff changeset
  5224
	orgY := orgX := 0
claus
parents:
diff changeset
  5225
    ] ifFalse:[
claus
parents:
diff changeset
  5226
	orgY := transformation translation y negated.
claus
parents:
diff changeset
  5227
	orgX := transformation translation x negated
claus
parents:
diff changeset
  5228
    ].
claus
parents:
diff changeset
  5229
claus
parents:
diff changeset
  5230
    count := nPixels.
claus
parents:
diff changeset
  5231
    (count > orgY) ifTrue:[
claus
parents:
diff changeset
  5232
	count := orgY
claus
parents:
diff changeset
  5233
    ].
claus
parents:
diff changeset
  5234
    (count <= 0) ifTrue:[^ self].
claus
parents:
diff changeset
  5235
claus
parents:
diff changeset
  5236
    self originWillChange.
claus
parents:
diff changeset
  5237
    newOrigin := orgX @ (orgY - count).
claus
parents:
diff changeset
  5238
claus
parents:
diff changeset
  5239
    shown ifFalse:[
claus
parents:
diff changeset
  5240
	self setViewOrigin:newOrigin.
claus
parents:
diff changeset
  5241
    ] ifTrue:[
claus
parents:
diff changeset
  5242
	m2 := margin * 2. "top & bottom margins"
claus
parents:
diff changeset
  5243
	(count >= self innerHeight) ifTrue:[
claus
parents:
diff changeset
  5244
	    self setViewOrigin:newOrigin.
claus
parents:
diff changeset
  5245
	    self redrawDeviceX:margin y:margin
claus
parents:
diff changeset
  5246
			 width:(width - m2)
claus
parents:
diff changeset
  5247
			height:(height - m2).
claus
parents:
diff changeset
  5248
	] ifFalse:[
claus
parents:
diff changeset
  5249
	    h := height - m2 - count.
claus
parents:
diff changeset
  5250
	    w := width.
claus
parents:
diff changeset
  5251
	    self catchExpose.
claus
parents:
diff changeset
  5252
	    self setViewOrigin:newOrigin.
claus
parents:
diff changeset
  5253
	    self copyFrom:self x:margin y:margin
claus
parents:
diff changeset
  5254
			     toX:margin y:(count + margin)
claus
parents:
diff changeset
  5255
			   width:w height:h.
claus
parents:
diff changeset
  5256
claus
parents:
diff changeset
  5257
	    self setInnerClip.
claus
parents:
diff changeset
  5258
	    self redrawDeviceX:margin y:margin
claus
parents:
diff changeset
  5259
			 width:(width - m2)
claus
parents:
diff changeset
  5260
			height:count.
claus
parents:
diff changeset
  5261
claus
parents:
diff changeset
  5262
	    self waitForExpose.
claus
parents:
diff changeset
  5263
	]
claus
parents:
diff changeset
  5264
    ].
claus
parents:
diff changeset
  5265
    self originChanged:(0 @ count negated).
claus
parents:
diff changeset
  5266
!
claus
parents:
diff changeset
  5267
claus
parents:
diff changeset
  5268
scrollDown:nPixels
claus
parents:
diff changeset
  5269
    "change origin to scroll down some pixels"
claus
parents:
diff changeset
  5270
claus
parents:
diff changeset
  5271
    |count "{ Class:SmallInteger }"
claus
parents:
diff changeset
  5272
     m2    "{ Class:SmallInteger }"
claus
parents:
diff changeset
  5273
     w     "{ Class:SmallInteger }"
claus
parents:
diff changeset
  5274
     h     "{ Class:SmallInteger }"
claus
parents:
diff changeset
  5275
     hCont 
claus
parents:
diff changeset
  5276
     ih    "{ Class:SmallInteger }"
claus
parents:
diff changeset
  5277
     orgX  
claus
parents:
diff changeset
  5278
     orgY  "{ Class:SmallInteger }"
claus
parents:
diff changeset
  5279
     newOrigin|
claus
parents:
diff changeset
  5280
claus
parents:
diff changeset
  5281
    hCont := self heightOfContents.
claus
parents:
diff changeset
  5282
    transformation isNil ifTrue:[
claus
parents:
diff changeset
  5283
	orgY := orgX := 0
claus
parents:
diff changeset
  5284
    ] ifFalse:[
claus
parents:
diff changeset
  5285
	hCont := (transformation applyScaleY:hCont) rounded.
claus
parents:
diff changeset
  5286
	orgY := transformation translation y negated.
claus
parents:
diff changeset
  5287
	orgX := transformation translation x negated.
claus
parents:
diff changeset
  5288
    ].
claus
parents:
diff changeset
  5289
claus
parents:
diff changeset
  5290
    count := nPixels.
claus
parents:
diff changeset
  5291
    ih := self innerHeight.
claus
parents:
diff changeset
  5292
claus
parents:
diff changeset
  5293
    ((orgY + nPixels + ih) > hCont) ifTrue:[
claus
parents:
diff changeset
  5294
	count := hCont - orgY - ih
claus
parents:
diff changeset
  5295
    ].
claus
parents:
diff changeset
  5296
    (count <= 0) ifTrue:[^ self].
claus
parents:
diff changeset
  5297
claus
parents:
diff changeset
  5298
    self originWillChange.
claus
parents:
diff changeset
  5299
    newOrigin := orgX @ (orgY + count).
claus
parents:
diff changeset
  5300
    shown ifFalse:[
claus
parents:
diff changeset
  5301
	self setViewOrigin:newOrigin.
claus
parents:
diff changeset
  5302
    ] ifTrue:[
claus
parents:
diff changeset
  5303
	m2 := margin * 2.
claus
parents:
diff changeset
  5304
	(count >= ih) ifTrue:[
claus
parents:
diff changeset
  5305
	    self setViewOrigin:newOrigin.
claus
parents:
diff changeset
  5306
	    self redrawDeviceX:margin y:margin
claus
parents:
diff changeset
  5307
			 width:(width - m2)
claus
parents:
diff changeset
  5308
			height:(height - m2).
claus
parents:
diff changeset
  5309
	] ifFalse:[
claus
parents:
diff changeset
  5310
	    h := height - m2 - count.
claus
parents:
diff changeset
  5311
	    w := self width.
claus
parents:
diff changeset
  5312
	    self catchExpose.
claus
parents:
diff changeset
  5313
	    self setViewOrigin:newOrigin.
claus
parents:
diff changeset
  5314
	    self copyFrom:self x:margin y:(count + margin)
claus
parents:
diff changeset
  5315
			     toX:margin y:margin
claus
parents:
diff changeset
  5316
			   width:w 
claus
parents:
diff changeset
  5317
			  height:h.
claus
parents:
diff changeset
  5318
claus
parents:
diff changeset
  5319
	    self setInnerClip.
claus
parents:
diff changeset
  5320
	    self redrawDeviceX:margin y:(h + margin) 
claus
parents:
diff changeset
  5321
			 width:(width - m2) height:count.
claus
parents:
diff changeset
  5322
claus
parents:
diff changeset
  5323
	    self waitForExpose.
claus
parents:
diff changeset
  5324
	]
claus
parents:
diff changeset
  5325
    ].
claus
parents:
diff changeset
  5326
    self originChanged:(0 @ count).
claus
parents:
diff changeset
  5327
!
claus
parents:
diff changeset
  5328
claus
parents:
diff changeset
  5329
scrollLeft:nPixels
claus
parents:
diff changeset
  5330
    "change origin to scroll left some pixels"
claus
parents:
diff changeset
  5331
claus
parents:
diff changeset
  5332
    |count "{ Class:SmallInteger }"
claus
parents:
diff changeset
  5333
     m2    "{ Class:SmallInteger }"
claus
parents:
diff changeset
  5334
     h     "{ Class:SmallInteger }"
claus
parents:
diff changeset
  5335
     orgX orgY newOrigin|
claus
parents:
diff changeset
  5336
claus
parents:
diff changeset
  5337
    transformation isNil ifTrue:[
claus
parents:
diff changeset
  5338
	orgY := orgX := 0
claus
parents:
diff changeset
  5339
    ] ifFalse:[
claus
parents:
diff changeset
  5340
	orgY := transformation translation y negated.
claus
parents:
diff changeset
  5341
	orgX := transformation translation x negated.
claus
parents:
diff changeset
  5342
    ].
claus
parents:
diff changeset
  5343
claus
parents:
diff changeset
  5344
    count := nPixels.
claus
parents:
diff changeset
  5345
    (count > orgX) ifTrue:[
claus
parents:
diff changeset
  5346
	count := orgX
claus
parents:
diff changeset
  5347
    ].
claus
parents:
diff changeset
  5348
    (count <= 0) ifTrue:[^ self].
claus
parents:
diff changeset
  5349
claus
parents:
diff changeset
  5350
    self originWillChange.
claus
parents:
diff changeset
  5351
    newOrigin := (orgX - count) @ orgY.
claus
parents:
diff changeset
  5352
claus
parents:
diff changeset
  5353
    shown ifFalse:[
claus
parents:
diff changeset
  5354
	self setViewOrigin:newOrigin.
claus
parents:
diff changeset
  5355
    ] ifTrue:[
claus
parents:
diff changeset
  5356
	m2 := margin * 2.
claus
parents:
diff changeset
  5357
	(count >= self innerWidth) ifTrue:[
claus
parents:
diff changeset
  5358
	    self setViewOrigin:newOrigin.
claus
parents:
diff changeset
  5359
	    self redrawDeviceX:margin y:margin
claus
parents:
diff changeset
  5360
			 width:(width - m2)
claus
parents:
diff changeset
  5361
			height:(height - m2).
claus
parents:
diff changeset
  5362
	] ifFalse:[
claus
parents:
diff changeset
  5363
	    h := (height - m2).
claus
parents:
diff changeset
  5364
claus
parents:
diff changeset
  5365
	    self catchExpose.
claus
parents:
diff changeset
  5366
	    self setViewOrigin:newOrigin.
claus
parents:
diff changeset
  5367
	    self copyFrom:self x:margin y:margin
claus
parents:
diff changeset
  5368
			     toX:(count + margin) y:margin
claus
parents:
diff changeset
  5369
			   width:(width - m2 - count) 
claus
parents:
diff changeset
  5370
			  height:h.
claus
parents:
diff changeset
  5371
claus
parents:
diff changeset
  5372
	    self setInnerClip.
claus
parents:
diff changeset
  5373
	    self redrawDeviceX:margin y:margin
claus
parents:
diff changeset
  5374
			 width:count height:(height - m2).
claus
parents:
diff changeset
  5375
claus
parents:
diff changeset
  5376
	    self waitForExpose.
claus
parents:
diff changeset
  5377
	]
claus
parents:
diff changeset
  5378
    ].
claus
parents:
diff changeset
  5379
    self originChanged:(count negated @ 0).
claus
parents:
diff changeset
  5380
!
claus
parents:
diff changeset
  5381
claus
parents:
diff changeset
  5382
scrollRight:nPixels
claus
parents:
diff changeset
  5383
    "change origin to scroll right some pixels"
claus
parents:
diff changeset
  5384
claus
parents:
diff changeset
  5385
    |count "{ Class:SmallInteger }"
claus
parents:
diff changeset
  5386
     m2    "{ Class:SmallInteger }"
claus
parents:
diff changeset
  5387
     h     "{ Class:SmallInteger }" 
claus
parents:
diff changeset
  5388
     wCont 
claus
parents:
diff changeset
  5389
     iw    "{ Class:SmallInteger }"
claus
parents:
diff changeset
  5390
     orgX orgY newOrigin|
claus
parents:
diff changeset
  5391
claus
parents:
diff changeset
  5392
    wCont := self widthOfContents.
claus
parents:
diff changeset
  5393
    transformation isNil ifTrue:[
claus
parents:
diff changeset
  5394
	orgY := orgX := 0
claus
parents:
diff changeset
  5395
    ] ifFalse:[
claus
parents:
diff changeset
  5396
	wCont := (transformation applyScaleX:wCont) rounded.
claus
parents:
diff changeset
  5397
	orgY := transformation translation y negated.
claus
parents:
diff changeset
  5398
	orgX := transformation translation x negated.
claus
parents:
diff changeset
  5399
    ].
claus
parents:
diff changeset
  5400
claus
parents:
diff changeset
  5401
    count := nPixels.
claus
parents:
diff changeset
  5402
    iw := self innerWidth.
claus
parents:
diff changeset
  5403
claus
parents:
diff changeset
  5404
    ((orgX + nPixels + iw) > wCont) ifTrue:[
claus
parents:
diff changeset
  5405
	count := wCont - orgX - iw
claus
parents:
diff changeset
  5406
    ].
claus
parents:
diff changeset
  5407
    (count <= 0) ifTrue:[^ self].
claus
parents:
diff changeset
  5408
claus
parents:
diff changeset
  5409
    self originWillChange.
claus
parents:
diff changeset
  5410
    newOrigin := (orgX + count) @ orgY.
claus
parents:
diff changeset
  5411
claus
parents:
diff changeset
  5412
    shown ifFalse:[
claus
parents:
diff changeset
  5413
	self setViewOrigin:newOrigin.
claus
parents:
diff changeset
  5414
    ] ifTrue:[
claus
parents:
diff changeset
  5415
	m2 := margin * 2.
claus
parents:
diff changeset
  5416
	(count >= iw) ifTrue:[
claus
parents:
diff changeset
  5417
	    self setViewOrigin:newOrigin.
claus
parents:
diff changeset
  5418
	    self redrawDeviceX:margin y:margin
claus
parents:
diff changeset
  5419
			 width:(width - m2)
claus
parents:
diff changeset
  5420
			height:(height - m2).
claus
parents:
diff changeset
  5421
	] ifFalse:[
claus
parents:
diff changeset
  5422
	    m2 := margin * 2.
claus
parents:
diff changeset
  5423
	    h := (height - m2).
claus
parents:
diff changeset
  5424
claus
parents:
diff changeset
  5425
	    self catchExpose.
claus
parents:
diff changeset
  5426
	    self setViewOrigin:newOrigin.
claus
parents:
diff changeset
  5427
	    self copyFrom:self x:(count + margin) y:margin
claus
parents:
diff changeset
  5428
			     toX:margin y:margin
claus
parents:
diff changeset
  5429
			   width:(width - m2 - count) 
claus
parents:
diff changeset
  5430
			  height:h.
claus
parents:
diff changeset
  5431
claus
parents:
diff changeset
  5432
	    self setInnerClip.
claus
parents:
diff changeset
  5433
	    self redrawDeviceX:(width - margin - count) y:margin 
claus
parents:
diff changeset
  5434
			 width:count height:(height - m2).
claus
parents:
diff changeset
  5435
claus
parents:
diff changeset
  5436
	    self waitForExpose.
claus
parents:
diff changeset
  5437
	].
claus
parents:
diff changeset
  5438
    ].
claus
parents:
diff changeset
  5439
    self originChanged:(count @ 0).
claus
parents:
diff changeset
  5440
! !
claus
parents:
diff changeset
  5441
claus
parents:
diff changeset
  5442
!SimpleView methodsFor:'scrolling'!
claus
parents:
diff changeset
  5443
claus
parents:
diff changeset
  5444
widthForScrollBetween:yStart and:yEnd 
claus
parents:
diff changeset
  5445
    "return the width in pixels for a scroll between yStart and yEnd
claus
parents:
diff changeset
  5446
     - return full width here since we do not know how wide contents is.
claus
parents:
diff changeset
  5447
     Views which only use part of their space (short lists, text) may redefine
claus
parents:
diff changeset
  5448
     this method and return the number of pixels that have to be scrolled.
claus
parents:
diff changeset
  5449
     On slow displays, this may make a difference; on fast ones you will probably
claus
parents:
diff changeset
  5450
     not notice any difference."
claus
parents:
diff changeset
  5451
claus
parents:
diff changeset
  5452
    ^ (width - margin - margin)
claus
parents:
diff changeset
  5453
!
claus
parents:
diff changeset
  5454
claus
parents:
diff changeset
  5455
verticalScrollStep
claus
parents:
diff changeset
  5456
    "return the amount to scroll when stepping up/down.
claus
parents:
diff changeset
  5457
     Subclasses may want to redefine this."
claus
parents:
diff changeset
  5458
claus
parents:
diff changeset
  5459
    ^ (device verticalPixelPerMillimeter * 20) asInteger
claus
parents:
diff changeset
  5460
!
claus
parents:
diff changeset
  5461
claus
parents:
diff changeset
  5462
scrollVerticalToPercent:percent
claus
parents:
diff changeset
  5463
    "scroll to a position given in percent of total"
claus
parents:
diff changeset
  5464
claus
parents:
diff changeset
  5465
    |hCont|
claus
parents:
diff changeset
  5466
claus
parents:
diff changeset
  5467
    hCont := self heightOfContents.
claus
parents:
diff changeset
  5468
    transformation notNil ifTrue:[
claus
parents:
diff changeset
  5469
	hCont := transformation applyScaleY:hCont.
claus
parents:
diff changeset
  5470
    ].
claus
parents:
diff changeset
  5471
    self scrollVerticalTo:
claus
parents:
diff changeset
  5472
	    ((((hCont * percent) / 100.0) + 0.5) asInteger)
claus
parents:
diff changeset
  5473
!
claus
parents:
diff changeset
  5474
claus
parents:
diff changeset
  5475
scrollVerticalTo:aPixelOffset
claus
parents:
diff changeset
  5476
    "change origin to make aPixelOffset be the top line"
claus
parents:
diff changeset
  5477
claus
parents:
diff changeset
  5478
    |orgY|
claus
parents:
diff changeset
  5479
claus
parents:
diff changeset
  5480
    orgY := self viewOrigin y.
claus
parents:
diff changeset
  5481
claus
parents:
diff changeset
  5482
    (aPixelOffset < orgY) ifTrue:[
claus
parents:
diff changeset
  5483
	self scrollUp:(orgY - aPixelOffset)
claus
parents:
diff changeset
  5484
    ] ifFalse:[
claus
parents:
diff changeset
  5485
	(aPixelOffset > orgY) ifTrue:[
claus
parents:
diff changeset
  5486
	    self scrollDown:(aPixelOffset - orgY)
claus
parents:
diff changeset
  5487
	]
claus
parents:
diff changeset
  5488
    ]
claus
parents:
diff changeset
  5489
!
claus
parents:
diff changeset
  5490
claus
parents:
diff changeset
  5491
scrollHorizontalToPercent:percent
claus
parents:
diff changeset
  5492
    "scroll to a position given in percent of total"
claus
parents:
diff changeset
  5493
claus
parents:
diff changeset
  5494
    |wCont|
claus
parents:
diff changeset
  5495
claus
parents:
diff changeset
  5496
    wCont := self widthOfContents.
claus
parents:
diff changeset
  5497
    transformation notNil ifTrue:[
claus
parents:
diff changeset
  5498
	wCont := transformation applyScaleX:wCont.
claus
parents:
diff changeset
  5499
    ].
claus
parents:
diff changeset
  5500
    self scrollHorizontalTo:
claus
parents:
diff changeset
  5501
	    ((((wCont * percent) / 100.0) + 0.5) asInteger)
claus
parents:
diff changeset
  5502
!
claus
parents:
diff changeset
  5503
140
claus
parents: 138
diff changeset
  5504
horizontalScrollStep
claus
parents: 138
diff changeset
  5505
    "return the amount to scroll when stepping left/right.
claus
parents: 138
diff changeset
  5506
     Subclasses may want to redefine this."
claus
parents: 138
diff changeset
  5507
claus
parents: 138
diff changeset
  5508
    ^ (device horizontalPixelPerMillimeter * 20) asInteger
claus
parents: 138
diff changeset
  5509
!
claus
parents: 138
diff changeset
  5510
135
claus
parents:
diff changeset
  5511
scrollHorizontalTo:aPixelOffset
claus
parents:
diff changeset
  5512
    "change origin to make aPixelOffset be the left col"
claus
parents:
diff changeset
  5513
claus
parents:
diff changeset
  5514
    |orgX|
claus
parents:
diff changeset
  5515
claus
parents:
diff changeset
  5516
    orgX := self viewOrigin x.
claus
parents:
diff changeset
  5517
claus
parents:
diff changeset
  5518
    (aPixelOffset < orgX) ifTrue:[
claus
parents:
diff changeset
  5519
	self scrollLeft:(orgX - aPixelOffset)
claus
parents:
diff changeset
  5520
    ] ifFalse:[
claus
parents:
diff changeset
  5521
	(aPixelOffset > orgX) ifTrue:[
claus
parents:
diff changeset
  5522
	    self scrollRight:(aPixelOffset - orgX)
claus
parents:
diff changeset
  5523
	]
claus
parents:
diff changeset
  5524
    ]
claus
parents:
diff changeset
  5525
!
claus
parents:
diff changeset
  5526
claus
parents:
diff changeset
  5527
scrollToTop
claus
parents:
diff changeset
  5528
    "move viewOrigin to top"
claus
parents:
diff changeset
  5529
claus
parents:
diff changeset
  5530
    self scrollVerticalTo:0
claus
parents:
diff changeset
  5531
!
claus
parents:
diff changeset
  5532
claus
parents:
diff changeset
  5533
scrollToTopLeft
claus
parents:
diff changeset
  5534
    "move viewOrigin to top/left"
claus
parents:
diff changeset
  5535
151
claus
parents: 145
diff changeset
  5536
    self scrollTo:(0 @ 0).
135
claus
parents:
diff changeset
  5537
!
claus
parents:
diff changeset
  5538
claus
parents:
diff changeset
  5539
scrollUp
claus
parents:
diff changeset
  5540
    "scroll up by some amount; this is called when the scrollbars
claus
parents:
diff changeset
  5541
     scroll-step up button is pressed."
claus
parents:
diff changeset
  5542
claus
parents:
diff changeset
  5543
    self scrollUp:(self verticalScrollStep)
claus
parents:
diff changeset
  5544
!
claus
parents:
diff changeset
  5545
claus
parents:
diff changeset
  5546
scrollDown
claus
parents:
diff changeset
  5547
    "scroll down by some amount; this is called when the scrollbars
claus
parents:
diff changeset
  5548
     scroll-step down button is pressed."
claus
parents:
diff changeset
  5549
claus
parents:
diff changeset
  5550
    self scrollDown:(self verticalScrollStep)
claus
parents:
diff changeset
  5551
!
claus
parents:
diff changeset
  5552
claus
parents:
diff changeset
  5553
scrollLeft
claus
parents:
diff changeset
  5554
    "scroll left by some amount; this is called when the scrollbars
claus
parents:
diff changeset
  5555
     scroll-step left button is pressed."
claus
parents:
diff changeset
  5556
claus
parents:
diff changeset
  5557
    self scrollLeft:(self horizontalScrollStep)
claus
parents:
diff changeset
  5558
!
claus
parents:
diff changeset
  5559
claus
parents:
diff changeset
  5560
scrollRight
claus
parents:
diff changeset
  5561
    "scroll right by some amount; this is called when the scrollbars
claus
parents:
diff changeset
  5562
     scroll-step right button is pressed."
claus
parents:
diff changeset
  5563
claus
parents:
diff changeset
  5564
    self scrollRight:(self horizontalScrollStep)
claus
parents:
diff changeset
  5565
! !
claus
parents:
diff changeset
  5566
claus
parents:
diff changeset
  5567
!SimpleView methodsFor:'user notification'!
claus
parents:
diff changeset
  5568
claus
parents:
diff changeset
  5569
warn:aString
claus
parents:
diff changeset
  5570
    "like Objects warn, but translates the string via the
claus
parents:
diff changeset
  5571
     resourcePack, thus giving a translated string automatically"
claus
parents:
diff changeset
  5572
151
claus
parents: 145
diff changeset
  5573
    super warn:(resources string:aString) withCRs
135
claus
parents:
diff changeset
  5574
!
claus
parents:
diff changeset
  5575
claus
parents:
diff changeset
  5576
warn:aString with:argument
claus
parents:
diff changeset
  5577
    "like Objects warn, but translates the string via the
claus
parents:
diff changeset
  5578
     resourcePack, thus giving a translated string automatically"
claus
parents:
diff changeset
  5579
151
claus
parents: 145
diff changeset
  5580
    super warn:(resources string:aString with:argument) withCRs
claus
parents: 145
diff changeset
  5581
!
claus
parents: 145
diff changeset
  5582
claus
parents: 145
diff changeset
  5583
warn:aString with:arg1 with:arg2
claus
parents: 145
diff changeset
  5584
    "like Objects warn, but translates the string via the
claus
parents: 145
diff changeset
  5585
     resourcePack, thus giving a translated string automatically"
claus
parents: 145
diff changeset
  5586
claus
parents: 145
diff changeset
  5587
    super warn:(resources string:aString with:arg1 with:arg2) withCRs
135
claus
parents:
diff changeset
  5588
! !
claus
parents:
diff changeset
  5589
claus
parents:
diff changeset
  5590
!SimpleView methodsFor:'cursor animation'!
claus
parents:
diff changeset
  5591
claus
parents:
diff changeset
  5592
showBusyWhile:aBlock
claus
parents:
diff changeset
  5593
    "evaluate some time consuming block, while doing this,
claus
parents:
diff changeset
  5594
     show a spinning wheel cursor"
claus
parents:
diff changeset
  5595
claus
parents:
diff changeset
  5596
    |ok bitmaps cursors mask process oldCursor|
claus
parents:
diff changeset
  5597
claus
parents:
diff changeset
  5598
    oldCursor := cursor.
claus
parents:
diff changeset
  5599
claus
parents:
diff changeset
  5600
    ok := true.
claus
parents:
diff changeset
  5601
    bitmaps := #('wheel1' 'wheel2' 'wheel3' 'wheel4') 
claus
parents:
diff changeset
  5602
	       collect:[:name |
claus
parents:
diff changeset
  5603
		   |f|
claus
parents:
diff changeset
  5604
claus
parents:
diff changeset
  5605
		   f := Form fromFile:(name , '.xbm').
claus
parents:
diff changeset
  5606
		   f isNil ifTrue:[
claus
parents:
diff changeset
  5607
			('no bitmap file: ' , name , '.xbm') errorPrintNL.
claus
parents:
diff changeset
  5608
			ok := false
claus
parents:
diff changeset
  5609
		   ].
claus
parents:
diff changeset
  5610
		   f
claus
parents:
diff changeset
  5611
	       ].
claus
parents:
diff changeset
  5612
claus
parents:
diff changeset
  5613
    mask := Form fromFile:'wheelm.xbm'.
claus
parents:
diff changeset
  5614
    mask isNil ifTrue:[
claus
parents:
diff changeset
  5615
	('no bitmap file: ' , mask , '.xbm') errorPrintNL.
claus
parents:
diff changeset
  5616
	ok := false
claus
parents:
diff changeset
  5617
    ].
claus
parents:
diff changeset
  5618
claus
parents:
diff changeset
  5619
    ok ifFalse:[
claus
parents:
diff changeset
  5620
	self cursor:Cursor wait.
claus
parents:
diff changeset
  5621
	aBlock valueNowOrOnUnwindDo:[
claus
parents:
diff changeset
  5622
	    self cursor:oldCursor
claus
parents:
diff changeset
  5623
	]
claus
parents:
diff changeset
  5624
    ] ifTrue:[
claus
parents:
diff changeset
  5625
	cursors := bitmaps collect:[:form | (Cursor sourceForm:form
claus
parents:
diff changeset
  5626
						      maskForm:mask
claus
parents:
diff changeset
  5627
							  hotX:8
claus
parents:
diff changeset
  5628
							  hotY:8) on:device].
claus
parents:
diff changeset
  5629
claus
parents:
diff changeset
  5630
	process := [
claus
parents:
diff changeset
  5631
		    (Delay forSeconds:0.25) wait.
claus
parents:
diff changeset
  5632
		    [true] whileTrue:[
claus
parents:
diff changeset
  5633
			cursors do:[:curs |
claus
parents:
diff changeset
  5634
			    self cursor:curs.
claus
parents:
diff changeset
  5635
			    (Delay forSeconds:0.05) wait
claus
parents:
diff changeset
  5636
			]
claus
parents:
diff changeset
  5637
		    ]
claus
parents:
diff changeset
  5638
		   ] fork.
claus
parents:
diff changeset
  5639
claus
parents:
diff changeset
  5640
	Processor activeProcess priority:7.
claus
parents:
diff changeset
  5641
	aBlock valueNowOrOnUnwindDo:[
claus
parents:
diff changeset
  5642
	    Processor activeProcess priority:8.
claus
parents:
diff changeset
  5643
	    process terminate.
claus
parents:
diff changeset
  5644
	    self cursor:oldCursor
claus
parents:
diff changeset
  5645
	]
claus
parents:
diff changeset
  5646
    ].
claus
parents:
diff changeset
  5647
claus
parents:
diff changeset
  5648
    "
claus
parents:
diff changeset
  5649
     View new realize showBusyWhile:[10 timesRepeat:[3000 factorial]]
claus
parents:
diff changeset
  5650
    "
claus
parents:
diff changeset
  5651
! !
claus
parents:
diff changeset
  5652
claus
parents:
diff changeset
  5653
SimpleView initialize!